!--------------------------------------------------------------------- ! Copyright (C) GFD Dennou Club, 2005. All rights reserved. !--------------------------------------------------------------------- !=begin != Module varinfo_mod ! ! * Developers: Morikawa Yasuhiro ! * Version: $Id: varinfo.f90,v 1.5 2007/06/08 02:18:15 morikawa Exp $ ! * Tag Name: $Name: $ ! * Change History: ! !== Overview ! !This module store Variable Infomation from NAMELIST and Provide. !These Information is expected to be used by ((< io_gt4_out_mod >)). ! !NAMELIST から出力する変数に関する情報を取得する。 !これらの情報は ((< io_gt4_out_mod >)) にて用いられることが想定されている。 ! ! !== Error Handling ! !== Known Bugs ! !== Note ! !== Future Plans ! !もしかすると、((< io_gt4_out_mod >)) モジュール内に格納される !べきかも知れません。 ! !=end module varinfo_mod !=begin !== Dependency use type_mod, only : INTKIND, STRING, TOKEN use gt4_history, only : GT_HISTORY_VARINFO use gt4_history, only : HistoryVarinfoCreate, HistoryVarinfoCopy use gt4_history, only : HistoryVarinfoAddAttr, HistoryVarinfoInquire use gt4_history, only : HistoryVarinfoClear !=end implicit none !=begin !== Public Interface private public :: VAR_INFO ! derived types public :: varinfo_init, varinfo_inquire, varinfo_end ! subroutines ! !== Generic Procedure ! !!$ interface varinfo_attrs_init !!$ module procedure varinfo_attrs_init0, varinfo_attrs_init1 !!$ end interface !== Derived Types ! !変数に関する各情報を格納 (データ本体は含まない) ! type VAR_INFO character(STRING) :: varkey = '' ! 変数キー character(STRING) :: file = '' ! 出力するファイル integer(INTKIND) :: StepInterval = 0 ! 出力ステップ間隔 integer(INTKIND) :: OutputStep = 0 ! 出力回数 type(GT_HISTORY_VARINFO):: varinfo ! gt4 変数情報 ! type(GT_HISTORY_ATTR), pointer & ! & :: attrs(:) =>null() ! 属性情報群 end type VAR_INFO !=end ! 変数情報を格納しておく変数 type(VAR_INFO), allocatable ,save:: vars_store(:) logical ,save:: varinfo_initialized = .false. character(STRING),parameter:: version = & & '$Id: varinfo.f90,v 1.5 2007/06/08 02:18:15 morikawa Exp $' character(STRING),parameter:: tagname = '$Name: $' contains !=begin !== Procedure Interface ! !=== Initialize module and acquire NAMELIST ! !モジュールを初期化し、NAMELIST から値を取得する。 !NAMELIST から値が取得できないものに関しては上記のデフォルト値が !用いられる。 ! !NAMELIST ファイルは、メインプログラムにて ((< nmlfile_mod >)) の !((< nmlfile_init >)) で指定されることが想定されているが、 !もしもこの初期化ルーチンより以前に指定されていなければ、 !((< nmlfile_init >)) のデフォルトで指定される NAMELIST ファイルを !読む。 ! subroutine varinfo_init !==== Dependency use type_mod, only: STRING, TOKEN, INTKIND, REKIND, DBKIND, & & NMLARRAY use nmlfile_mod,only: nmlfile_init, nmlfile_open, nmlfile_close use dc_types, only: GT_TOKEN => TOKEN, GT_STRING => STRING use dc_trace, only: DbgMessage, BeginSub, EndSub use dc_message,only: MessageNotify use dc_string, only: StrHead, JoinChar !=end implicit none !=begin ! !==== NAMELIST varinfo_nml ! !変数に関する基本情報を設定するための NAMELIST で、 !複数の varinfo_nml を用意する事で、複数の変数の設定が可能である。 !変数 varkey はモデル毎に !内部で設定される物理量のマーカで、具体的には !((< io_gt4_out_mod >)) モジュールの !((< io_gt4_out_SetVars >)) サブルーチンでマーカを設定し、 !((< io_gt4_out_Put >)) サブルーチンでデータを file に !指定されたファイルに出力する。もしも file を与えない、 !または空文字を与えた場合には、((< io_gt4_out_nml >)) !で与えた default_output 変数で指定されたファイルに出力する。 ! !varname, dimnum, dimnames, longname, units, xtype !は出力される変数に付加される情報である。 ! !StepInterval, OutputStep を与えない、またはゼロ以下の値を !与えた場合には ((< time_mod >)) の time_nml で与えた !StepInterval, OutputStep が用いられる。 ! character(STRING) :: varkey = '' ! 変数キー character(STRING) :: file = '' ! 出力するファイル character(GT_TOKEN) :: varname = '' ! 変数名 integer(INTKIND) :: dimnum = 0 ! 依存する次元 character(GT_TOKEN) :: dimnames(NMLARRAY) = '' ! 依存する次元 character(GT_STRING) :: longname = '' ! 変数の記述的名称 character(GT_STRING) :: units = '' ! 変数の単位 character(GT_TOKEN) :: xtype = '' ! 変数の型 integer(INTKIND) :: StepInterval = 0 ! 出力ステップ間隔 integer(INTKIND) :: OutputStep = 0 ! 出力回数 namelist /varinfo_nml/ & & varkey , & ! 変数キー & file , & ! 出力するファイル & varname , & ! 変数名 & dimnum , & ! 依存する次元の数 & dimnames , & ! 依存する次元変数名 & longname , & ! 変数の記述的名称 & units , & ! 変数の単位 & xtype , & ! 変数の型 & StepInterval , & ! 出力回数 & OutputStep ! 出力ステップ間隔 ! !==== NAMELIST varinfo_attr_nml ! !変数 varattr の属性情報を与える。 !NAMELIST に複数の varinfo_attr_nml を用意しておく事で !複数の変数に対し、複数の情報を与える事が可能である。 !与えない場合には属性情報は付加されない。 ! !attrtype には与える属性値の種類を設定する。 !(()) !を参照せよ。なお、arraysize に 1 以上の値を設定すると、 !配列データが優先されて属性値に設定される。 ! character(GT_STRING) :: varattr = '' ! 属性を付加する変数名 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 /varinfo_attr_nml/ & & varattr , & ! 属性を付加する変数名 & attrname , & ! 属性名 & attrtype , & ! 属性値の型 & cvalue , & ! 属性の値 (文字) & ivalue , & ! 属性の値 (整数) & rvalue , & ! 属性の値 (単精度実数) & dvalue , & ! 属性の値 (倍精度実数) & lvalue , & ! 属性の値 (論理) & arraysize , & ! 配列のサイズ & iarray , & ! 属性の値 (整数) & rarray , & ! 属性の値 (単精度実数) & darray ! 属性の値 (倍精度実数) !=end !------------------------------------------------------------------- ! 変数情報の一時格納変数 !------------------------------------------------------------------- type(VAR_INFO) , allocatable :: vars_store_tmp(:) ! type(GT_HISTORY_ATTR), allocatable :: attrs_tmp(:) !---------------------------------------------------------------- ! 汎用変数 !---------------------------------------------------------------- integer(INTKIND) :: i, j, k logical :: err integer(INTKIND) :: nmlstat, nmlunit logical :: nmlreadable, next character(TOKEN) :: position character(STRING) :: var_name character(STRING), parameter:: subname = "varinfo_init" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if (varinfo_initialized) then call EndSub( subname, '%c is already called', c1=trim(subname) ) return else varinfo_initialized = .true. endif !---------------------------------------------------------------- ! Version identifier !---------------------------------------------------------------- call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname)) !---------------------------------------------------------------- ! read varinfo_nml !---------------------------------------------------------------- if ( allocated(vars_store) ) then deallocate(vars_store) endif call nmlfile_init call nmlfile_open(nmlunit, nmlreadable) if (.not. nmlreadable) then call DbgMessage('Not Read NAMELIST varinfo_nml') call MessageNotify('W', subname, & & 'Can not Read NAMELIST varinfo_nml.') else i = 0 j = 0 next = .false. varinfo_nml_input : do i = i + 1 call DbgMessage('NAMELIST varinfo_nml Input, <%d> time', i=(/i/)) ! 初期化 varkey = '' ! 変数キー file = '' ! 出力するファイル varname = '' ! 変数名 dimnum = 0 ! 依存する次元 dimnames(:)= '' ! 依存する次元 longname = '' ! 変数の記述的名称 units = '' ! 変数の単位 xtype = '' ! 変数の型 StepInterval = 0 ! 出力ステップ間隔 OutputStep = 0 ! 出力回数 ! read nml read(nmlunit, nml=varinfo_nml, iostat=nmlstat) call DbgMessage('Stat of NAMELIST varinfo_nml Input is <%d>', & & i=(/nmlstat/)) write(0, nml=varinfo_nml) ! Inquire access position inquire(nmlunit, position=position) if ( trim(position) /= 'APPEND' .and. nmlstat == 0 ) then next = .true. else next = .false. endif ! 有効でない値を含むものに関しては無視。 if (varkey == '' ) then call DbgMessage('var is blank. so this varinfo_nml is ignored.') if (next) cycle varinfo_nml_input if (.not. next) exit varinfo_nml_input elseif (dimnum < 1) then call DbgMessage('dimnum < 1. so this varinfo_nml is ignored.') if (next) cycle varinfo_nml_input if (.not. next) exit varinfo_nml_input endif !-------------------------------------------------------------- ! vars_store への格納 !-------------------------------------------------------------- ! vars_store の準備・拡張 j = j + 1 if ( .not. allocated(vars_store) ) then allocate( vars_store(1) ) ! 初期化 !!$ if ( associated(vars_store(1)%attrs) ) then !!$ deallocate( vars_store(1)%attrs ) !!$ endif else allocate( vars_store_tmp(j-1) ) call varinfo_copy( vars_store(1:j-1), vars_store_tmp(1:j-1) ) deallocate( vars_store ) allocate( vars_store(j) ) call varinfo_copy( vars_store_tmp(1:j-1), vars_store(1:j-1) ) deallocate( vars_store_tmp ) ! 初期化 !!$ if ( associated(vars_store(j)%attrs) ) then !!$ deallocate( vars_store(j)%attrs ) !!$ endif endif vars_store(j)%varkey = varkey vars_store(j)%file = file vars_store(j)%StepInterval = StepInterval vars_store(j)%OutputStep = OutputStep call HistoryVarinfoCreate(vars_store(j)%varinfo, & & varname, dimnames(1:dimnum), longname, units, xtype) !!$ vars_store(j)%varinfo%name = varname !!$ allocate( vars_store(j)%varinfo%dims( dimnum ) ) !!$ vars_store(j)%varinfo%dims = dimnames(1:dimnum) !!$ vars_store(j)%varinfo%longname = longname !!$ vars_store(j)%varinfo%units = units !!$ vars_store(j)%varinfo%xtype = xtype if (.not. next) exit varinfo_nml_input next = .false. ! 次回のための初期化 enddo varinfo_nml_input endif call nmlfile_close !---------------------------------------------------------------- ! read varinfo_attr_nml !---------------------------------------------------------------- call nmlfile_init call nmlfile_open(nmlunit, nmlreadable) if (.not. nmlreadable) then call DbgMessage('Not Read NAMELIST varinfo_attr_nml') call MessageNotify('W', subname, & & 'Can not Read NAMELIST varinfo_attr_nml.') else i = 0 next = .false. varinfo_attr_nml_input : do if ( .not. allocated(vars_store) ) then call DbgMessage('variables are not defined, so varinfo_attr_nml is ignored') exit varinfo_attr_nml_input endif i = i + 1 call DbgMessage('NAMELIST varinfo_attr_nml Input, <%d> time', i=(/i/)) ! 初期化 varattr = '' ! 属性を付加する変数名 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=varinfo_attr_nml, iostat=nmlstat) call DbgMessage('Stat of NAMELIST varinfo_attr_nml Input is <%d>', & & i=(/nmlstat/)) write(0, nml=varinfo_attr_nml) ! Inquire access position inquire(nmlunit, position=position) if ( trim(position) /= 'APPEND' .and. nmlstat == 0 ) then next = .true. else next = .false. endif ! 有効でない値を含むものに関しては無視。 if (varattr == '') then call DbgMessage('varattr is blank. so this varinfo_attr_nml is ignored.') if (next) cycle if (.not. next) exit varinfo_attr_nml_input elseif (attrname == '') then call DbgMessage('attrname is blank. so this varinfo_attr_nml is ignored.') if (next) cycle if (.not. next) exit varinfo_attr_nml_input elseif (attrtype == '') then call DbgMessage('attrtype is blank. so this varinfo_attr_nml is ignored.') if (next) cycle if (.not. next) exit varinfo_attr_nml_input endif ! varattr を vars_store のどこに格納すべきか探査して j に格納。 ! 対応するものが vars_store 内に無い場合は無視。 j = 0 do j = 1, size(vars_store) err = .false. call HistoryVarinfoInquire(vars_store(j)%varinfo, name=var_name) call DbgMessage('Search varname=<%c> in vars_store (<%c>)', & & c1=trim(varattr) , & & c2=trim(var_name) ) if ( trim(varattr) == trim(var_name) ) then exit endif err = .true. enddo if (err) then call DbgMessage('variable <%c> is not defined in varinfo_nml.'// & & ' So this varinfo_attr_nml is ignored.' , & & c1=trim(varattr) ) if (next) cycle if (.not. next) exit endif !-------------------------------------------------------------- ! vars_store%attrs への格納 !-------------------------------------------------------------- ! attrs(:) の拡張 !!$ if ( .not. associated(vars_store(j)%attrs) ) then !!$ allocate( vars_store(j)%attrs(1) ) !!$ k = 1 !!$ else !!$ k = size( vars_store(j)%attrs ) + 1 !!$ allocate( attrs_tmp(k-1) ) !!$ call varinfo_attrs_copy(vars_store(j)%attrs(1:k-1), attrs_tmp(1:k-1)) !!$ deallocate( vars_store(j)%attrs ) !!$ allocate( vars_store(j)%attrs(k) ) !!$ call varinfo_attrs_copy(attrs_tmp(1:k-1), vars_store(j)%attrs(1:k-1)) !!$ deallocate( attrs_tmp ) !!$ endif !!$ !!$ if (arraysize > 0) then !!$ call varinfo_attrs_init(vars_store(j)%attrs(k)) !!$ !!$ deallocate( vars_store(j)%attrs(k)%iarray ) !!$ deallocate( vars_store(j)%attrs(k)%rarray ) !!$ deallocate( vars_store(j)%attrs(k)%darray ) !!$ !!$ allocate( vars_store(j)%attrs(k)%iarray( arraysize ) ) !!$ allocate( vars_store(j)%attrs(k)%rarray( arraysize ) ) !!$ allocate( vars_store(j)%attrs(k)%darray( arraysize ) ) !!$ !!$ vars_store(j)%attrs(k)%array = .true. !!$ !!$ else !!$ call varinfo_attrs_init(vars_store(j)%attrs(k)) !!$ endif if (StrHead(attrtype, 'char')) then call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, cvalue) elseif (StrHead(attrtype, 'logical')) then call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, lvalue) elseif (StrHead(attrtype, 'int')) then if (arraysize > 0) then call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, iarray) else call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, ivalue) end if elseif (StrHead(attrtype, 'real')) then if (arraysize > 0) then call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, rarray) else call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, rvalue) end if elseif (StrHead(attrtype, 'double')) then if (arraysize > 0) then call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, darray) else call HistoryVarinfoAddAttr(vars_store(j) % varinfo, attrname, dvalue) end if end if !!$ vars_store(j)%attrs(k)%attrname = attrname !!$ vars_store(j)%attrs(k)%attrtype = attrtype !!$ vars_store(j)%attrs(k)%cvalue = cvalue !!$ vars_store(j)%attrs(k)%ivalue = ivalue !!$ vars_store(j)%attrs(k)%rvalue = rvalue !!$ vars_store(j)%attrs(k)%dvalue = dvalue !!$ vars_store(j)%attrs(k)%lvalue = lvalue !!$ vars_store(j)%attrs(k)%iarray(1:max(1,arraysize)) = iarray(1:max(1,arraysize)) !!$ vars_store(j)%attrs(k)%rarray(1:max(1,arraysize)) = rarray(1:max(1,arraysize)) !!$ vars_store(j)%attrs(k)%darray(1:max(1,arraysize)) = darray(1:max(1,arraysize)) !!$ if (.not. next) exit varinfo_attr_nml_input next = .false. ! 次回のための初期化 enddo varinfo_attr_nml_input end if call nmlfile_close call EndSub( subname ) end subroutine varinfo_init !=begin !=== Return Variable Information about varkey. ! !変数キー varkey に対応する変数情報 info を返す。 !stat にはステータスを返す。正常に変数情報が返れば 0, !varkey に対応する情報が無ければ 1, ((< varinfo_init >)) !による初期化が行なわれていない場合は -1 を返す。 ! subroutine varinfo_inquire(varkey, info, stat) !==== Dependency use type_mod, only: STRING, TOKEN, INTKIND, REKIND, DBKIND use dc_trace, only: DbgMessage, BeginSub, EndSub use dc_error, only: StoreError, USR_ERRNO !=end implicit none !=begin !==== Input ! character(*), intent(in) :: varkey ! 変数キー ! !==== Output ! type(VAR_INFO), intent(out) :: info ! VAR_INFO 変数 integer(INTKIND), intent(out) :: stat ! ステータス !=end integer(INTKIND) :: i character(STRING), parameter:: subname = "varinfo_inquire" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname ) if (.not. varinfo_initialized) then stat = -1 call EndSub( subname, 'Call varinfo_init before call %c. status=<%d>', & & c1=trim(subname), i=(/stat/) ) return endif !---------------------------------------------------------------- ! vars_store 内から、varkey に該当するものを探査する。 !---------------------------------------------------------------- do i = 1, size( vars_store ) ! varkey に該当するものが見つかったらそれを info に返す。 if ( trim(vars_store(i)%varkey) == trim(varkey) ) then info % varkey = vars_store(i) % varkey info % file = vars_store(i) % file info % StepInterval = vars_store(i) % StepInterval info % OutputStep = vars_store(i) % OutputStep call HistoryVarinfoCopy(& & varinfo_dest=info % varinfo, & & varinfo_src=vars_store(i) % varinfo) stat = 0 call EndSub( subname, 'varkey=<%c> is found. status=<%d>', & & c1=trim(varkey), i=(/stat/) ) return endif enddo !---------------------------------------------------------------- ! varkey に該当するものが無い場合は stat = 1 として返す。 !---------------------------------------------------------------- stat = 1 call EndSub( subname, 'varkey=<%c> is not found. status=<%d>', & & c1=trim(varkey), i=(/stat/) ) end subroutine varinfo_inquire !=begin !=== Terminate module ! !(()) で設定された値を破棄し、デフォルトに戻す。 ! subroutine varinfo_end !==== Dependency use dc_trace, only: DbgMessage, BeginSub, EndSub !=end implicit none character(STRING), parameter:: subname = "varinfo_end" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if ( .not. varinfo_initialized) then call EndSub( subname, 'varinfo_init was not called', & & c1=trim(subname) ) return else varinfo_initialized = .false. endif deallocate(vars_store) call EndSub( subname, 'vars_store is deallocated.' ) end subroutine varinfo_end !=begin !=== Copy VAR_INFO array. ! !varinfo_mod の内部サブルーチン。 !構造体 ((< VAR_INFO >)) の1次元配列のコピーを行なう。 ! subroutine varinfo_copy(from, to) !==== Dependency use type_mod , only: STRING, INTKIND use dc_trace , only: BeginSub, EndSub, DbgMessage use dc_string, only: JoinChar !=end implicit none !=begin !==== Input ! type(VAR_INFO), intent(in) :: from(:) ! !==== Output ! type(VAR_INFO), intent(out) :: to(:) !=end integer(INTKIND) :: i character(STRING) :: var_name character(STRING), parameter:: subname = "varinfo_copy" continue call BeginSub(subname) call DbgMessage('size(from)=<%d>, size(to)=<%d>, So copy <%d> times.', & & i=(/ size(from), size(to), min(size(from),size(to)) /) ) do i = 1, min( size(from), size(to) ) call HistoryVarinfoInquire(from(i) % varinfo, name=var_name) call DbgMessage('from(%d) [varkey=<%c> ' // & & 'file=<%c> varinfo-name=<%c>]' , & & c1=trim( from(i)%varkey ) , & & c2=trim( from(i)%file ) , & & c3=trim( var_name ) , & & i=(/ i /) ) to(i)%varkey = from(i)%varkey to(i)%file = from(i)%file to(i)%StepInterval = from(i)%StepInterval to(i)%OutputStep = from(i)%OutputStep call HistoryVarinfoCopy(& & varinfo_dest=to(i) % varinfo, varinfo_src=from(i) % varinfo) !!$ to(i)%varinfo%name = from(i)%varinfo%name !!$ to(i)%varinfo%longname = from(i)%varinfo%longname !!$ to(i)%varinfo%units = from(i)%varinfo%units !!$ to(i)%varinfo%xtype = from(i)%varinfo%xtype !!$ !!$ if ( associated(to(i)%varinfo%dims) ) then !!$ deallocate( to(i)%varinfo%dims ) !!$ endif !!$ if ( associated(from(i)%varinfo%dims) ) then !!$ allocate( to(i)%varinfo%dims( size(from(i)%varinfo%dims) ) ) !!$ to(i)%varinfo%dims(:) = from(i)%varinfo%dims(:) !!$ endif !!$ !!$ if ( associated(to(i)%attrs) ) then !!$ deallocate( to(i)%attrs ) !!$ endif !!$ if ( associated(from(i)%attrs) ) then !!$ allocate( to(i)%attrs( size(from(i)%attrs) ) ) !!$ call varinfo_attrs_copy( from(i)%attrs(:), to(i)%attrs(:) ) !!$ endif enddo call EndSub(subname) end subroutine varinfo_copy !!$ !=begin !!$ !=== Copy GT_HISTORY_ATTR array. !!$ ! !!$ !varinfo_mod の内部サブルーチン。 !!$ !構造体 (()) !!$ !の1次元配列のコピーを行なう。 !!$ ! !!$ subroutine varinfo_attrs_copy(from, to) !!$ !==== Dependency !!$ use type_mod, only: STRING, INTKIND !!$ use gt4_history, only: GT_HISTORY_ATTR !!$ use dc_trace, only: BeginSub, EndSub, DbgMessage !!$ !=end !!$ implicit none !!$ !=begin !!$ !==== Input !!$ ! !!$ type(GT_HISTORY_ATTR), intent(in) :: from(:) !!$ ! !!$ !==== Output !!$ ! !!$ type(GT_HISTORY_ATTR), intent(out) :: to(:) !!$ !=end !!$ integer(INTKIND) :: i !!$ character(STRING), parameter:: subname = "varinfo_attrs_copy" !!$ continue !!$ !!$ call BeginSub(subname) !!$ !!$ call DbgMessage('size(from)=<%d>, size(to)=<%d>, So copy <%d> times.', & !!$ & i=(/ size(from), size(to), min(size(from),size(to)) /) ) !!$ !!$ do i = 1, min( size(from), size(to) ) !!$ call DbgMessage('from(%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( from(i)%attrname ) , & !!$ & c2=trim( from(i)%attrtype ) , & !!$ & c3=trim( from(i)%cvalue ) , & !!$ & i=(/ i, from(i)%ivalue , & !!$ & size(from(i)%iarray) , & !!$ & from(i)%iarray , & !!$ & size(from(i)%rarray) , & !!$ & size(from(i)%darray) & !!$ & /) , & !!$ & r=(/from(i)%rvalue, from(i)%rarray/) , & !!$ & d=(/from(i)%dvalue, from(i)%darray/) , & !!$ & l=(/from(i)%lvalue/) ) !!$ !!$ allocate( to(i)%iarray( size(from(i)%iarray) ) ) !!$ allocate( to(i)%rarray( size(from(i)%rarray) ) ) !!$ allocate( to(i)%darray( size(from(i)%darray) ) ) !!$ !!$ to(i)%attrname = from(i)%attrname !!$ to(i)%attrtype = from(i)%attrtype !!$ to(i)%array = from(i)%array !!$ to(i)%cvalue = from(i)%cvalue !!$ to(i)%ivalue = from(i)%ivalue !!$ to(i)%rvalue = from(i)%rvalue !!$ to(i)%dvalue = from(i)%dvalue !!$ to(i)%lvalue = from(i)%lvalue !!$ to(i)%iarray(:) = from(i)%iarray(:) !!$ to(i)%rarray(:) = from(i)%rarray(:) !!$ to(i)%darray(:) = from(i)%darray(:) !!$ enddo !!$ !!$ call EndSub(subname) !!$ end subroutine varinfo_attrs_copy !=begin !!$ !=== Initialize GT_HISTORY_ATTR variable. !!$ ! !!$ !varinfo_mod の内部サブルーチン。 !!$ !構造体 (()) !!$ !変数の初期化を行なう。 !!$ ! !!$ subroutine varinfo_attrs_init0(attrs) !!$ !==== Dependency !!$ use type_mod, only: STRING, INTKIND !!$ use gt4_history, only: GT_HISTORY_ATTR !!$ use dc_trace, only: BeginSub, EndSub, DbgMessage !!$ !=end !!$ implicit none !!$ !=begin !!$ !==== In/Out !!$ ! !!$ type(GT_HISTORY_ATTR), intent(inout):: attrs !!$ !=end !!$ character(STRING), parameter:: subname = "varinfo_attrs_init0" !!$ continue !!$ !!$ call BeginSub(subname) !!$ !!$ allocate( attrs%iarray( 1 ) ) !!$ allocate( attrs%rarray( 1 ) ) !!$ allocate( attrs%darray( 1 ) ) !!$ !!$ attrs%attrname = '' !!$ attrs%attrtype = '' !!$ attrs%array = .false. !!$ attrs%cvalue = '' !!$ attrs%ivalue = 0 !!$ attrs%rvalue = 0.0 !!$ attrs%dvalue = 0.0d0 !!$ attrs%lvalue = .false. !!$ attrs%iarray(:) = 0 !!$ attrs%rarray(:) = 0.0 !!$ attrs%darray(:) = 0.0d0 !!$ !!$ call DbgMessage('Initialize attrs [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( attrs%attrname ) , & !!$ & c2=trim( attrs%attrtype ) , & !!$ & c3=trim( attrs%cvalue ) , & !!$ & i=(/ attrs%ivalue , & !!$ & size(attrs%iarray) , & !!$ & attrs%iarray , & !!$ & size(attrs%rarray) , & !!$ & size(attrs%darray) & !!$ & /) , & !!$ & r=(/attrs%rvalue, attrs%rarray/) , & !!$ & d=(/attrs%dvalue, attrs%darray/) , & !!$ & l=(/attrs%lvalue/) ) !!$ !!$ call EndSub(subname) !!$ end subroutine varinfo_attrs_init0 !!$ !!$ !!$ !=begin !!$ !=== Initialize GT_HISTORY_ATTR variable. !!$ ! !!$ !varinfo_mod の内部サブルーチン。 !!$ !構造体 (()) !!$ !の1次元配列の初期化を行なう。 !!$ ! !!$ subroutine varinfo_attrs_init1(attrs) !!$ !==== Dependency !!$ use type_mod, only: STRING, INTKIND !!$ use gt4_history, only: GT_HISTORY_ATTR !!$ use dc_trace, only: BeginSub, EndSub, DbgMessage !!$ !=end !!$ implicit none !!$ !=begin !!$ !==== In/Out !!$ ! !!$ type(GT_HISTORY_ATTR), intent(inout):: attrs(:) !!$ !=end !!$ integer(INTKIND) :: i !!$ character(STRING), parameter:: subname = "varinfo_attrs_init1" !!$ continue !!$ !!$ call BeginSub(subname) !!$ !!$ call DbgMessage('size(attrs)=<%d>' , i=(/size(attrs)/) ) !!$ !!$ do i = 1, size(attrs) !!$ call varinfo_attrs_init(attrs(i)) !!$ enddo !!$ !!$ call EndSub(subname) !!$ end subroutine varinfo_attrs_init1 end module varinfo_mod