Return from contained subroutine

1

If subroutine foo CONTAINs subroutine bar, is there a way to RETURN from (exit) foo from within bar? I would like to handle errors within a CONTAINed subroutine, and if there is an error, to return from foo, not just bar. Schematically, this is the problem:

subroutine foo()
call bar(ierr)
contains 
subroutine bar(ierr)
if (ierr /= 0) then
   print*,"in foo, ierr = ",ierr
   return ! RETURNs to foo, not to the caller of foo
   ! allow "return_from foo"?
end if
end subroutine bar
end subroutine foo

In other languages, return foo means return the value foo, so Fortran should not have the same syntax with a different meaning. Maybe allow syntax such as
return_from foo?

2

To the best of my knowledge, there isn’t a mechanism in the language to exit the host procedure via a RETURN from a contained procedure. I personally don’t think such an option will be good for Fortran, I would never use it.

One can consider adding a dummy argument to the foo toward an error handling callback procedure that foo/bar can invoke which can then allow the caller to take control of the situation.

Or, there is always the ALTERNATE RETURN, a poor Fortranner’s substitute due to relentless kicking off the “can down the road” by the standard-bearers when it comes to providing any modern exception handling facility in the language. This can permit foo to complete whatever cleanup may be necessary before exiting the subprogram.

module m
contains
   subroutine foo(ierr)
      integer, intent(out) :: ierr
      call bar(ierr,*999)
      return
 999  continue
      print *, "run-time exception in bar: ierr = ", ierr
   contains
      subroutine bar(irc,*)
         integer, intent(inout) :: irc
         real :: x
         call random_number(x)
         ierr = 0
         if ( (x > 0.4).and.(x < 0.6) ) then
            ierr = 1
            return 1
         end if
         return
      end subroutine 
   end subroutine 
end module
   use m, only : foo
   integer :: i, ker
   do i = 1, 100
      call foo(ker)
      if ( ker /= 0 ) stop
      write( *, fmt="(g0,1x)", advance="no") i 
   end do
end

C:\Temp>ifort /standard-semantics p.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.1.2 Build 20201208_000000
Copyright (C) 1985-2020 Intel Corporation. All rights reserved.

Microsoft (R) Incremental Linker Version 14.28.29337.0
Copyright (C) Microsoft Corporation. All rights reserved.

-out:p.exe
-subsystem:console
p.obj

C:\Temp>p.exe
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
run-time exception in bar: ierr = 1

C:\Temp>

2 Likes