iofortran

Best way to handle multiple exit points in Fortran


I have a Fortran code which reads a file (if you're curious about the background, see How to safely check whether a Fortran file exists when reading it with Python?). Since this code is called from Python, I need to handle all or most IO errors because I don't want my Python code to crash without a sensible error message. I thus edited the Fortran code this way:

  subroutine read_params(filename, params, ierr)
  implicit none
  ! Argument Declarations !
  character(len=*), intent(in) :: filename
  integer, dimension(4), intent(out) :: params
  integer, intent(out) :: ierr
  ! Variable Declarations
  integer :: i, iounit, ios
  character(len=:), allocatable :: errmsg

  iounit = 1
  ierr = 0 ! Initialize error code
  allocate(character(len=256+len(filename)) :: errmsg)
  open(unit=iounit, status="old", file=filename, form="unformatted", iostat=ios, iomsg=errmsg)
  call check_for_io_errors(ios, "open", ierr, errmsg)
  if (ierr /= 0) then
      close(iounit)
      return
  end if
  read(iounit, *, iostat=ios, iomsg=errmsg) (params(i), i=1, 4)
  call check_for_io_errors(ios, "read", ierr, errmsg)
  if (ierr /= 0) then
      close(iounit)
      return
  end if
  close(iounit)

  end subroutine read_params

As you can see, the subroutine has multiple exit points, and some code duplication. Alternatively, I could do

      subroutine read_params(filename, params, ierr)
      implicit none
      ! Argument Declarations !
      character(len=*), intent(in) :: filename
      integer, dimension(4), intent(out) :: params
      integer, intent(out) :: ierr
      ! Variable Declarations
      integer :: i, iounit, ios
      character(len=:), allocatable :: errmsg

      iounit = 1
      ierr = 0 ! Initialize error code
      allocate(character(len=256+len(filename)) :: errmsg)
      open(unit=iounit, status="old", file=filename, form="unformatted", iostat=ios, iomsg=errmsg)
      call check_for_io_errors(ios, "open", ierr, errmsg)
      if (ierr /= 0) then
          goto 10
      end if
      read(iounit, *, iostat=ios, iomsg=errmsg) (params(i), i=1, 4)
      call check_for_io_errors(ios, "read", ierr, errmsg)
      if (ierr /= 0) then
          goto 10
      end if
10    close(iounit)

      end subroutine read_params

which uses the dreaded goto statement. What is the preferred way to do this in Fortran ≤ 2003? Also, if you have any other suggestions to improve the code, feel free to let me know.

PS it's probably not necessary to answer the main question, but here is the source for the subroutine check_for_io_errors in case you're curious:

  subroutine check_for_io_errors(ios, operation, ierr, errmsg)
  implicit none
  ! Argument Declarations !
  integer, intent(in) :: ios
  character(len=*), intent(in) :: operation
  integer, intent(out) :: ierr
  character(len=*), intent(in) :: errmsg

  if (ios /= 0) then
      if (operation == "open") then
          ierr = -1
          print *, "Error opening file"
          print *, "Error message: " // trim(errmsg)
      else if (operation == "read") then
          ierr = -2
          print *, "Error reading file"
          print *, "Error message: " // trim(errmsg)
      else if (operation == "write") then
          ierr = -3
          print *, "Error writing file"
          print *, "Error message: " // trim(errmsg)
      end if
  end if

  end subroutine check

Solution

  • Reasonnable uses of goto, like here, look fine to me. The advantage compared to the return solution is that you don't have to repeat the close(iounit) statement (ok, it's just one statement, but imagine if you have several of them...).

    As noted in the comments, the block control structure offers a maybe more structured way:

    block
       ...
       if (ierr /= 0) exit
       ...
       if (ierr /= 0) exit
       ...
    end block
    close(iounit)
    

    If your compiler doesn't allow using it, you can achieve something similar with an "infinite do loop" (just don't forget the final exit!):

    do
       ...
       if (ierr /= 0) exit
       ...
       if (ierr /= 0) exit
       ...
       exit
    end do
    close(iounit)