!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2005. All rights reserved.
!---------------------------------------------------------------------

module nmlfile_mod

  use type_mod,   only : TOKEN, INTKIND, STRING

  implicit none

  private
  public :: nmlfile_init, nmlfile_end    ! subroutines
  public :: nmlfile_open, nmlfile_close  ! subroutines
  public :: nmlfile                      ! functions

  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.1.1.1 2005/11/08 14:10:23 morikawa Exp $'
  character(STRING),parameter:: tagname = '$Name: dcpam3-20051109-3 $'

contains

  !=== 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)
    
    use type_mod,  only: STRING, TOKEN, INTKIND
    
    implicit none
    
    character(*), intent(in), optional :: nml  ! NAMELIST file name
    
    character(STRING), parameter:: subname = "nmlfile_init"
    continue
    
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    if (nmlfile_initialized) then
       return
    else
       nmlfile_initialized = .true.
    endif

    !----------------------------------------------------------------
    !   Version identifier
    !----------------------------------------------------------------

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

    !----------------------------------------------------------------
    !   Output Message
    !----------------------------------------------------------------

  end subroutine nmlfile_init

  !=== 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)

    use type_mod,  only: STRING, TOKEN, INTKIND

    implicit none

    !==== 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
    !----------------------------------------------------------------

    nmlunit = -1
    readable = .false.

    if (.not. nmlfile_initialized) then
       return
    endif

    !----------------------------------------------------------------
    !   既に nmlunit_save が接続済みの場合にはそれを解除
    !----------------------------------------------------------------
    if (nmlunit_save >= 0) then
       inquire(unit=nmlunit_save, opened=p)
       if (p) then
          close(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.
       return
    endif

    !----------------------------------------------------------------
    !   ファイル file_nml のステータスチェック
    !----------------------------------------------------------------
    ! ファイルが存在して、読み取り可能であること、既に
    ! Open されていないかをチェックする。
    inquire(file=trim(file_nml), exist=e, number=n, read=r)

    ! ファイルが存在しない場合は readable = .false. で返す。
    if (.not. e) then
       nmlunit = -1
       readable = .false.
       return
    endif

    ! 読み取り不能である場合は readable = .false. で返す。
    if (r == 'NO') then
       nmlunit = -1
       readable = .false.
       return
    endif

    ! ファイルが既に Open されている場合には1度解除する。
    if ( n >= 0 ) then
       close(n)
    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.
       return
    endif

    ! 問題なければ終了
    nmlunit = nmlunit_save
    readable = .true.
    return
  end subroutine nmlfile_open


  !=== Close NAMELIST file
  !
  !nmlfile_open で開いたファイルを Close する。
  !nmlfile_open が呼ばれていない場合には何もせずに終了する。
  !
  subroutine nmlfile_close()
    !==== Dependency
    use type_mod,  only: STRING, TOKEN, INTKIND

    implicit none

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

    if (.not. nmlfile_initialized) then
       return
    endif

    !----------------------------------------------------------------
    !   nmlunit_save が負の場合は未接続とみなして終了
    !----------------------------------------------------------------
    if (nmlunit_save < 0) then
       return
    end if

    !----------------------------------------------------------------
    !   nmlunit_save が正の場合は close し、nmlunit_save = -1 にする。
    !----------------------------------------------------------------
    inquire(unit=nmlunit_save, opened=p)
    if (.not. p) then
    else
       close(unit=nmlunit_save)
    end if

    nmlunit_save = -1
    return

  end subroutine nmlfile_close

  !=== Return NAMELIST file name
  !
  character(TOKEN) function nmlfile() result(result)
  !==== Dependency
    use type_mod,  only: STRING, TOKEN, INTKIND

    implicit none

    character(STRING), parameter:: subname = "nmlfile"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    result = file_nml
    return
  end function nmlfile


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

    implicit none

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

    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    if ( .not. nmlfile_initialized) then
       return
    else
       nmlfile_initialized = .false.
    endif

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

  end subroutine nmlfile_end


end module nmlfile_mod
