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