Passing file identifiers to all subroutines of fortran code

Question

The Fortran program 'MAIN' below calls 3 subroutines.

1. It opens a file if it is not present, (overwrites if it is already present).
2. writes something on the file using the file identifier integer and
3. closes the file.

---

       program MAIN

2001 FORMAT (A,I10)
   INTEGER FILEIDS(10)
   CHARACTER*64 fname
   FILEIDS(1) = 701
   write(*,2001) 'opnoutfl', FILEIDS(1)

   fname = 'advect1.dat'

   CALL OFNFL (FILEIDS(1), fname)

   CALL BDEXCH (FILEIDS(1))
   CALL CLOOUTFL(FILEIDS(1))
   END



   SUBROUTINE OFNFL (UNITNO, fname)

   LOGICAL EXISTS, OPND

   INTEGER UNITNO
   CHARACTER*64 fname,dirname,path

2001 FORMAT (A,I10)
     write(*,2001) 'opnoutfl', UNITNO
    dirname = 'sediment/'
    path  = trim(dirname) // trim(fname)

   INQUIRE (file=path, EXIST=EXISTS)

  IF (EXISTS) THEN
     OPEN (UNITNO, file=path, status='old')
     close(UNITNO, STATUS='DELETE')
     OPEN (UNITNO, file=path, status='NEW')
     WRITE(UNITNO,2001) 'Alte Dateil ist geloest  ',UNITNO
  ELSE
     OPEN (UNITNO, file=path, status='NEW')
     WRITE(UNITNO, 2001) 'Neue Datei ist geoeffnet',UNITNO
  END IF

    RETURN
    END


  SUBROUTINE CLOOUTFL (UNITNO)

  INTEGER UNITNO

  CLOSE(UNITNO)
  RETURN
  END


   SUBROUTINE BDEXCH (MESSU)

   INTEGER MESSU

2001 FORMAT (A,I10)    

   WRITE(MESSU, 2001) 'bdexch schreibt', MESSU+10

    RETURN
    END

My question is, at this moment I am passing file identifier as argument. How can I modify/improve this code so that the file identifier created in first subroutine i.e. OFNFL() be automatically seen to subsequent subroutines which uses/writes on the file? The program where I want to use it creates lots of files and then different subroutines writes on different files, so passing file identifier like this will not look very clean!!

Answer 1

If you want to share access to one or more files that are known beforehand, a possible way is to make each file into a singleton and to pack all of them in a module. I illustrate the principle below, after rewriting your code in modern fortran. The example incorporates many feature that should be considered for a production code. Of course, the implementation should be adapted to your real code.

module mod_output
  use, intrinsic :: iso_fortran_env, only : ERROR_UNIT
  implicit none
  private

  character(len=*), parameter :: MSG_NEW = 'Neue Datei ist geoeffnet'
  character(len=*), parameter :: MSG_DEL = 'Alte Dateil ist geloest '

  integer, public , parameter :: DIR_ID  = 1
  integer, public , parameter :: FILE_ID = 2

  !.. Singleton
  type, private :: class_output
     character(len=:), allocatable :: Directory
     character(len=:), allocatable :: FileName
     integer                       :: unitID      = 0
     logical                       :: opened      =.FALSE.
   contains
     procedure, public :: set     => class_output_set
     procedure, public :: getUnit => class_output_getUnit
     procedure, public :: open    => class_output_open
     procedure, public :: isSet   => class_output_isSet
     procedure, public :: close   => class_output_close
  end type class_output
  !*** some examples:
  type(class_output), public :: output_1
  type(class_output), public :: output_2
  integer, parameter, public :: SIZE_OUTPUT_LIST=10
  type(class_output), public :: outputList(SIZE_OUTPUT_LIST)
  
contains

  subroutine class_output_set(self,fieldID,strn)
    implicit none
    class(class_output), intent(inout) :: self
    integer            , intent(in)    :: fieldID
    character(len=*)   , intent(in)    :: strn
    select case ( fieldID )
    case ( DIR_ID  )
       self%Directory = trim(adjustl(strn))
    case ( FILE_ID )
       self%FileName  = trim(adjustl(strn))
    end select
  end subroutine class_output_set
    
  logical function class_output_isSet(self) result( isSet )
    implicit none
    class(class_output), intent(in) :: self
    isSet = allocated( self%Directory ) .and. allocated( self%FileName )
  end function class_output_isSet
    
  subroutine class_output_open(self)
    implicit none
    class(class_output), intent(inout) :: self
    character(len=:), allocatable :: path, msg
    character(len=100)            :: iomsg
    logical                       :: exists
    integer                       :: uid, iostat
    if( .not. self%IsSet() )then
       write(ERROR_UNIT) " output file not set"
       error stop
    end if
    call execute_command_line("mkdir -p "//trim(self%Directory))
    path = trim(self%Directory) // trim(self%FileName)
    inquire( file = path, exist = exists )
    if(exists)then
       msg = MSG_DEL
    else
       msg = MSG_NEW
    endif
    open(newunit = uid   , &
         file    = path  , &
         action  ="write", &
         iostat  = iostat, &
         iomsg   = iomsg )
    if( iostat /= 0 )then
       write(ERROR_UNIT,"(a)") iomsg
       error stop
    endif
    write(uid,"(a,x,i0)") msg, uid
    self%unitID = uid
    self%opened = .TRUE.
  end subroutine class_output_open

  subroutine class_output_close(self)
    implicit none
    class(class_output), intent(inout) :: self
    character(len=100) :: iomsg
    integer            :: iostat
    close(self%unitID  , &
         iostat= iostat, &
         iomsg = iomsg )
    if( iostat /= 0 )then
       write(ERROR_UNIT,"(a)") iomsg
       error stop
    endif
  end subroutine class_output_close

  integer function class_output_getUnit(self) result( uid )
    implicit none
    class(class_output), intent(inout) :: self
    if(.not.self%Opened)then
       write(ERROR_UNIT,"(a)") "Attempt to access unit of closed file"
       error stop
    endif
    uid = self%unitID 
  end function class_output_getUnit

end module mod_output

Then your main program would look like this

program main
  !.. the other outputs can be initialized and used as well.
  !   If the different files have constant directory and filename
  !   they may be specified in mod_output and initialized collectively
  !   by an init routine at the beginning of the main program
  use mod_output
  implicit none
  integer, parameter :: int_vector(3) = [1,2,3] 
  call output_1%Set(  DIR_ID, "sediment/"   )
  call output_1%Set( FILE_ID, "advect1.dat" )
  call output_1%Open()
  CALL bdexch( int_vector, size(int_vector) )
  call output_1%Close()
end program main

subroutine bdexch( ivec, n )
  use mod_output, only : output_1
  implicit none
  integer, intent(in) :: ivec(n), n
  integer :: uid
  uid = output_1%getUnit()
  write(uid,"(a,*(x,i0))") 'bdexch schreibt', ivec + 10
end subroutine bdexch

For an introduction to the simple syntax of modern Fortran, I suggest the following quick modern Fortran tutorial.