ecearth3/sources/tm5mp/base/go_file.F90

!###############################################################################
!
#define IF_ERROR_RETURN(action) if (status/=0) then; write (gol,'("in ",a)') rname; call goErr; action; return; end if
!
!###############################################################################


module GO_File

  implicit none

  ! --- in/out -------------------

  private

  public  ::  goGetFU

  public  ::  TTextFile
  public  ::  Init, Done
  public  ::  ReadLine, RewindFile


  ! --- const ---------------------------------
  
  character(len=*), parameter  ::  mname = 'GO_File'


  ! --- types -------------------------------------

  type TTextFile
    character(len=80)       ::  name
    ! file unit:
    integer                 ::  fu
    ! comment ?
    logical                 ::  commented
    character(len=1)        ::  comment
  end type TTextFile


  ! --- interfaces -------------------------------------

  interface Init
    module procedure file_Init
  end interface
  
  interface Done
    module procedure file_Done
  end interface
  

contains


  ! ==============================================================
  ! ===
  ! === file units
  ! ===
  ! ==============================================================


  ! Returns the first free available file unit number.

  subroutine goGetFU( fu, status )
  
    use GO_FU   , only : goStdIn, goStdOut, goStdErr
    use GO_FU   , only : goFuRange
    use GO_Print, only : gol, goErr

    ! --- in/out --------------------------

    integer, intent(out)      ::  fu
    integer, intent(out)      ::  status

    ! --- const ---------------------------
    
    character(len=*), parameter  ::  rname = mname//'/goGetFU'
    
    ! --- local --------------------------

    integer               ::  i
    character(len=256)    ::  fname
    logical               ::  opened

    ! --- local ---------------------------
    
    ! start with lowest possible unit:
    fu = goFuRange(1) - 1
    
    ! loop until unopned unit is found:
    do

      ! try next file unit:
      fu = fu + 1

      ! too large ?
      if ( fu > goFuRange(2) ) then
        write (gol,'("unable to select free file unit within allowed range ...")'); call goErr
        write (gol,'("close some files or increase goFuRange in module GO_FU")'); call goErr
        write (gol,'("current goFuRange : ",i6," .. ",i6)') goFuRange; call goErr
        write (gol,'("open files:")')
        do i = goFuRange(1), goFuRange(2)
          inquire( unit=i, name=fname )
          write (gol,'(i6," : ",a)') i, trim(fname); call goErr
        end do
        write (gol,'("in ",a)') rname; call goErr; status=1; return
      end if
      
      ! skip ?
      if ( fu==goStdIn  ) cycle
      if ( fu==goStdOut ) cycle
      if ( fu==goStdErr ) cycle

      ! free available unit ? then ok
      inquire( unit=fu, opened=opened )
      if ( .not. opened ) exit
      
    end do

    ! ok
    status = 0

  end subroutine goGetFU


  ! ==============================================================
  ! ===
  ! === text file
  ! ===
  ! ==============================================================


  !
  ! call Init( file, filename, iostat, [,status='unknown'|'old'|'new'] [,comment='\%'] )
  !
  ! Replaces the intrinsic 'open' command, but uses a
  ! a structure of type TTextFile instead of a file unit number. \\
  ! Arguments passed are the same as for 'open'.\\
  ! In addition, a text file can be opened as a commented
  ! text file; with the 'ReadLine' command one is able to read
  ! lines from the file while skipping the lines starting
  ! with the specified comment.
  !

  subroutine file_Init( file, filename, iostat, status, comment )

    use GO_Print, only : gol, goPr, goErr

    ! --- in/out ------------------------

    type(TTextFile), intent(out)              ::  file
    character(len=*), intent(in)              ::  filename
    integer, intent(out)                      ::  iostat
    
    character(len=*), intent(in), optional    ::  status
    character(len=1), intent(in), optional    ::  comment

    ! --- const ---------------------------
    
    character(len=*), parameter  ::  rname = mname//'/file_Init'
    
    ! --- local ----------------------------

    logical             ::  exist    
    character(len=10)   ::  statusX

    ! --- begin ----------------------------

    ! file exist ?
    inquire( file=trim(filename), exist=exist )
    if ( .not. exist ) then
      write (gol,'("commented text file not found:")'); call goErr
      write (gol,'("  file name : ",a)') trim(filename); call goErr
      write (gol,'("in ",a)') rname; call goErr; iostat=1; return
    end if

    ! check file status : 'old', 'new', 'unknown'
    if (present(status)) then
      statusX = status
    else
      statusX = 'unknown'
    end if

    ! store filename:
    file%name = filename

    ! select free file unit:
    Call goGetFU( file%fu, iostat )
    if (iostat/=0) then; write (gol,'("in ",a)') rname; call goErr; iostat=1; return; end if

    ! open file:
    open( unit=file%fu, file=trim(filename), iostat=iostat, &
                                 status=statusX, form='formatted' )
    if ( iostat /= 0 ) then
      write (gol,'("from file open :")'); call goErr
      write (gol,'("  file name : ",a)') trim(filename); call goErr
      write (gol,'("in ",a)') rname; call goErr; iostat=1; return
    end if
    
    ! check on comment lines ?
    if ( present(comment) ) then
      file%commented = .true.
      file%comment = comment
    else
      file%commented = .false.
      file%comment = 'x'
    end if

    ! ok
    iostat = 0

  end subroutine file_Init


  ! ***


  !
  ! call Done( file )
  !

  subroutine file_Done( file, status )

    use GO_Print, only : gol, goPr, goErr

    ! --- in/out -----------------

    type(TTextFile), intent(inout)    ::  file
    integer, intent(out)              ::  status

    ! --- const ----------------------
    
    character(len=*), parameter  ::  rname = mname//'/file_Done'
    
    ! --- begin ------------------------

    ! close file:
    close( unit=file%fu, iostat=status )
    if ( status /= 0 ) then
      write (gol,'("from closing file:")'); call goErr
      write (gol,'("  ",a)') trim(file%name); call goErr
      write (gol,'("in ",a)') rname; call goErr; status=1; return
    end if
    
    ! ok
    status = 0

  end subroutine file_Done


  ! ***


  !
  ! call ReadLine( file, s )
  !
  ! Reads the next line from a commented text file,
  ! but skips all lines starting with the 'comment'
  ! specified with the 'Init' command.
  ! Empty lines are skipped too.
  !

  subroutine ReadLine( file, s, status  )

    use GO_Print, only : gol, goPr, goErr

    ! --- in/out -------------------------

    type(TTextFile), intent(inout)      ::  file
    character(len=*), intent(out)       ::  s
    integer, intent(out)                ::  status

    ! --- const --------------------------
    
    character(len=*), parameter  ::  rname = mname//'/ReadLine'
    
    ! --- local --------------------------

    character(len=10)        ::  fmt

    ! --- begin --------------------------

    ! format (a100) etc:
    write (fmt,'("(a",i6.6,")")') len(s)

    ! loop until:
    !  o uncommented line has been read in s
    !  o eof is reached
    do
     
      ! read next line:
      read (file%fu,fmt,iostat=status) s
      if ( status < 0 ) then  ! eof
        s = ''
        status=-1; return
      else if ( status > 0 ) then
        write (gol,'("reading line from file:")'); call goErr
        write (gol,'("  ",a)') trim(file%name); call goErr
        write (gol,'("in ",a)') rname; call goErr; status=1; return
      end if

      ! remove leading space:
      s = adjustl( s )

      ! empty ?
      if ( len_trim(s) == 0 ) cycle

      ! check for comment ?
      if ( file%commented .and. (scan(s,file%comment)==1) ) cycle
      
      ! s filled; leave loop
      exit
      
    end do
    
    ! ok
    status = 0

  end subroutine ReadLine

  subroutine RewindFile( file, status)

    use GO_Print, only : gol, goPr, goErr

    ! --- in/out -------------------------

    type(TTextFile), intent(inout)      ::  file
    integer, intent(out)                ::  status

    ! --- const --------------------------
    
    character(len=*), parameter  ::  rname = mname//'/RewindFile'
    
    ! --- local --------------------------

    ! --- begin --------------------------

    rewind(unit = file%fu, iostat = status)
    if (status /= 0 ) then 
        write (gol,'("Rewind operation failed")')    ; call goErr
        write (gol,*) 'On file: ',trim(file%name)    ; call goErr
        write (gol,*) 'Unit   : ',file%fu            ; call goErr
        write (gol,'("in ",a)') rname; call goErr; status=1; return
    endif
    status = 0

  end subroutine RewindFile

end module GO_File


! ###########################################################################
! ###
! ### test program
! ###
! ###########################################################################
!
! ---[test.rc]--------------------------------------
! !
! ! abcdefg
! ! 2
!
! 0000000001111111111222222222233333333334
! 1234567890123456789012345678901234567890
!
! aaa :     kasfjasfjsla;kfja;ls
!
!   !  xxxxxxxxxx
!
!       bbb  : 123
! --------------------------------------------------
!
!program test_go_file
!
!  use go_file
!  
!  type(TTextFile)     ::  file
!  character(len=25)  ::  s
!  integer             ::  status
!  
!  call Init( file, 'test.rc', status )
!  if (status/=0) stop 'error'
!  
!  do
!  
!    call ReadLine( file, s, status )
!    if (status<0) then
!      print *, 'xxx eof'
!      exit
!    else if ( status == 0 ) then
!      print *, 'xxx "'//trim(s)//'"'
!    else
!      print *, 'xxx error'
!      exit
!    end if
!
!  end do
!  
!  call Done( file, status )
!  if (status/=0) stop 'error'
!
!
!end program test_go_file
!