!******************************************************************************
! 2006/06/04 : A function fi_lc is added.
!******************************************************************************
! 2003/07/25
!******************************************************************************
!
! If this subroutine finish correctly, ios = 0. 
!
!******************************************************************************

  module fi_module

    use vtype_module

    implicit none

    private


    public :: fi_findfu, fi_open, fi_lc


    interface
       subroutine fi_findfu( fn, mode, ios, fu, req_fu )
         use vtype_module
         character(len=*), intent(in )           :: fn, mode
         integer(i4b)    , intent(out)           :: ios, fu
         integer(i4b)    , intent(in ), optional :: req_fu
       end subroutine fi_findfu
    end interface

    interface
       subroutine fi_open( fn, mode, fu, fm, acc, req_fu )
         use vtype_module
         character(len=*), intent(in )           :: fn, mode
         integer(i4b)    , intent(out)           :: fu
         character(len=*), intent(in ), optional :: fm, acc
         integer(i4b)    , intent(in ), optional :: req_fu
       end subroutine fi_open
    end interface


    interface
       function fi_lc( fn, nheader, nfooter ) result( nline )
         use vtype_module
         character(len=*), intent(in )           :: fn
         integer(i4b)    , intent(in ), optional :: nheader, nfooter
         integer(i4b)                            :: nline
       end function fi_lc
    end interface


  end module fi_module


  !****************************************************************************
  ! fi_findfu
  !****************************************************************************
  ! Example:
  !
  !      use vtype
  !      character(len=stdstr) :: fn
  !      integer(i4b)          :: ios, fu
  !      character(len=stdstr) :: mode
  !
  !      fn = "file"
  !      call fio_findfu( fn, ios, fu, mode )
  !      if( ios /= 0 ) then
  !         write( 6, * ) 'STOP in parse_ctl: ', ios
  !         stop
  !      end if
  !      open( unit = fu, file = fn, status = "unknown", iostat = ios )
  !
  !**************************************************************************

  subroutine fi_findfu( fn, mode, ios, fu, req_fu )

    use vtype_module

    character(len=*), intent(in )           :: fn, mode
    integer(i4b)    , intent(out)           :: ios, fu
    integer(i4b)    , intent(in ), optional :: req_fu


    !
    ! local variables
    !
    logical                 :: od, ex
    integer(i4b), parameter :: fus = 11, fue = 99


    if( ( mode .ne. "read" ) .and. ( mode .ne. "write" ) ) then
       write( 6, * ) 'Now, mode of "', trim( mode ), '" is not supported.'
       stop
    end if


    inquire( file = fn, opened = od, exist = ex )

    if( ( mode .eq. "read" ) .and. ( .not. ex ) ) then
       write( 6, * ) 'ERROR: In fi_findfu: File ', trim( fn ), &
            ' does not exist.'
       ios = 903
       fu = -1
       return
    end if

    if( od ) then
       write( 6, * ) 'ERROR: In fi_findfu: File ', trim( fn ), ' is open.'
       ios = 901
       fu = -1
       return
    end if

    if( present( req_fu ) ) then
       fu = req_fu
       inquire( unit = fu, opened = od, iostat = ios )
       if( od ) then
          write( 6, * ) 'ERROR: Requested file unit has already used.'
          ios = 904
       end if
    else
       find_fu_loop : do fu = fus, fue
          inquire( unit = fu, opened = od, iostat = ios )
          if( .not. od ) exit find_fu_loop
       end do find_fu_loop
       if( fu .gt. fue ) then
          write( 6, * ) 'ERROR: In fi_findfu: Unable to find a file unit.'
          ios = 902
          fu = -1
          return
       end if

       ios = 0
    end if


  end subroutine fi_findfu

  !**************************************************************************
  ! fi_open
  !**************************************************************************
  ! Example:
  !
  !   mode : 'read' or 'write'
  !   fm   : 'formatted' or 'unformatted'
  !   acc  : 'sequential' or 'direct'
  !**************************************************************************

  subroutine fi_open( fn, mode, fu, fm, acc, req_fu )

    use vtype_module

    implicit none

    interface
       subroutine fi_findfu( fn, mode, ios, fu, req_fu )
         use vtype_module
         character(len=*), intent(in )           :: fn, mode
         integer(i4b)    , intent(out)           :: ios, fu
         integer(i4b)    , intent(in ), optional :: req_fu
       end subroutine fi_findfu
    end interface

    character(len=*), intent(in )           :: fn, mode
    integer(i4b)    , intent(out)           :: fu
    character(len=*), intent(in ), optional :: fm, acc
    integer(i4b)    , intent(in ), optional :: req_fu


    !
    ! local variables
    !
    character(len=extstr) :: sta
    character(len=extstr) :: l_fm, l_acc
    integer(i4b)          :: ios


    call fi_findfu( fn, mode, ios, fu, req_fu )
    if( ios /= 0 ) then
       write( 6, * ) 'STOP in parse_ctl: ', ios
       stop
    end if


    if( mode .eq. 'read' ) then
       sta = 'OLD'
    else if( mode .eq. 'write' ) then
!         sta = 'NEW'
       sta = 'unknown'
    else
       write( 6, * ) 'Now, "', trim( mode ), '" mode is not supported.'
       stop
    end if

    if( present( fm ) ) then
       l_fm = fm
    else
       l_fm = 'formatted'
    end if

    if( present( acc ) ) then
       l_acc = acc
    else
       l_acc = 'sequential'
    end if


    open( unit = fu, file = fn, iostat = ios, status = sta, &
         form = l_fm, access = l_acc )

    if( ios .ne. 0 ) then
       write( 6, * ) 'Unable to open file ', trim( fn ), '.'
       stop
    end if


  end subroutine fi_open

  !****************************************************************************

  function fi_lc( fn, nheader, nfooter ) result( nline )

    use vtype_module

    implicit none

    interface
       subroutine fi_open( fn, mode, fu, fm, acc, req_fu )
         use vtype_module
         character(len=*), intent(in )           :: fn, mode
         integer(i4b)    , intent(out)           :: fu
         character(len=*), intent(in ), optional :: fm, acc
         integer(i4b)    , intent(in ), optional :: req_fu
       end subroutine fi_open
    end interface

    character(len=*), intent(in )           :: fn
    integer(i4b)    , intent(in ), optional :: nheader, nfooter

    integer(i4b)                            :: nline


    !
    ! local variables
    !
    integer(i4b) :: l_nheader, l_nfooter
    integer(i4b) :: fu, ios


    if( present( nheader ) ) then
       l_nheader = nheader
    else
       l_nheader = 0
    end if

    if( present( nfooter ) ) then
       l_nfooter = nfooter
    else
       l_nfooter = 0
    end if


    call fi_open( fn, "read", fu )
    nline = 0
    line_count_loop : do
       read( fu, *, iostat = ios )
       if( ios .ne. 0 ) exit line_count_loop
       nline = nline + 1
    end do line_count_loop
    close( fu )

    nline = nline - l_nheader - l_nfooter


  end function fi_lc

  !****************************************************************************
