((< nmlfile_init >)) で指定されることが想定されているが、
もしもこの初期化ルーチンより以前に指定されていなければ、 ((<
nmlfile_init >)) のデフォルトで指定される NAMELIST ファイルを 読む。
subroutine axis_x_init
!==== Dependency
!=end
implicit none
!-------------------------------------------------------------------
! 変数定義
!-------------------------------------------------------------------
!=begin
!
!==== NAMELIST
!
!X 軸の次元変数に関する情報を与える。
!値を与えないものに関しては以下のデフォルトの値が用いられる。
!
!変数 decision には X 軸のデータをどのように与えるかを指定する。
!
!* (({ 'manual' }))
! * Data 配列に格納したデータをそのまま X 軸として与える。
!
!* (({ 'spectral' }))
! * スペクトル法を用いる事を想定し、 length に応じて自動的に
! X 軸のデータが決まる。
!
!* gtool4 変数 (例えば (({ 'foo.nc@lon' })) など)
! * 該当する変数から X 軸のデータを取得する。
!
!変数 length には、 ((<grid_3d_mod>)) の公開要素 ((< im >)) と同じ
!値を与えなければならない。
!
character(TOKEN) :: name = 'lon' ! 次元変数名
integer(INTKIND) :: length = 64 ! 次元長 (配列サイズ)
character(STRING) :: longname = 'Longitude' ! 次元変数の記述的名称
character(STRING) :: units = 'degrees_east' ! 次元変数の単位
character(TOKEN) :: xtype = 'float' ! 次元変数の型
character(STRING) :: decision = 'spectral' ! 次元データの取得方法
real(REKIND) :: Data(NMLARRAY) = 0.0 ! 次元データ入力用
namelist /axis_x_nml/ name , length , longname , units , xtype , decision , Data ! 次元データ
!=end
!=begin
!
!X 軸の次元変数の属性に関する情報を与える。
!NAMELIST に複数の axis_x_attr_nml を用意しておく事で
!複数の情報を与える事が可能である。
!与えない場合には属性情報は付加されない。
!
!attrtype には与える属性値の種類を設定する。
!((<URL:http://www.gfd-dennou.org/arch/gtool4/gt4f90io-current/doc/gt_history.htm#derived_gthistoryattr>))
!を参照せよ。なお、arraysize に 1 以上の値を設定すると、
!配列データが優先されて属性値に設定される。
!
character(GT_TOKEN) :: attrname = '' ! 属性名
character(GT_TOKEN) :: attrtype = '' ! 属性値の型
character(GT_STRING) :: cvalue = '' ! 属性の値 (文字)
integer(INTKIND) :: ivalue = 0 ! 属性の値 (整数)
real(REKIND) :: rvalue = 0.0 ! 属性の値 (単精度実数)
real(DBKIND) :: dvalue = 0.0d0 ! 属性の値 (倍精度実数)
logical :: lvalue = .false.! 属性の値 (論理)
integer(INTKIND) :: arraysize= 0 ! 配列のサイズ
integer(INTKIND) :: iarray(NMLARRAY) = 0 ! 属性の値 (整数)
real(REKIND) :: rarray(NMLARRAY) = 0.0 ! 属性の値 (単精度実数)
real(DBKIND) :: darray(NMLARRAY) = 0.0d0! 属性の値 (倍精度実数)
namelist /axis_x_attr_nml/ attrname , attrtype , cvalue , ivalue , rvalue , dvalue , lvalue , arraysize , iarray , rarray , darray ! 属性の値 (倍精度実数)
!=end
!-----------------------------------------------------------------
! 変数情報の一時格納変数
!-----------------------------------------------------------------
type(GT_HISTORY_ATTR), allocatable :: attrs_tmp(:)
!-----------------------------------------------------------------
! 汎用変数
!-----------------------------------------------------------------
integer(INTKIND) :: i, k
integer(INTKIND) :: nmlstat, nmlunit
logical :: nmlreadable, next
character(TOKEN) :: position
character(STRING), parameter:: subname = "axis_x_init"
continue
!----------------------------------------------------------------
! Check Initialization
!----------------------------------------------------------------
call BeginSub(subname)
if (axis_x_initialized) then
call EndSub( subname, '%c is already called', c1=trim(subname) )
return
else
axis_x_initialized = .true.
endif
!----------------------------------------------------------------
! Version identifier
!----------------------------------------------------------------
call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname))
!-----------------------------------------------------------------
! Initialize Dependent Modules
!-----------------------------------------------------------------
call grid_3d_init
call spml_init
!----------------------------------------------------------------
! read axis_x_nml
!----------------------------------------------------------------
call nmlfile_init
call nmlfile_open(nmlunit, nmlreadable)
if (nmlreadable) then
read(nmlunit, nml=axis_x_nml, iostat=nmlstat)
call DbgMessage('Stat of NAMELIST axis_x_nml Input is <%d>', i=(/nmlstat/))
write(0, nml=axis_x_nml)
else
call DbgMessage('Not Read NAMELIST axis_x_nml')
call MessageNotify('W', subname, 'Can not Read NAMELIST axis_x_nml. Force Use Default Value.')
end if
call nmlfile_close
x_Dim%stored = .false.
! 次元変数の情報を構造型変数 x_Dim への代入
x_Dim%axisinfo%name = name
x_Dim%axisinfo%length = length
x_Dim%axisinfo%longname = longname
x_Dim%axisinfo%units = units
x_Dim%axisinfo%xtype = xtype
allocate( x_Dim%a_Dim(x_Dim%axisinfo%length) )
! 次元変数の情報を構造型変数 x_Dim への代入
select case(decision)
! manual: NAMELIST の Data で入力
case('manual')
x_Dim%a_Dim(:) = 0
x_Dim%a_Dim(1:x_Dim%axisinfo%length) = Data(1:x_Dim%axisinfo%length)
x_Dim%stored = .true.
axis_x_data_from_manual = .true.
! spectral: SPMODEL の wa_module により生成
case('spectral')
axis_x_data_from_spectral = .true.
x_Dim%stored = .false.
! foo.nc@lon: foo.nc ファイルの lon 変数から取得
! その他 : spectral と同じに
case default
! 文字の中に '@' か '?' が含まれる場合は gtool4 変数として
! 認識し、その nc ファイルから変数情報をコピーする。
if ( index(decision, GT_ATMARK) > 0 .or. index(decision, GT_QUESTION) > 0) then
axis_x_data_from_netcdf = decision
x_Dim%stored = .false.
! それ以外は 'spectral' と同じように処理
else
axis_x_data_from_spectral = .true.
x_Dim%stored = .false.
endif
end select
!----------------------------------------------------------------
! read axis_x_attr_nml
!----------------------------------------------------------------
call nmlfile_init
call nmlfile_open(nmlunit, nmlreadable)
if (.not. nmlreadable) then
call DbgMessage('Not Read NAMELIST axis_x_attr_nml')
call MessageNotify('W', subname, 'Can not Read NAMELIST axis_x_attr_nml.')
else
i = 0
next = .false.
axis_x_attr_nml_input : do
i = i + 1
call DbgMessage('NAMELIST axis_x_attr_nml Input, <%d> time', i=(/i/))
! 初期化
attrname = '' ! 属性名
attrtype = '' ! 属性値の型
cvalue = '' ! 属性の値 (文字)
ivalue = 0 ! 属性の値 (整数)
rvalue = 0.0 ! 属性の値 (単精度実数)
dvalue = 0.0d0 ! 属性の値 (倍精度実数)
lvalue = .false.! 属性の値 (論理)
arraysize = 0 ! 配列のサイズ
iarray(:) = 0 ! 属性の値 (整数)
rarray(:) = 0.0 ! 属性の値 (単精度実数)
darray(:) = 0.0d0 ! 属性の値 (倍精度実数)
! read nml
read(nmlunit, nml=axis_x_attr_nml, iostat=nmlstat)
call DbgMessage('Stat of NAMELIST axis_x_attr_nml Input is <%d>', i=(/nmlstat/))
write(0, nml=axis_x_attr_nml)
! Inquire access position
inquire(nmlunit, position=position)
if ( trim(position) /= 'APPEND' ) then
next = .true.
else
next = .false.
endif
! 有効でない値を含むものに関しては無視。
if (attrname == '') then
call DbgMessage('attrname is blank. so this axis_x_attr_nml is ignored.')
if (next) cycle
if (.not. next) exit
elseif (attrtype == '') then
call DbgMessage('attrtype is blank. so this axis_x_attr_nml is ignored.')
if (next) cycle
if (.not. next) exit
endif
!-----------------------------------------------------------
! x_Dim%attrs への格納
!-----------------------------------------------------------
! attrs(:) の拡張
if ( .not. associated(x_Dim%attrs) ) then
allocate( x_Dim%attrs(1) )
k = 1
else
k = size( x_Dim%attrs ) + 1
! 配列データの領域確保
allocate( attrs_tmp(k-1) )
call axis_attrs_copy(from=x_Dim%attrs(1:k-1), to=attrs_tmp(1:k-1))
deallocate( x_Dim%attrs )
allocate( x_Dim%attrs(k) )
call axis_attrs_copy(from=attrs_tmp(1:k-1), to=x_Dim%attrs(1:k-1))
deallocate( attrs_tmp )
endif
if (arraysize > 0) then
call axis_attrs_init(x_Dim%attrs(k))
deallocate( x_Dim%attrs(k)%iarray )
deallocate( x_Dim%attrs(k)%rarray )
deallocate( x_Dim%attrs(k)%darray )
allocate( x_Dim%attrs(k)%iarray( arraysize ) )
allocate( x_Dim%attrs(k)%rarray( arraysize ) )
allocate( x_Dim%attrs(k)%darray( arraysize ) )
x_Dim%attrs(k)%array = .true.
else
call axis_attrs_init(x_Dim%attrs(k))
endif
x_Dim%attrs(k)%attrname = attrname
x_Dim%attrs(k)%attrtype = attrtype
x_Dim%attrs(k)%cvalue = cvalue
x_Dim%attrs(k)%ivalue = ivalue
x_Dim%attrs(k)%rvalue = rvalue
x_Dim%attrs(k)%dvalue = dvalue
x_Dim%attrs(k)%lvalue = lvalue
x_Dim%attrs(k)%iarray(1:max(1,arraysize)) = iarray(1:max(1,arraysize))
x_Dim%attrs(k)%rarray(1:max(1,arraysize)) = rarray(1:max(1,arraysize))
x_Dim%attrs(k)%darray(1:max(1,arraysize)) = darray(1:max(1,arraysize))
call DbgMessage('x_Dim-attrs(%d) [attrname=<%c> ' // 'attrtype=<%c> array=<%b> cvalue=<%c> ' // 'ivalue=<%d> rvalue=<%r> dvalue=<%f> ' // 'iarray(1:%d)=<%d, ...> ' // 'rarray(1:%d)=<%r, ...> darray(1:%d)=<%f, ...>' , c1=trim( x_Dim%attrs(k)%attrname ) , c2=trim( x_Dim%attrs(k)%attrtype ) , c3=trim( x_Dim%attrs(k)%cvalue ) , i=(/ k, x_Dim%attrs(k)%ivalue , size(x_Dim%attrs(k)%iarray) , x_Dim%attrs(k)%iarray , size(x_Dim%attrs(k)%rarray) , size(x_Dim%attrs(k)%darray) /) , r=(/x_Dim%attrs(k)%rvalue, x_Dim%attrs(k)%rarray/) , d=(/x_Dim%attrs(k)%dvalue, x_Dim%attrs(k)%darray/) , l=(/x_Dim%attrs(k)%lvalue/) )
if (.not. next) exit axis_x_attr_nml_input
next = .false. ! 次回のための初期化
enddo axis_x_attr_nml_input
end if
call nmlfile_close
!----------------------------------------------------------------
! grid_3d_mod との整合性をチェック
!----------------------------------------------------------------
call grid_3d_init
if (x_Dim%axisinfo%length /= im) then
call MessageNotify('E', subname, message='axis length is inconsistent with im in grid_3d_mod')
endif
!----------------------------------------------------------------
! 例外処理
!----------------------------------------------------------------
if (length < 1) then
call MessageNotify('E', subname, message='Invalid grid number.')
endif
call EndSub( subname )
end subroutine axis_x_init