!--------------------------------------------------------------------- ! Copyright (C) GFD Dennou Club, 2005. All rights reserved. !--------------------------------------------------------------------- !=begin != Module nmlfile_mod ! ! * Developers: Morikawa Yasuhiro ! * Version: $Id: nmlfile.f90,v 1.1.1.1 2005/11/08 14:10:23 morikawa Exp $ ! * Tag Name: $Name: $ ! * 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.1.1.1 2005/11/08 14:10:23 morikawa Exp $' character(STRING),parameter:: tagname = '$Name: $' contains !=begin !== Procedure Interface ! !=== Initialize module and acquire NAMELIST ! !nmlfile_mod モジュールの初期化ルーチン。 !引数 nml に渡された文字列を NAMELIST ファイル名として格納し、 !そのファイルを (()) で open、 (()) で !close する。 ! !メインプログラムにおいて、他のモジュールの初期化ルーチンよりも先に !呼ばれる事が想定されており、その際に引数 nml に渡された NAMELIST !ファイル名を以降 (正確には (()) が呼ばれるまで)、 !他のモジュールでも利用する事となる。 ! !もしも、メインプログラムにおいて呼ばなかった場合や !引数無しで呼ばれた場合、または引数に空白を与えた場合は、 !デフォルトの 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 ! !(()) で設定された値を破棄し、 !読み込む 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