| Class | nmlfile_mod |
| In: |
src/shared/nmlfile/nmlfile.f90
|
| result : | character(TOKEN) |
character(TOKEN) function nmlfile() result(result)
!==== Dependency
!=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
| nml : | character(*), intent(in), optional
|
もしも、メインプログラムにおいて呼ばなかった場合や 引数無しで呼ばれた場合、または引数に空白を与えた場合は、 デフォルトの NAMELIST ファイル ((* nmlfile.nml *)) が読み込まれる。
subroutine nmlfile_init(nml)
!
!==== Dependency
!
!=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
| nmlunit : | integer(INTKIND), intent(out)
| ||
| readable : | logical , intent(out)
|
なお、以前にこのプログラムにて NAMELIST ファイルが Open されている場合、 既に Open されている装置番号を自動的に閉じる。
subroutine nmlfile_open(nmlunit, readable)
!
!==== Dependency
!=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