How to expand the scope of a subroutine inside a subroutine?

1

Dear all,

A quick question, for an extremely simplified example,

subroutine A(n)
integer :: n
if (n>100) then
  write (6,*) 'Rich!', n
  return
else
  write (6,*) 'Poor!', n
  return
endif
write (6,*) 'This is line shall not be displayed.'
end subroutine A

Now, for some reason I want the above subroutine A to be written as subroutine A_mod.
A_mod and A should behave exactly the same. That is, the text "This is line will not be displayed.‘’ really should not be displayed in both A_mod and A . I define sub subroutine show inside A_mod to simplify the write and return statements. In real case these write and return statements are actually some long and similar code. That is why I want to use sub subroutine show, so that I do not need to repeat some similar code blocks explicitly again and again.

So I make Amod as below,

subroutine A_mod(n)
integer :: n
if (n>100) then
  call show('Rich!',*100)
else
  call show('Poor',*100)
endif
write (6,*) 'This is line shall not be displayed.'
100 return ! sub subroutine show should just to here.
contains
subroutine show(ch,*)
character(*) :: ch
write (6,*) ch, n
return 1
end subroutine show
end subroutine A_mod

So that the sub subroutine show is really return to the proper place in the subroutine A_mod, which is

100 return

Here I used alternative return,
https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnb3/index.html

I know it looks like using alternative return, I can let sub subroutine show to jump to any place in subroutine A_mod as I want to.

However it seems alternative return may be an obsolete feature (however it seems very useful in this case). So anyway, I just wonder, is there any other modern way to let sub subroutine (such as show) jump to certain places in the main subroutine (such as A_mod)?

Thanks much in advance!

2

Apart from go to and alternative returns which lead to complicated control flow, you could do this:

logical :: skip
skip = .true.

write(*,'(A)',advance='no') "n = "
read(*,*) n

if (n > 100) then
   write(*,*) "Rich"
else
   write(*,*) "Poor"
end if

! ... [insert code to change skip to .false.] ...

if (.not. skip) then
   write(*,*) "This line shall not be displayed"
end if

end

As it stands now, the example makes little sense, because the last write is bound to be skipped under all normal circumstances. I am guessing in your true code there might be additional statements between the two else blocks.

1 Like
3

Thank you @ivanpribec . Yeah the example I showed is not too good.
The real code contains a little bit MPI, and it is more like

subroutine A(...)
...
do i = 1, n
  if ( rank ==0 ) then
! rank 0 cpu do the job. 
! However at some point if rank 0 find error, 
! it wants to inform all the cores to return
  ... long god damn code ...
    if (detected some error) then
     quit= .true. 
     goto 100
    else
      quit = .false. 
    endif
  ...  long god damn code  ...
  endif
100 continue
  call broadcast(quit) 
  if (quit) then return
! all core will wait here for rank 0 to broadcast if quit or not. 
! if quit is true then all the cores return.
enddo
...
end subroutine A

  1. It looks like in this case, if rank 0 detects some error, and it wants all the cores to return, I can think of the not-so-adorable goto statement is convenient. All the cores will run at 100, and wait for the broadcast, when quit is true, all the cores return subroutine A.
    Is there some other way can achieve this?
    I mean, if rank 0 detects something wrong, if inform all the cores to stop or return or whatever.

  2. if I want to make

  ... long god damn code ...
    if (detected some error) then
     quit= .true. 
     goto 100
    else
      quit = .false. 
    endif
  ...  long god damn code  ...

into a sub subroutine inside subroutine A, call it longcode, like

subroutine A(...)
...
do i = 1, n
  if ( rank ==0 ) then
! rank 0 cpu do the job. 
! However at some point if rank 0 find error, 
! it wants to inform all the cores to return
    call longcode(...)
  endif
100 continue
  call broadcast(quit) 
  if (quit) then return
! all core will wait here for rank 0 to broadcast if quit or not. 
! if quit is true then all the cores return.
enddo
...
contains
subroutine longcode(...)
! seems need to use alternative return, 
! so that it return to 100 in the main subroutine. 
end subroutine longcode
end subroutine A

It seems the alternative return will be needed in sub subroutine longcode.
Is there some more modern way that can let sub subroutine longcode jump to some places in the main subroutine A?

Sorry it is a little bit chaotic, lol.

4

The usual way to do this is to use error/return flags from your routine:

! Only rank 0 will run this function
integer(STATUS_CODE) function do_your_job(bla,bla) result(ierr)
    ierr = STATUS_SUCCESS ! default: all good

    ! On errors of any kind, return an error code
    if (problem) then 
       ierr = STATUS_PROBLEM_1
       return
    endif

end function do_your_job

Of course you need to define your error codes somewhere as PARAMETERs . The usual logic simplifies math in MPI and is usually:

  • ierr == 0 : success, no more info
  • ierr>0: success, return some info
  • ierr<0: error code

so you can later do

   if (rank==0) then 
      ierr = do_your_job(blabla)
   else
      ierr = SUCCESS
   endif

   ! Gather error code
   ierr = MPI_ALLREDUCE(ierr,MPI_MIN,blabla)

   if (ierr<0) stop ' error occurred '
1 Like
5

You want to give your error codes an ENUM-like status:


integer, parameter :: STATUS_CODE = int32 ! define a kind

integer(STATUS_CODE), parameter :: STATUS_SUCCESS = 0
integer(STATUS_CODE), parameter :: STATUS_INVALID_INPUT = -1
integer(STATUS_CODE), parameter :: STATUS_INVALID_OUTPUT = -2
! etc.
1 Like
6

Can’t you just use a label on the if statement and exit to it:

rank0: if ( rank ==0 ) then
! rank 0 cpu do the job. 
! However at some point if rank 0 find error, 
! it wants to inform all the cores to return
  ... long god damn code ...
    if (detected some error) then
     quit= .true. 
     exit rank0
    else
      quit = .false. 
    endif
  ...  long god damn code  ...
  endif rank0

Personally I like alternate returns and am hoping that one day they’ll make a comeback. The status code example below shows the unnecessarily verbosity which is one of Fortran’s weaknesses. Perhaps one day we’ll get the equivalent of enum class (C++)

Your code also shows a limitation of internal procedures - you can’t invoke a return from the calling code. In scripting languages (well tcl at least) you can invoke a return by just specifying the level, e.g. return -level 1 -code ok
Extending return to the functionality of tcl would give internal procedures a serious boost.

1 Like