!--------------------------------------------------------------------- ! Copyright (C) GFD Dennou Club, 2005. All rights reserved. !--------------------------------------------------------------------- !=begin != Module io_gt4_out_mod ! ! * Developers: Morikawa Yasuhiro ! * Version: $Id: io_gt4_out.f90,v 1.3 2006/07/25 03:16:27 morikawa Exp $ ! * Tag Name: $Name: $ ! * Change History: ! !== Overview ! !This module output data with gtool4 netCDF conventions. ! !gtool4 netCDF 規約に基づくデータを出力する。 ! !== Error Handling ! !== Known Bugs ! ! * 1つのファイルに異なる StepInterval が設定される場合、 ! HistoryCreate には先に設定されたものの StepInterval で時間間隔を ! 決めるため、後で設定した変数の StepInterval が前のものよりも ! 小さい場合には整合的でなくなる。 ! ! * 回避方法 ! * 異なる StepInterval を設定する場合にはそれらは ! 別個のファイルに分ける。 ! !== Note ! !== Future Plans ! ! !=end module io_gt4_out_mod !=begin !== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use axis_type_mod, only : AXISINFO use gt4_history, only : GT_HISTORY use gt4_history, only : HistoryVarinfoCreate, HistoryVarinfoCopy use gt4_history, only : HistoryVarinfoAddAttr, HistoryVarinfoInquire use gt4_history, only : HistoryVarinfoClear use gt4_history, only : HistoryAxisCreate, HistoryAxisCopy use gt4_history, only : HistoryAxisAddAttr, HistoryAxisInquire use gt4_history, only : HistoryAxisClear !=end implicit none !=begin !== Public Interface private public :: io_gt4_out_init, io_gt4_out_end ! subroutines public :: io_gt4_out_SetDims ! subroutines public :: io_gt4_out_SetVars, io_gt4_out_Put ! subroutines ! !== Generic Procedure ! interface io_gt4_out_Put module procedure io_gt4_out_Put3Real module procedure io_gt4_out_Put2Real module procedure io_gt4_out_Put0Real module procedure io_gt4_out_Put3Double module procedure io_gt4_out_Put2Double module procedure io_gt4_out_Put0Double end interface ! !== Derived Types ! !出力変数データ格納用構造体。((< io_gt4_out_SetVars >)) で設定。 ! type IO_GT4_OUT_VARS character(STRING), pointer:: varkeys(:) =>null()! 変数キー character(STRING) :: file ! 出力ファイル type(GT_HISTORY) :: gt_history ! GT_HISTORY 変数 logical :: created ! HistoryCreate 済かどうか type(IO_GT4_OUT_VARS), pointer :: next end type IO_GT4_OUT_VARS !=end !------------------------------------------------------------------- ! 出力ファイル設定。(モジュールで保持) !------------------------------------------------------------------- character(STRING), save :: & & file_save , & ! 出力ファイル名 (デフォルト) & title_save , & ! タイトル & source_save , & ! モデル名 (作成手段) & institution_save ! 実行者名 (作成者) !------------------------------------------------------------------- ! 次元データ格納用構造体。io_gt4_out_SetDims で設定。 !------------------------------------------------------------------- type(AXISINFO), save, allocatable :: axes_store(:) logical , save :: axes_store_used = .false. type(IO_GT4_OUT_VARS), save, pointer:: vars_output logical, save :: vars_output_used logical, save :: io_gt4_out_initialized = .false. character(STRING),parameter:: version = & & '$Id: io_gt4_out.f90,v 1.3 2006/07/25 03:16:27 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 io_gt4_out_init !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use nmlfile_mod, only : nmlfile_init, nmlfile_open, nmlfile_close use time_mod, only : time_init use varinfo_mod, only : varinfo_init use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage use dc_message, only : MessageNotify !=end implicit none !=begin ! !==== NAMELIST ! !出力ファイル設定。 !file に与えたものがデフォルトの出力ファイルとなる。 !その他の情報は出力する gtool4 netCDF データの大域データとして !与えられる。 ! character(STRING) :: & & file = 'result.nc' , & ! 出力ファイル名 (デフォルト) & title = 'GCM Test' , & ! タイトル & source = 'DCPAM' , & ! モデル名 (作成手段) & institution = 'GFD Dennou Club' ! 実行者名 (作成者) namelist /io_gt4_out_nml/ & & file , & ! 出力ファイル名 (デフォルト) & title , & ! タイトル & source , & ! モデル名 (作成手段) & institution ! 実行者名 (作成者) !=end !----- 作業用内部変数 ----- integer(INTKIND) :: nmlstat, nmlunit logical :: nmlreadable character(STRING), parameter:: subname = "io_gt4_out_init" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if (io_gt4_out_initialized) then call EndSub( subname, '%c is already called', c1=trim(subname) ) return else io_gt4_out_initialized = .true. endif !---------------------------------------------------------------- ! Version identifier !---------------------------------------------------------------- call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname)) !---------------------------------------------------------------- ! read io_gt4_out_nml !---------------------------------------------------------------- ! Initialization file = 'result.nc' ! 出力ファイル名 (デフォルト) title = 'GCM Test' ! タイトル source = 'DCPAM' ! モデル名 (作成手段) institution = 'GFD Dennou Club' ! 実行者名 (作成者) call nmlfile_init call nmlfile_open(nmlunit, nmlreadable) if (nmlreadable) then read(nmlunit, nml=io_gt4_out_nml, iostat=nmlstat) call DbgMessage('Stat of NAMELIST io_gt4_out_nml Input is <%d>', & & i=(/nmlstat/)) write(0, nml=io_gt4_out_nml) else call DbgMessage('Not Read NAMELIST io_gt4_out_nml') call MessageNotify('W', subname, & & 'Can not Read NAMELIST io_gt4_out_nml. Force Use Default Value.') end if call nmlfile_close !---------------------------------------------------------------- ! receive NAMELIST information !---------------------------------------------------------------- file_save = file title_save = title source_save = source institution_save = institution !---------------------------------------------------------------- ! time_mod の初期化ルーチン time_init を呼ぶ。 !---------------------------------------------------------------- call time_init !---------------------------------------------------------------- ! varinfo_mod の初期化ルーチン varinfo_init を呼ぶ。 !---------------------------------------------------------------- call varinfo_init call EndSub(subname) end subroutine io_gt4_out_init !=begin !=== Set Dimension ! !出力する gtool4 netCDF データの座標情報を設定する。 !複数回呼ぶ事で複数の座標を設定する。 !現在の所、設定した座標は出力する全ての netCDF ファイルに !出力される。 ! subroutine io_gt4_out_SetDims(axis) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use axis_type_mod, only : AXISINFO, axis_type_copy use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage !=end implicit none !=begin !==== Input ! type(AXISINFO), intent(in) :: axis !=end !----- 作業用内部変数 ----- type(AXISINFO), allocatable :: axes_store_tmp(:) character(STRING) :: axis_name character(STRING), parameter:: subname = "io_gt4_out_SetDims" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) call HistoryAxisInquire(axis % axisinfo, name=axis_name) call DbgMessage('dimname=<%c>', c1=trim(axis_name) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !---------------------------------------------------------------- ! 次元名と次元データを axes_store 構造体に格納 !---------------------------------------------------------------- ! 初回のデータ入力 if (.not. axes_store_used) then call DbgMessage('axes_store_used = %b. allocate(axes_store_used(1))', & & l=(/axes_store_used/)) allocate( axes_store(1) ) axes_store_used = .true. call axis_type_copy( axis, axes_store(1) ) call DbgMessage('Store axis=<%c> to axes_store(1).', & & c1=trim(axis_name) ) ! 2 回目以降 else call DbgMessage('axes_store_used = %b. allocate(axes_store_used(%d))', & & l=(/axes_store_used/), i=(/size(axes_store)+1/)) allocate( axes_store_tmp(size(axes_store)) ) call axis_type_copy( & & axes_store(1:size(axes_store)), & & axes_store_tmp(1:size(axes_store)) ) deallocate(axes_store) allocate( axes_store(size(axes_store_tmp)+1) ) call axis_type_copy( & & axes_store_tmp(1:size(axes_store_tmp)), & & axes_store(1:size(axes_store_tmp)) ) call axis_type_copy( axis, axes_store(size(axes_store)) ) call DbgMessage('Store axis=<%c> to axes_store(%d).', & & c1=trim(axis_name), i=(/size(axes_store)/)) endif call EndSub(subname) end subroutine io_gt4_out_SetDims !=begin !=== Set Variables ! !出力する変数を設定する。 !複数回呼ぶ事で複数の変数を設定できる。 !このサブルーチンで設定するのは変数キー varkey のみであり、 !具体的な情報は ((< varinfo_mod >)) の ((< varinfo_init >)) にて !NAMELIST ((< varinfo_nml >)) で設定される。 !(本来は、デフォルトの値はプログラム無いにハードコードすべきかも知れない)。 ! subroutine io_gt4_out_SetVars(varkey) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use time_mod, only : InitTime, DelTime, StepInterval, & & tvar, ttype, tname, tunit use varinfo_mod, only : varinfo_inquire, VAR_INFO use gt4_history, only : GT_HISTORY , GT_HISTORY_AXIS , & & HistoryCreate, HistoryAddVariable , & & HistoryCopyVariable , & & HistoryAddAttr, HistoryPut use gt4_history,only: HistoryVarinfoInquire use dc_string, only : JoinChar use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage !=end implicit none !=begin !==== Input ! character(*), intent(in) :: varkey ! 変数キー !=end !----- 作業用内部変数 ----- type(VAR_INFO) :: info ! varinfo_mod データ格納 character(STRING) :: output_file ! デフォルト出力ファイル character(STRING), allocatable:: var_tmp(:) type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 type(IO_GT4_OUT_VARS), pointer:: vars_tmp2 type(GT_HISTORY_AXIS), allocatable :: axes_gt4(:) ! 次元情報格納変数 integer(INTKIND) :: i, stat integer(INTKIND) :: StepIntervalTmp character(STRING) :: axis_name character(STRING), parameter:: subname = "io_gt4_out_SetVars" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !----------------------------------------------------------------- ! varinfo モジュールより、var をキーにして情報を取得 !----------------------------------------------------------------- call varinfo_inquire & & ( varkey , & ! intent(in) : 変数キー & info , & ! intent(out): VAR_INFO データ & stat ) ! intent(out): ステータス if (stat > 0) then call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', & & c1=trim(varkey) ) return endif if ( info%StepInterval < 1 ) then StepIntervalTmp = StepInterval ! in time_mod else StepIntervalTmp = info%StepInterval ! in varinfo_mod end if !----------------------------------------------------------------- ! ファイル名が空 (または空白) の場合はデフォルトの値を用いる。 !----------------------------------------------------------------- if ( trim(info%file) == '' ) then output_file = file_save else output_file = info%file endif call DbgMessage('Varkey=<%c> is output to file=<%c>.' , & & c1=trim(varkey), c2=(trim(output_file)) ) !----------------------------------------------------------------- ! 変数キーと出力ファイルを vars_output 構造体に格納 !----------------------------------------------------------------- ! 初回のデータ入力 if (.not. vars_output_used) then call DbgMessage('vars_output_used = %b. allocate(vars_output_used(1))', & & l=(/vars_output_used/) ) allocate(vars_output) vars_output_used = .true. ! 変数キーとデータの格納 allocate(vars_output%next) allocate(vars_output%next%varkeys(1)) vars_output%next%varkeys(1) = varkey vars_output%next%file = output_file vars_output%next%created = .false. nullify(vars_output%next%next) vars_tmp1 => vars_output%next call DbgMessage('store vars_output [varkeys(1)=<%c>, file=<%c>]' , & & c1=trim(vars_tmp1%varkeys(1)), c2=trim(vars_tmp1%file) ) ! 2 回目以降 else call DbgMessage('vars_output_used = %b.', l=(/vars_output_used/) ) vars_tmp1 => vars_output vars_tmp2 => vars_tmp1%next ! データが格納されていないか、file が同じところまで進む do if ( associated(vars_tmp2) ) then call DbgMessage('Search vars_output ' // & & '[varkeys(:)=<%c>, file=<%c>, created=<%b>].', & & c1=trim( JoinChar(vars_tmp2%varkeys(:)) ) , & & c2=trim( vars_tmp2%file ) , & & l=(/vars_tmp2%created/) ) if ( trim(vars_tmp2%file) == trim(output_file) ) then call DbgMessage('file=<%c> is already created. ' // & & 'Existing vars=<%c> ', & & c1=trim( vars_tmp2%file ) , & & c2=trim( JoinChar(vars_tmp2%varkeys(:)) ) ) vars_tmp1 => vars_tmp2 exit endif elseif ( .not. associated(vars_tmp2) ) then call DbgMessage('file=<%c> is not created. ', & & c1=trim( vars_tmp1%file ) ) allocate(vars_tmp1%next) vars_tmp1 => vars_tmp1%next exit endif vars_tmp1 => vars_tmp2 vars_tmp2 => vars_tmp1%next enddo ! ! 変数キーと出力ファイルの格納 ! ! 既に同じ出力ファイル名が存在する場合 if ( associated(vars_tmp1%varkeys) ) then allocate( var_tmp(size(vars_tmp1%varkeys)) ) var_tmp(:) = vars_tmp1%varkeys(:) deallocate(vars_tmp1%varkeys) allocate( vars_tmp1%varkeys(size(var_tmp) + 1) ) vars_tmp1%varkeys(1:size(var_tmp)) = var_tmp(:) vars_tmp1%varkeys( size(var_tmp) + 1) = varkey deallocate(var_tmp) ! 新規の出力ファイル名の場合 else allocate( vars_tmp1%varkeys(1) ) vars_tmp1%varkeys(1) = varkey vars_tmp1%file = output_file vars_tmp1%created = .false. endif call DbgMessage('store vars_output [varkeys(%d)=<%c>, file=<%c>]', & & i=(/size(vars_tmp1%varkeys)/) , & & c1=trim( vars_tmp1%varkeys(size(vars_tmp1%varkeys)) ) , & & c2=trim( vars_tmp1%file ) ) nullify(vars_tmp1%next) endif !----------------------------------------------------------------- ! axes_store から次元情報格納構造体 GT_HISTORY_AXIS 変数作成 !----------------------------------------------------------------- if (axes_store_used) then call DbgMessage('Generate gtool4 axes data from axes_store(1:%d).', & & i=(/size(axes_store)/)) ! 時間次元用に1つ多めに確保 allocate( axes_gt4(size(axes_store) + 1) ) do i = 1, size(axes_store) axes_gt4(i) = axes_store(i)%axisinfo enddo else call DbgMessage('Can not Generate gtool4 axes data Because axes_store is not found.') endif !----------------------------------------------------------------- ! axes_gt4 に時間の次元を追加 !----------------------------------------------------------------- if (.not. allocated(axes_gt4)) then allocate( axes_gt4(1) ) endif call HistoryAxisCreate(axes_gt4(size(axes_gt4)), & & tvar, 0, tname, tunit, ttype) !!$ axes_gt4( size(axes_gt4) )%name = tvar !!$ axes_gt4( size(axes_gt4) )%length = 0 !!$ axes_gt4( size(axes_gt4) )%longname = tname !!$ axes_gt4( size(axes_gt4) )%units = tunit !!$ axes_gt4( size(axes_gt4) )%xtype = ttype !----------------------------------------------------------------- ! HistoryCreate (io_gt4_out_init で取得した情報を用いる) !----------------------------------------------------------------- if ( .not. vars_tmp1%created) then call HistoryCreate( & ! ヒストリー作成 & file=trim(vars_tmp1%file), & ! intent(in) : 出力ファイル名 & title=trim(title_save) , & ! intent(in) : タイトル & source=trim(source_save) , & ! intent(in) : 作成手段 & institution=trim(institution_save) , & ! intent(in) : 作成者 & axes=axes_gt4 , & ! intent(in) : 次元データ全て & origin=real(InitTime) , & ! intent(in) : 時間の原点 & interval=real(StepIntervalTmp*DelTime), & ! intent(in) : 出力時間間隔 & history=vars_tmp1%gt_history ) ! intent(out): GT_HISTORY vars_tmp1%created = .true. else call DbgMessage('file=<%c> is already created', c1=trim(vars_tmp1%file) ) endif !----------------------------------------------------------------- ! HistoryPut [in gt4f90io] による次元データの設定 !----------------------------------------------------------------- do i = 1, size(axes_store) call HistoryAxisInquire(axes_store(i) % axisinfo, name=axis_name) call HistoryPut & & ( axis_name, & ! intent(in) : 次元名 & axes_store(i)%a_Dim , & ! intent(in) : 次元データ & vars_tmp1%gt_history ) ! intent(inout): GT_HISTORY enddo !!$ !----------------------------------------------------------------- !!$ ! HistoryAddAttr [in gt4f90io] による次元データへの属性の設定 !!$ !----------------------------------------------------------------- !!$ do i = 1, size(axes_store) !!$ if (associated(axes_store(i)%attrs) ) then !!$ call HistoryAddAttr & !!$ & ( axes_store(i)%axisinfo%name , & ! intent(in): 次元名 !!$ & axes_store(i)%attrs , & ! intent(in): 属性情報 !!$ & vars_tmp1%gt_history ) ! intent(inout): GT_HISTORY !!$ endif !!$ enddo !----------------------------------------------------------------- ! HistoryAddVariable [in gt4f90io] による変数の設定 !----------------------------------------------------------------- call HistoryAddVariable( & & varinfo=info%varinfo , & ! intent(in): GT_HISTORY_VARINFO & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY !----------------------------------------------------------------- ! HistoryCopyVariable [in gt4f90io] による変数の設定 !----------------------------------------------------------------- !!$ call HistoryCopyVariable( & !!$ & file=trim(info_file) , & ! intent(in) : コピー元ファイル !!$ & varkey=trim( vars_tmp1%varkeys(size(vars_tmp1%varkeys)) ), & !!$ & ! intent(in) : 変数名 !!$ & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY !!$ !----------------------------------------------------------------- !!$ ! HistoryAddAttr [in gt4f90io] による変数への属性付加 !!$ !----------------------------------------------------------------- !!$ if (associated(info%attrs) ) then !!$ call HistoryAddAttr( & !!$ & varname=info%varinfo%name , & ! intent(in): 変数名 !!$ & attrs=info%attrs , & ! intent(in): GT_HISTORY_ATTR !!$ & history=vars_tmp1%gt_history )! intent(inout) : GT_HISTORY !!$ endif call EndSub(subname) end subroutine io_gt4_out_SetVars !=begin !=== Put 3-Dimensional Single Precision Data to netCDF file ! !変数キー varkey にデータ xyz_Var を出力する。 !((< varinfo_mod >)) の ((< varinfo_init >)) の !NAMELIST ((< varinfo_nml >)) で対応する varkey が !与えられていない場合、データは出力されない。 ! !各 varkey に対応する ((< varinfo_mod >)) の StepInterval および !OutputStep と、((< time_mod >)) の CurrentLoop から、 !出力するタイミングが正しいかどうかをチェックして出力する。 !出力するタイミングでないと判定された場合は何もせずに終了する。 !なお、((< varinfo_mod >)) の StepInterval および OutputStep が !無効な値 (ゼロ以下) の場合には ((< time_mod >)) の StepInterval !と OutputStep が用いられる。具体的な判定方法は以下の通りである。 ! ! * CurrentLoop を StepInterval で割り、余りが 0 の場合には出力。 ! * CurrentLoop が StepInterval * OutputStep よりも ! 大きくなってしまったら以降出力は行なわない。 ! subroutine io_gt4_out_Put3Real(varkey, xyz_Var) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use time_mod, only : StepInterval, OutputStep, CurrentLoop use varinfo_mod, only : varinfo_inquire, VAR_INFO use gt4_history, only : HistoryPut, HistoryVarinfoInquire use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage use dc_message, only : MessageNotify !=end implicit none !=begin !==== Input ! character(*), intent(in):: varkey ! 変数名 real(REKIND), intent(in):: xyz_Var(:,:,:) ! 出力データ !=end !----- 作業用内部変数 ----- type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 integer(INTKIND) :: i, stat logical :: hit_vars_output = .false. type(VAR_INFO) :: info integer(INTKIND) :: StepIntervalTmp integer(INTKIND) :: OutputStepTmp character(STRING) :: var_name character(STRING), parameter:: subname = "io_gt4_out_Put3Real" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !----------------------------------------------------------------- ! Get Information from varinfo_mod about varkey. !----------------------------------------------------------------- call varinfo_inquire & & ( varkey , & ! intent(in) : 変数キー & info , & ! intent(out): VAR_INFO データ & stat ) ! intent(out): ステータス if (stat > 0) then call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', & & c1=trim(varkey) ) return endif !----------------------------------------------------------------- ! Check CurrentLoop in time_mod !----------------------------------------------------------------- if ( info%StepInterval < 1 ) then StepIntervalTmp = StepInterval ! in time_mod else StepIntervalTmp = info%StepInterval ! in varinfo_mod end if if ( info%OutputStep < 1 ) then OutputStepTmp = OutputStep ! in time_mod else OutputStepTmp = info%OutputStep ! in varinfo_mod end if if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then call EndSub( subname, & & 'This is not Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then call EndSub( subname, & & 'Already CurrentLoop exceed StepInterval*OutputStep. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if !----------------------------------------------------------------- ! Search vars_output for varkey's infomation. !----------------------------------------------------------------- hit_vars_output = .false. vars_tmp1 => vars_output%next do if ( .not. associated(vars_tmp1) ) then call MessageNotify('E', subname, & & message='Varkey is not found.') elseif ( associated(vars_tmp1%varkeys) ) then do i = 1, size(vars_tmp1%varkeys) if ( varkey == vars_tmp1%varkeys(i) ) then hit_vars_output = .true. endif call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', & & i=(/i/) , & & c1=trim( vars_tmp1%varkeys(i) ) , & & c2=trim( vars_tmp1%file ) ) call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) ) enddo endif if (hit_vars_output) exit vars_tmp1 => vars_tmp1%next enddo !----------------------------------------------------------------- ! Output by HistoryPut [in gt4f90io] !----------------------------------------------------------------- call HistoryVarinfoInquire(info % varinfo, name=var_name) call HistoryPut( & & varname=var_name , & ! intent(in) : 変数名 & array=xyz_Var , & ! intent(in) : 出力値 & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY call EndSub( subname, & & 'This is Just Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) end subroutine io_gt4_out_Put3Real !=begin !=== Put 2-Dimensional Single Precision Data to netCDF file ! !機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 !ただしこちらは単精度実数 2 次元のデータを出力する。 ! subroutine io_gt4_out_Put2Real(varkey, xy_Var) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use time_mod, only : StepInterval, OutputStep, CurrentLoop use varinfo_mod, only : varinfo_inquire, VAR_INFO use gt4_history, only : HistoryPut, HistoryVarinfoInquire use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage use dc_message, only : MessageNotify !=end implicit none !=begin !==== Input ! character(*), intent(in):: varkey ! 変数名 real(REKIND), intent(in):: xy_Var(:,:) ! 出力データ !=end !----- 作業用内部変数 ----- type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 integer(INTKIND) :: i, stat logical :: hit_vars_output = .false. type(VAR_INFO) :: info integer(INTKIND) :: StepIntervalTmp integer(INTKIND) :: OutputStepTmp character(STRING) :: var_name character(STRING), parameter:: subname = "io_gt4_out_Put2Real" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !----------------------------------------------------------------- ! Get Information from varinfo_mod about varkey. !----------------------------------------------------------------- call varinfo_inquire & & ( varkey , & ! intent(in) : 変数キー & info , & ! intent(out): VAR_INFO データ & stat ) ! intent(out): ステータス if (stat > 0) then call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', & & c1=trim(varkey) ) return endif !----------------------------------------------------------------- ! Check CurrentLoop in time_mod !----------------------------------------------------------------- if ( info%StepInterval < 1 ) then StepIntervalTmp = StepInterval ! in time_mod else StepIntervalTmp = info%StepInterval ! in varinfo_mod end if if ( info%OutputStep < 1 ) then OutputStepTmp = OutputStep ! in time_mod else OutputStepTmp = info%OutputStep ! in varinfo_mod end if if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then call EndSub( subname, & & 'This is not Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then call EndSub( subname, & & 'Already CurrentLoop exceed StepInterval*OutputStep. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if !----------------------------------------------------------------- ! Search vars_output for varkey's infomation. !----------------------------------------------------------------- hit_vars_output = .false. vars_tmp1 => vars_output%next do if ( .not. associated(vars_tmp1) ) then call MessageNotify('E', subname, & & message='Varkey is not found.') elseif ( associated(vars_tmp1%varkeys) ) then do i = 1, size(vars_tmp1%varkeys) if ( varkey == vars_tmp1%varkeys(i) ) then hit_vars_output = .true. endif call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', & & i=(/i/) , & & c1=trim( vars_tmp1%varkeys(i) ) , & & c2=trim( vars_tmp1%file ) ) call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) ) enddo endif if (hit_vars_output) exit vars_tmp1 => vars_tmp1%next enddo !----------------------------------------------------------------- ! Output by HistoryPut [in gt4f90io] !----------------------------------------------------------------- call HistoryVarinfoInquire(info % varinfo, name=var_name) call HistoryPut( & & varname=var_name , & ! intent(in) : 変数名 & array=xy_Var , & ! intent(in) : 出力値 & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY call EndSub( subname, & & 'This is Just Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) end subroutine io_gt4_out_Put2Real !=begin !=== Put 0-Dimensional Single Precision Data to netCDF file ! !機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 !ただしこちらは単精度実数 0 次元のデータを出力する。 ! subroutine io_gt4_out_Put0Real(varkey, Var) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use time_mod, only : StepInterval, OutputStep, CurrentLoop use varinfo_mod, only : varinfo_inquire, VAR_INFO use gt4_history, only : HistoryPut, HistoryVarinfoInquire use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage use dc_message, only : MessageNotify !=end implicit none !=begin !==== Input ! character(*), intent(in):: varkey ! 変数名 real(REKIND), intent(in):: Var ! 出力データ !=end !----- 作業用内部変数 ----- type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 integer(INTKIND) :: i, stat logical :: hit_vars_output = .false. type(VAR_INFO) :: info integer(INTKIND) :: StepIntervalTmp integer(INTKIND) :: OutputStepTmp character(STRING) :: var_name character(STRING), parameter:: subname = "io_gt4_out_Put0Real" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !----------------------------------------------------------------- ! Get Information from varinfo_mod about varkey. !----------------------------------------------------------------- call varinfo_inquire & & ( varkey , & ! intent(in) : 変数キー & info , & ! intent(out): VAR_INFO データ & stat ) ! intent(out): ステータス if (stat > 0) then call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', & & c1=trim(varkey) ) return endif !----------------------------------------------------------------- ! Check CurrentLoop in time_mod !----------------------------------------------------------------- if ( info%StepInterval < 1 ) then StepIntervalTmp = StepInterval ! in time_mod else StepIntervalTmp = info%StepInterval ! in varinfo_mod end if if ( info%OutputStep < 1 ) then OutputStepTmp = OutputStep ! in time_mod else OutputStepTmp = info%OutputStep ! in varinfo_mod end if if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then call EndSub( subname, & & 'This is not Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then call EndSub( subname, & & 'Already CurrentLoop exceed StepInterval*OutputStep. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if !----------------------------------------------------------------- ! Search vars_output for varkey's infomation. !----------------------------------------------------------------- hit_vars_output = .false. vars_tmp1 => vars_output%next do if ( .not. associated(vars_tmp1) ) then call MessageNotify('E', subname, & & message='Varkey is not found.') elseif ( associated(vars_tmp1%varkeys) ) then do i = 1, size(vars_tmp1%varkeys) if ( varkey == vars_tmp1%varkeys(i) ) then hit_vars_output = .true. endif call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', & & i=(/i/) , & & c1=trim( vars_tmp1%varkeys(i) ) , & & c2=trim( vars_tmp1%file ) ) call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) ) enddo endif if (hit_vars_output) exit vars_tmp1 => vars_tmp1%next enddo !----------------------------------------------------------------- ! Output by HistoryPut [in gt4f90io] !----------------------------------------------------------------- call HistoryVarinfoInquire(info % varinfo, name=var_name) call HistoryPut( & & varname=var_name , & ! intent(in) : 変数名 & value=Var , & ! intent(in) : 出力値 & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY call EndSub( subname, & & 'This is Just Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) end subroutine io_gt4_out_Put0Real !=begin !=== Put 3-Dimensional Double Precision Data to netCDF file ! !機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 !ただしこちらは倍精度実数 3 次元のデータを出力する。 ! subroutine io_gt4_out_Put3Double(varkey, xyz_Var) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use time_mod, only : StepInterval, OutputStep, CurrentLoop use varinfo_mod, only : varinfo_inquire, VAR_INFO use gt4_history, only : HistoryPut, HistoryVarinfoInquire use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage use dc_message, only : MessageNotify !=end implicit none !=begin !==== Input ! character(*), intent(in):: varkey ! 変数名 real(DBKIND), intent(in):: xyz_Var(:,:,:) ! 出力データ !=end !----- 作業用内部変数 ----- type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 integer(INTKIND) :: i, stat logical :: hit_vars_output = .false. type(VAR_INFO) :: info integer(INTKIND) :: StepIntervalTmp integer(INTKIND) :: OutputStepTmp character(STRING) :: var_name character(STRING), parameter:: subname = "io_gt4_out_Put3Double" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !----------------------------------------------------------------- ! Get Information from varinfo_mod about varkey. !----------------------------------------------------------------- call varinfo_inquire & & ( varkey , & ! intent(in) : 変数キー & info , & ! intent(out): VAR_INFO データ & stat ) ! intent(out): ステータス if (stat > 0) then call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', & & c1=trim(varkey) ) return endif !----------------------------------------------------------------- ! Check CurrentLoop in time_mod !----------------------------------------------------------------- if ( info%StepInterval < 1 ) then StepIntervalTmp = StepInterval ! in time_mod else StepIntervalTmp = info%StepInterval ! in varinfo_mod end if if ( info%OutputStep < 1 ) then OutputStepTmp = OutputStep ! in time_mod else OutputStepTmp = info%OutputStep ! in varinfo_mod end if if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then call EndSub( subname, & & 'This is not Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then call EndSub( subname, & & 'Already CurrentLoop exceed StepInterval*OutputStep. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if !----------------------------------------------------------------- ! Search vars_output for varkey's infomation. !----------------------------------------------------------------- hit_vars_output = .false. vars_tmp1 => vars_output%next do if ( .not. associated(vars_tmp1) ) then call MessageNotify('E', subname, & & message='Varkey is not found.') elseif ( associated(vars_tmp1%varkeys) ) then do i = 1, size(vars_tmp1%varkeys) if ( varkey == vars_tmp1%varkeys(i) ) then hit_vars_output = .true. endif call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', & & i=(/i/) , & & c1=trim( vars_tmp1%varkeys(i) ) , & & c2=trim( vars_tmp1%file ) ) call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) ) enddo endif if (hit_vars_output) exit vars_tmp1 => vars_tmp1%next enddo !----------------------------------------------------------------- ! Output by HistoryPut [in gt4f90io] !----------------------------------------------------------------- call HistoryVarinfoInquire(info % varinfo, name=var_name) call HistoryPut( & & varname=var_name , & ! intent(in) : 変数名 & array=xyz_Var , & ! intent(in) : 出力値 & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY call EndSub( subname, & & 'This is Just Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) end subroutine io_gt4_out_Put3Double !=begin !=== Put 2-Dimensional Double Precision Data to netCDF file ! !機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 !ただしこちらは倍精度実数 2 次元のデータを出力する。 ! subroutine io_gt4_out_Put2Double(varkey, xy_Var) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use time_mod, only : StepInterval, OutputStep, CurrentLoop use varinfo_mod, only : varinfo_inquire, VAR_INFO use gt4_history, only : HistoryPut, HistoryVarinfoInquire use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage use dc_message, only : MessageNotify !=end implicit none !=begin !==== Input ! character(*), intent(in):: varkey ! 変数名 real(DBKIND), intent(in):: xy_Var(:,:) ! 出力データ !=end !----- 作業用内部変数 ----- type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 integer(INTKIND) :: i, stat logical :: hit_vars_output = .false. type(VAR_INFO) :: info integer(INTKIND) :: StepIntervalTmp integer(INTKIND) :: OutputStepTmp character(STRING) :: var_name character(STRING), parameter:: subname = "io_gt4_out_Put2Double" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !----------------------------------------------------------------- ! Get Information from varinfo_mod about varkey. !----------------------------------------------------------------- call varinfo_inquire & & ( varkey , & ! intent(in) : 変数キー & info , & ! intent(out): VAR_INFO データ & stat ) ! intent(out): ステータス if (stat > 0) then call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', & & c1=trim(varkey) ) return endif !----------------------------------------------------------------- ! Check CurrentLoop in time_mod !----------------------------------------------------------------- if ( info%StepInterval < 1 ) then StepIntervalTmp = StepInterval ! in time_mod else StepIntervalTmp = info%StepInterval ! in varinfo_mod end if if ( info%OutputStep < 1 ) then OutputStepTmp = OutputStep ! in time_mod else OutputStepTmp = info%OutputStep ! in varinfo_mod end if if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then call EndSub( subname, & & 'This is not Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then call EndSub( subname, & & 'Already CurrentLoop exceed StepInterval*OutputStep. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if !----------------------------------------------------------------- ! Search vars_output for varkey's infomation. !----------------------------------------------------------------- hit_vars_output = .false. vars_tmp1 => vars_output%next do if ( .not. associated(vars_tmp1) ) then call MessageNotify('E', subname, & & message='Varkey is not found.') elseif ( associated(vars_tmp1%varkeys) ) then do i = 1, size(vars_tmp1%varkeys) if ( varkey == vars_tmp1%varkeys(i) ) then hit_vars_output = .true. endif call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', & & i=(/i/) , & & c1=trim( vars_tmp1%varkeys(i) ) , & & c2=trim( vars_tmp1%file ) ) call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) ) enddo endif if (hit_vars_output) exit vars_tmp1 => vars_tmp1%next enddo !----------------------------------------------------------------- ! Output by HistoryPut [in gt4f90io] !----------------------------------------------------------------- call HistoryVarinfoInquire(info % varinfo, name=var_name) call HistoryPut( & & varname=var_name , & ! intent(in) : 変数名 & array=xy_Var , & ! intent(in) : 出力値 & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY call EndSub( subname, & & 'This is Just Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) end subroutine io_gt4_out_Put2Double !=begin !=== Put 2-Dimensional Double Precision Data to netCDF file ! !機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 !ただしこちらは倍精度実数 2 次元のデータを出力する。 ! subroutine io_gt4_out_Put0Double(varkey, Var) !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use time_mod, only : StepInterval, OutputStep, CurrentLoop use varinfo_mod, only : varinfo_inquire, VAR_INFO use gt4_history, only : HistoryPut, HistoryVarinfoInquire use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage use dc_message, only : MessageNotify !=end implicit none !=begin !==== Input ! character(*), intent(in):: varkey ! 変数名 real(DBKIND), intent(in):: Var ! 出力データ !=end !----- 作業用内部変数 ----- type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 integer(INTKIND) :: i, stat logical :: hit_vars_output = .false. type(VAR_INFO) :: info integer(INTKIND) :: StepIntervalTmp integer(INTKIND) :: OutputStepTmp character(STRING) :: var_name character(STRING), parameter:: subname = "io_gt4_out_Put0Double" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) ) if (.not. io_gt4_out_initialized) then call EndSub( subname, 'Call io_gt4_out_init before call %c', & & c1=trim(subname) ) return endif !----------------------------------------------------------------- ! Get Information from varinfo_mod about varkey. !----------------------------------------------------------------- call varinfo_inquire & & ( varkey , & ! intent(in) : 変数キー & info , & ! intent(out): VAR_INFO データ & stat ) ! intent(out): ステータス if (stat > 0) then call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', & & c1=trim(varkey) ) return endif !----------------------------------------------------------------- ! Check CurrentLoop in time_mod !----------------------------------------------------------------- if ( info%StepInterval < 1 ) then StepIntervalTmp = StepInterval ! in time_mod else StepIntervalTmp = info%StepInterval ! in varinfo_mod end if if ( info%OutputStep < 1 ) then OutputStepTmp = OutputStep ! in time_mod else OutputStepTmp = info%OutputStep ! in varinfo_mod end if if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then call EndSub( subname, & & 'This is not Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then call EndSub( subname, & & 'Already CurrentLoop exceed StepInterval*OutputStep. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) return end if !----------------------------------------------------------------- ! Search vars_output for varkey's infomation. !----------------------------------------------------------------- hit_vars_output = .false. vars_tmp1 => vars_output%next do if ( .not. associated(vars_tmp1) ) then call MessageNotify('E', subname, & & message='Varkey is not found.') elseif ( associated(vars_tmp1%varkeys) ) then do i = 1, size(vars_tmp1%varkeys) if ( varkey == vars_tmp1%varkeys(i) ) then hit_vars_output = .true. endif call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', & & i=(/i/) , & & c1=trim( vars_tmp1%varkeys(i) ) , & & c2=trim( vars_tmp1%file ) ) call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) ) enddo endif if (hit_vars_output) exit vars_tmp1 => vars_tmp1%next enddo !----------------------------------------------------------------- ! Output by HistoryPut [in gt4f90io] !----------------------------------------------------------------- call HistoryVarinfoInquire(info % varinfo, name=var_name) call HistoryPut( & & varname=var_name , & ! intent(in) : 変数名 & value=Var , & ! intent(in) : 出力値 & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY call EndSub( subname, & & 'This is Just Output Step. ' // & & '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', & & c1=trim(subname), & & i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) ) end subroutine io_gt4_out_Put0Double !=begin !=== Terminate module ! !((< io_gt4_out_init>)) で設定された値を破棄し、 !デフォルトの値に戻す。 !また、HistoryClose によって、HistoryCreate 等に対応する終了処理 !を行なう。 ! subroutine io_gt4_out_end !==== Dependency use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING use gt4_history, only : HistoryClose use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage !=end implicit none !----------------------------------------------------------------- ! 変数定義 !----------------------------------------------------------------- !----- 作業用内部変数 ----- type(IO_GT4_OUT_VARS), pointer:: vars_tmp1 character(STRING), parameter:: subname = "io_gt4_out_end" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub(subname) if ( .not. io_gt4_out_initialized) then call EndSub( subname, 'io_gt4_out_init was not called', & & c1=trim(subname) ) return else io_gt4_out_initialized = .false. endif !----------------------------------------------------------------- ! HistoryClose [in gt4f90io] による終了処理 ! ! vars_output で1つ1つ探査しつつ終了させていく。 !----------------------------------------------------------------- vars_tmp1 => vars_output%next do if ( .not. associated(vars_tmp1) ) then exit elseif ( vars_tmp1%created ) then call HistoryClose(history=vars_tmp1%gt_history) vars_tmp1%created = .false. endif vars_tmp1 => vars_tmp1%next enddo !----------------------------------------------------------------- ! Initialize axes_store !----------------------------------------------------------------- if ( allocated(axes_store) ) then deallocate(axes_store) endif axes_store_used = .false. !----------------------------------------------------------------- ! Initialize vars_output !----------------------------------------------------------------- deallocate( vars_output ) nullify( vars_output ) vars_output_used = .false. !----------------------------------------------------------------- ! Initialize netCDF global attribute information !----------------------------------------------------------------- file_save = 'result.nc' ! 出力ファイル名 (デフォルト) title_save = 'GCM Test' ! タイトル source_save = 'DCPAM' ! モデル名 (作成手段) institution_save = 'GFD Dennou Club' ! 実行者名 (作成者) call EndSub(subname) end subroutine io_gt4_out_end end module io_gt4_out_mod