!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2005. All rights reserved.
!---------------------------------------------------------------------
                                                                 !=begin
!= Module nmlfile_mod
!
!   * Developers: Morikawa Yasuhiro
!   * Version: $Id: nmlfile.f90,v 1.9 2005/01/19 08:52:37 morikawa Exp $
!   * Tag Name: $Name: dcpam2-20050522-2 $
!   * Change History: 
!
!== Overview
!
!This module support to input NAMELIST.
!
!NAMELIST を取得するための支援モジュールである。
!ファイルから NAMELIST を取得する場合に便利な
!サブルーチンを用意している。
!NAMELIST を取得するモジュールおよびプログラムは、
!原則的に全てこのモジュールを呼ぶ。
!
!== Error Handling
!
!== Known Bugs
!
!== Note
!
!== Future Plans
!
!現在、あるプログラムで読み込む事が可能な NAMELIST ファイルは、
!メインプログラムで nmlfile_init(nml) と呼んだ際の nml という
!ファイル名に固定されてしまう。実行プログラムで引数としてファイル名を
!取得したり、標準入力からファイル名を取得するなどして、
!再コンパイル無しに NAMELIST ファイルを変更できると良いかもしれない。
!
                                                                 !=end

module nmlfile_mod
                                                                 !=begin
  !== Dependency
  use type_mod,   only : TOKEN, INTKIND, STRING
                                                                 !=end
  implicit none
                                                                 !=begin
  !== Public Interface
  private
  public :: nmlfile_init, nmlfile_end    ! subroutines
  public :: nmlfile_open, nmlfile_close  ! subroutines
  public :: nmlfile                      ! functions
                                                                 !=end

  character(TOKEN) ,parameter:: file_default = 'nmlfile.nml'! default file
  character(TOKEN) ,save:: file_nml = file_default! NAMELIST file name
  integer(INTKIND) ,save:: nmlunit_save = -1  ! NAMELIST ファイル用装置番号

  logical          ,save     :: nmlfile_initialized = .false.
  character(STRING),parameter:: version = &
       & '$Id: nmlfile.f90,v 1.9 2005/01/19 08:52:37 morikawa Exp $'
  character(STRING),parameter:: tagname = '$Name: dcpam2-20050522-2 $'

contains
                                                                 !=begin
  !== Procedure Interface
  !
  !=== Initialize module and acquire NAMELIST
  !
  !nmlfile_mod モジュールの初期化ルーチン。
  !引数 nml に渡された文字列を NAMELIST ファイル名として格納し、
  !そのファイルを ((<nmlfile_open>)) で open、 ((<nmlfile_close>)) で
  !close する。
  !
  !メインプログラムにおいて、他のモジュールの初期化ルーチンよりも先に
  !呼ばれる事が想定されており、その際に引数 nml に渡された NAMELIST
  !ファイル名を以降 (正確には ((<nmlfile_end>)) が呼ばれるまで)、
  !他のモジュールでも利用する事となる。
  !
  !もしも、メインプログラムにおいて呼ばなかった場合や
  !引数無しで呼ばれた場合、または引数に空白を与えた場合は、
  !デフォルトの NAMELIST ファイル ((* nmlfile.nml *)) が読み込まれる。
  !
  subroutine nmlfile_init(nml)
  !
  !==== Dependency
  !
    use type_mod,  only: STRING, TOKEN, INTKIND
    use dc_trace,  only: BeginSub, EndSub, DbgMessage
    use dc_message,only: MessageNotify
                                                                 !=end
    implicit none
                                                                 !=begin
    !==== Input
    !
    character(*), intent(in), optional :: nml  ! NAMELIST file name
                                                                 !=end

!!$                                                                 !=begin
!!$    !
!!$    !==== NAMELIST
!!$    !
!!$    character(TOKEN)    :: file  = file_default ! NAMELIST file name
!!$
!!$    namelist /nmlfile_nml/ file
!!$                                                                 !=end
!!$
!!$    integer(INTKIND)            :: nmlstat
    character(STRING), parameter:: subname = "nmlfile_init"
  continue

    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub(subname)
    if (nmlfile_initialized) then
       call EndSub( subname, '%c is already called', c1=trim(subname) )
       return
    else
       nmlfile_initialized = .true.
    endif

    !----------------------------------------------------------------
    !   Version identifier
    !----------------------------------------------------------------
    call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname))

    !----------------------------------------------------------------
    !   Reflect optional argument "nml"
    !----------------------------------------------------------------
    if (present(nml)) then
       if (trim(nml) /= '') then
          file_nml = nml
       endif
    endif

    !----------------------------------------------------------------
    !   read nmlfile_nml
    !----------------------------------------------------------------
!!$    read(5,nml=nmlfile_nml, iostat=nmlstat)
!!$    call DbgMessage('Stat of NAMELIST nmlfile_nml Input is <%d>', &
!!$         &           i=(/nmlstat/))
!!$    write(0,nml=nmlfile_nml)
!!$
!!$    ! If invalid value file is selected, use default.
!!$    if ( nmlstat /= 0 .or. trim(file) /= '' ) then
!!$       file_nml = file
!!$    endif

    !----------------------------------------------------------------
    !   Output Message
    !----------------------------------------------------------------
    call MessageNotify('M', subname, 'Set to Input NAMELIST file <%c>', &
         & c1=trim(file_nml) )

    call EndSub( subname )
  end subroutine nmlfile_init


                                                                 !=begin
  !=== Open NAMELIST file, and Return Device Number
  !
  !nmlfile_mod に格納している NAMELIST ファイルを「適当な」装置番号で
  !Open し、その装置番号を nmlunit として返し、readable に .true. を
  !返す。もしも Open が失敗した、またはファイルが読み取り不可能な
  !場合には nmlunit に -1 を、readable に .false. を返す。
  !
  !なお、以前にこのプログラムにて NAMELIST ファイルが Open されている場合、
  !既に Open されている装置番号を自動的に閉じる。
  !
  subroutine nmlfile_open(nmlunit, readable)
    !
    !==== Dependency
    use type_mod,  only: STRING, TOKEN, INTKIND
    use dc_trace,  only: BeginSub, EndSub, DbgMessage
    use dc_string, only: CPrintf
    use dc_message,only: MessageNotify
                                                                 !=end
    implicit none
                                                                 !=begin
    !==== Output
    !
    integer(INTKIND), intent(out):: nmlunit  ! Device Number for nml file
    logical         , intent(out):: readable ! Readable Flag
                                                                 !=end
    integer(INTKIND)            :: unit, ios, n
    logical                     :: x, p, e
    character(STRING)           :: r
    character(STRING), parameter:: subname = "nmlfile_open"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub( subname )

    nmlunit = -1
    readable = .false.

    if (.not. nmlfile_initialized) then
       call EndSub( subname, 'Call nmlfile_init before call %c.', &
            &       c1=trim(subname) )
       return
    endif

    !----------------------------------------------------------------
    !   既に nmlunit_save が接続済みの場合にはそれを解除
    !----------------------------------------------------------------
    if (nmlunit_save >= 0) then
       inquire(unit=nmlunit_save, opened=p)
       if (p) then
          close(nmlunit_save)
          call DbgMessage('Close(%d)', i=(/nmlunit_save/))
       endif
       nmlunit_save = -1
    end if

    !----------------------------------------------------------------
    !   「適当な」装置番号を探査、格納
    !----------------------------------------------------------------
    unit = 98  ! "98" は適当に大きい数字を選んだだけ
    do
       ! 装置番号 unit が接続可能で、かつ未接続かどうか
       inquire(unit=unit, exist=x, opened=p)
       if (x .and. .not. p) then
          nmlunit_save = unit
          exit
       endif
       ! 装置番号 unit が利用不可、または利用済の場合は 0 以下に
       ! なるまで unit - 1 して繰り返す。
       unit = unit - 1
       if (unit < 0) exit
    enddo

    if (nmlunit_save < 0) then
       nmlunit = -1
       readable = .false.
       call MessageNotify('W', subname, &
            & 'Device Number is not available, so <%c> can not be opend.', &
            & c1=trim(file_nml) )
       call EndSub(subname, &
            & 'Device Number is not available, so <%c> can not be opend.', &
            & c1=trim(file_nml) )
       return
    endif

    !----------------------------------------------------------------
    !   ファイル file_nml のステータスチェック
    !----------------------------------------------------------------
    ! ファイルが存在して、読み取り可能であること、既に
    ! Open されていないかをチェックする。
    inquire(file=trim(file_nml), exist=e, number=n, read=r)
    call DbgMessage('Status of inquire(%c) [exist=<%b>, ' // &
         & 'number=<%d>, read=<%c>].', &
         & l=(/e/), i=(/n/), c1=trim(file_nml), c2=trim(r) )

    ! ファイルが存在しない場合は readable = .false. で返す。
    if (.not. e) then
       nmlunit = -1
       readable = .false.
       call MessageNotify('W', subname, &
            & '<%c> is not found.', c1=trim(file_nml) )
       call EndSub(subname, &
            & '<%c> is not found.', c1=trim(file_nml) )
       return
    endif

    ! 読み取り不能である場合は readable = .false. で返す。
    if (r == 'NO') then
       nmlunit = -1
       readable = .false.
       call MessageNotify('W', subname, &
            & '<%c> is not readable.', c1=trim(file_nml) )
       call EndSub(subname, &
            & '<%c> is not readable.', c1=trim(file_nml) )
       return
    endif

    ! ファイルが既に Open されている場合には1度解除する。
    if ( n >= 0 ) then
       close(n)
       call DbgMessage('close(%d) [file_nml=<%c>].', &
            & i=(/n/), c1=trim(file_nml) )
    endif

    !----------------------------------------------------------------
    !   ファイル file_nml を装置番号 nmlunit_save と接続
    !----------------------------------------------------------------
    ! 装置番号 unit と file_nml を接続する。
    open(unit=nmlunit_save, file=trim(file_nml), status='OLD', &
         & iostat=ios, action='READ')

    ! 入出力に問題があった場合は readable = .false. で返す。
    if (ios /= 0) then
       nmlunit = -1
       readable = .false.
       call MessageNotify('W', subname, &
            & '<%c> can not be opened successfully.', c1=trim(file_nml) )
       call EndSub(subname, &
            & '<%c> can not be opened successfully.', c1=trim(file_nml) )
       return
    endif


    ! 問題なければ終了
    nmlunit = nmlunit_save
    readable = .true.
    call EndSub( subname, 'Open <%c>. unit=<%d>. readable=<%b>.', &
         & c1=trim(file_nml), i=(/nmlunit_save/), l=(/readable/) )
    return
  end subroutine nmlfile_open


                                                                 !=begin
  !=== Close NAMELIST file
  !
  !nmlfile_open で開いたファイルを Close する。
  !nmlfile_open が呼ばれていない場合には何もせずに終了する。
  !
  subroutine nmlfile_close()
    !==== Dependency
    use type_mod,  only: STRING, TOKEN, INTKIND
    use dc_trace,  only: BeginSub, EndSub, DbgMessage
    use dc_string, only: CPrintf
    use dc_message,only: MessageNotify
                                                                 !=end
    implicit none

    logical                     :: p
    character(STRING), parameter:: subname = "nmlfile_close"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub( subname )

    if (.not. nmlfile_initialized) then
       call EndSub( subname, 'Call nmlfile_init before call %c.', &
            &       c1=trim(subname) )
       return
    endif

    !----------------------------------------------------------------
    !   nmlunit_save が負の場合は未接続とみなして終了
    !----------------------------------------------------------------
    if (nmlunit_save < 0) then
       call EndSub( subname, '<%c> was not opend.', c1=trim(file_nml) )
       return
    end if

    !----------------------------------------------------------------
    !   nmlunit_save が正の場合は close し、nmlunit_save = -1 にする。
    !----------------------------------------------------------------
    inquire(unit=nmlunit_save, opened=p)
    if (.not. p) then
       call EndSub( subname, '<%c> was not opend.', c1=trim(file_nml) )
    else
       close(unit=nmlunit_save)
       call EndSub( subname, '<%c> was closed.', c1=trim(file_nml) )
    end if

    nmlunit_save = -1
    return

  end subroutine nmlfile_close



                                                                 !=begin
  !
  !=== Return NAMELIST file name
  !
  character(TOKEN) function nmlfile() result(result)
  !==== Dependency
    use type_mod,  only: STRING, TOKEN, INTKIND
    use dc_trace,  only: BeginSub, EndSub, DbgMessage
    use dc_string, only: CPrintf
    use dc_message,only: MessageNotify
                                                                 !=end
    implicit none

    character(STRING), parameter:: subname = "nmlfile"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub( subname )

    result = file_nml

    if (.not. nmlfile_initialized) then
       call EndSub( subname, 'Call nmlfile_init before call %c.', &
            &       c1=trim(subname) )
       call MessageNotify('W', subname, &
            & 'nmlfile_init was not called. Now nmlfile=<%c>.', &
            & c1=trim(file_nml) )
       return
    else
       call EndSub( subname, 'nmlfile=<%c>.', c1=trim(file_nml) )
       return
    endif

    return
  end function nmlfile




                                                                 !=begin
  !=== Terminate module
  !
  !((<nmlfile_init>)) で設定された値を破棄し、
  !読み込む NAMELIST ファイルの名前を ((* nmlfile.nml *)) に戻す。
  !
  subroutine nmlfile_end()
  !==== Dependency
    use type_mod,  only: STRING
    use dc_trace,  only: BeginSub, EndSub, DbgMessage
                                                                 !=end
    implicit none

    !-----------------------------------------------------------------
    !   変数定義
    !-----------------------------------------------------------------
    !----- 作業用内部変数 -----
    character(STRING),  parameter:: subname = "nmlfile_end"
  continue

    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub(subname)
    if ( .not. nmlfile_initialized) then
       call EndSub( subname, 'nmlfile_init was not called', &
            &       c1=trim(subname) )
       return
    else
       nmlfile_initialized = .false.
    endif

    !----------------------------------------------------------------
    !   Reset to default value
    !----------------------------------------------------------------
    file_nml = file_default ! NAMELIST file name
    nmlunit_save = -1     ! NAMELIST ファイル用装置番号

    call EndSub(subname)
  end subroutine nmlfile_end


end module nmlfile_mod
