#!/usr/bin/env ruby # -*- f90 -*- # vi: set sw=4 ts=8: require("intrinsic_types") require("optparse") # # "gt4_historyauto.f90" Generator with Ruby. # opt = OptionParser.new opt.on('--histput_dim=VAL') {|v| $histput_dim = v.to_i} opt.on('--histget_dim=VAL') {|v| $histget_dim = v.to_i} opt.parse!(ARGV) $histput_dim = 7 unless $histput_dim $histget_dim = 7 unless $histget_dim print <<"__EndOfFortran90Code__" !-- #{rb2f90_header_comment}! !++ ! != gtool4 netCDF データの入出力インターフェース (大規模モデル用) != Interface of Input/Output of gtool4 netCDF data (For large models) ! ! Authors:: Yasuhiro MORIKAWA ! Version:: $Id: gt4_historyauto.rb2f90,v 1.25 2008-08-12 10:53:30 morikawa Exp $ ! Tag Name:: $Name: gt4f90io-20080812 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2008. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! module gt4_historyauto ! != gtool4 netCDF データの入出力インターフェース (大規模モデル用) != Interface of Input/Output of gtool4 netCDF data (For large models) ! ! Note that Japanese and English are described in parallel. ! ! gt4_historyauto モジュールは gt4_history モジュールの応用版であり, ! 出力変数が 10 を超えるような大規模な数値モデルを想定した, ! データ出力のための簡便なインターフェースを ! 提供します. ! このモジュールは以下のような特徴を持ちます. ! ! * 複数のファイルへの出力を行う場合, ! gt4_history モジュールではファイルごとに ! gt4_history#HistoryCreate を何度も ! 呼び出す必要がありましたが, このモジュールでは ! HistoryAutoCreate をモデル内で一度呼び出すだけで済みます. ! * 個別の変数について, 出力ファイルや出力間隔を手軽に変更可能です. ! 実際には, HistoryAutoAddVariable の引数もしくは, ! NAMELIST#gt4_historyauto_nml によって変更することが可能です. ! * gt4_history#GT_HISTORY 構造体を直接使用することなく ! 出力を行うことが可能となっています. ! ! ! "gt4_historyauto" module is an application of "gt4_history" module, ! and provides data output easy-to-use interfaces ! for large numerical models that output 10 or more variables. ! This module has following features. ! ! * In case that multiple files are output, ! "gt4_history#HistoryCreate" must be called many times at each file ! using "gt4_history" module, while ! "HistoryAutoCreate" has to be called once in a numerical model ! using this module. ! * Output filename or output interval, etc can be changed easily. ! In practice, their settings are changed by arguments of ! "HistoryAutoAddVariable" or "NAMELIST#gt4_historyauto_nml". ! * "gt4_history#GT_HISTORY" need not be used. ! ! !== Procedures list ! ! HistoryAutoCreate :: 初期化 ! HistoryAutoAddVariable :: 変数追加 ! HistoryAutoPut :: データ出力 ! HistoryAutoProgress :: 時刻進行 ! HistoryAutoClose :: 終了処理 ! HistoryAutoPutAxis :: 座標データ追加 ! HistoryAutoAddWeight :: 座標重み追加 ! HistoryAutoAddAttr :: 属性追加 ! --------------------- :: --------------------- ! HistoryAutoCreate :: Initialization ! HistoryAutoAddVariable :: Addition of variables ! HistoryAutoPut :: Output of data ! HistoryAutoProgress :: Progression of time ! HistoryAutoClose :: Termination ! HistoryAutoPutAxis :: Addition of data of axes ! HistoryAutoAddWeight :: Addition of weights of axes ! HistoryAutoAddAttr :: Addition of attributes ! ! !== NAMELIST ! ! NAMELIST#gt4_historyauto_nml ! !== Acknowledgment ! ! * このモジュールは, 堀之内氏による gt4_history の ! アプリケーション "gt4_historyauto_h" を参照に作成しました. ! ! * "gt4_historyauto_h" that is an application of "gt4_history" ! by Horinouchi is referred when this module is created. ! ! gt4_history モジュール ! "gt4_history" module ! use gt4_history, only: GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY ! NAMELIST の使用を想定したヒストリデータ出力情報管理用ユーティリティ ! Utilities for history data output information management assuming use of NAMELIST ! use gt4_history_nmlinfo, only: GTHST_NMLINFO ! NetCDF ライブラリで規定される最大の次元の数, 変数の数 ! Maximum number of dimensions and variables prescribed by the NetCDF library ! use netcdf_f77, only: NF_MAX_DIMS, NF_MAX_VARS ! 日付および時刻の取り扱い ! Date and time handler ! use dc_date_types, only: DC_DIFFTIME ! 日時の差を表現するデータ型. ! Data type for difference about date and time ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: DP, & ! 倍精度実数型. Double precision. & STRING, & ! 文字列. Strings. & TOKEN ! キーワード. Keywords. !!$ ! gt4_historyauto_h (堀之内版 gt4_historyauto) をカスケード提供 !!$ ! gt4_historyauto_h (Horinouchi version of gt4_historyauto) is !!$ ! cascaded and provided. !!$ ! !!$ !-- !!$ use gt4_historyauto_h, only: & !!$ & GT4_ATTRIBUTE, init_gt4_attribute, & !!$ & GT4_REAL1D, init_gt4_real1d, & !!$ & GT4_NAMED_REALARY, init_gt4_named_realary, & !!$ & HistoryAutoPut, HistoryAutoCreate, HistoryAutoCopyCreate, & !!$ & HistoryAutoWhetherPutNow, HistoryAutoSetRunInfo, HistoryAutoSetGrid !!$ !++ implicit none private public:: HistoryAutoCreate public:: HistoryAutoClose public:: HistoryAutoAddWeight public:: HistoryAutoPutAxis public:: HistoryAutoAddVariable public:: HistoryAutoPut public:: HistoryAutoAddAttr public:: HistoryAutoProgress !!$ ! gt4_historyauto_h (堀之内版 gt4_historyauto) をカスケード提供 !!$ ! gt4_historyauto_h (Horinouchi version of gt4_historyauto) is provided. !!$ ! !!$ !-- !!$ public :: GT4_ATTRIBUTE, init_gt4_attribute !!$ public :: GT4_REAL1D, init_gt4_real1d !!$ public :: GT4_NAMED_REALARY, init_gt4_named_realary !!$! public :: HistoryAutoPut !!$! public :: HistoryAutoCreate !!$ public :: HistoryAutoCopyCreate !!$ public :: HistoryAutoWhetherPutNow !!$ public :: HistoryAutoSetRunInfo !!$ public :: HistoryAutoSetGrid !!$ !++ ! 次元数 ! Number of dimensions ! integer, save:: numdims ! 座標重み変数の数 ! Number of variables of axes weight ! integer, save:: numwgts = 0 ! 座標重み変数の接尾詞 ! Suffix of variables of axes weight ! character(*), parameter:: wgtsuf = '_weight' ! 変数の数 ! Number of variables ! integer, save:: numvars = 0 ! 1 つの変数が依存可能な次元の数 ! Number of dimensions on which one variable can depend ! integer, parameter:: MAX_DIMS_DEPENDED_BY_VAR = #{$histput_dim} ! 出力間隔をΔtで割った際に, 余りとして許容される範囲 ! Allowable range of remainder of output interval divided by delta t ! real(DP), parameter:: max_remainder_range = 1.0e-3_DP ! 出力ファイルの基本メタデータ ! Basic meta data for output file ! character(STRING), save:: title_save character(STRING), save:: source_save character(STRING), save:: institution_save character(STRING), save:: conventions_save character(TOKEN), save:: gt_version_save character(TOKEN), save:: rank_save ! 時刻データ ! Time data ! type(DC_DIFFTIME), save:: start_difftime type(DC_DIFFTIME), save:: current_difftime type(DC_DIFFTIME), save:: delta_difftime integer, save:: Nstep = 0 ! 時刻の単位 (HistoryAutoCreate の dims によって指定されたもの) ! Unit of time (specified by "dims" of "HistoryAutoCreate") ! character(TOKEN):: time_unit_bycreate ! NAMELIST の使用を想定したヒストリデータ出力情報管理用ユーティリティ ! Utilities for history data output information management assuming use of NAMELIST ! type(GTHST_NMLINFO), save:: gthstnml type GT_HISTORY_AXIS_DATA ! ! 座標軸データ用の構造型 ! Derived type for axes data ! real(DP), pointer:: a_axis(:) =>null() end type GT_HISTORY_AXIS_DATA ! 座標軸情報 ! Information of axes ! type(GT_HISTORY_AXIS), save, target:: gthst_axes(1:NF_MAX_DIMS) type(GT_HISTORY_AXIS_DATA), save, target:: data_axes(1:NF_MAX_DIMS) type(GT_HISTORY_VARINFO), save:: gthst_weights(1:NF_MAX_DIMS) type(GT_HISTORY_AXIS_DATA), save, target:: data_weights(1:NF_MAX_DIMS) type GT_HISTORY_DUMMY ! ! GT_HISTORY 型変数を指す構造体 ! Derived type for indication to "GT_HISTORY" ! type(GT_HISTORY), pointer:: gthist =>null() end type GT_HISTORY_DUMMY ! 変数情報 ! Information of variables ! type(GT_HISTORY_VARINFO), save:: gthst_vars(1:NF_MAX_VARS) character(TOKEN), save:: varname_vars(1:NF_MAX_VARS) = '' type(GT_HISTORY_DUMMY), save:: gthst_history_vars(1:NF_MAX_VARS) logical, save:: output_valid_vars(1:NF_MAX_VARS) = .false. ! 変数出力が有効か否か. ! Whether output of variables is valid or not. logical, save:: output_timing_vars(1:NF_MAX_VARS) = .false. ! 現在のステップでは出力を行うか否か. ! Whether output is done or not at currrent step. integer, save:: intstep_vars(1:NF_MAX_VARS) = 1 ! 出力間隔のステップ数. ! Number of step of interval of output. integer, save:: originstep_vars(1:NF_MAX_VARS) = 0 ! ファイルを作成するステップ数. ! Number of step of creation of file integer, save:: terminusstep_vars(1:NF_MAX_VARS) = -1 ! ファイルをクローズするステップ数. ! Number of step of closure of file integer, save:: newfile_intstep_vars(1:NF_MAX_VARS) = -1 ! ファイルを新規に作り直すステップ数. ! Number of step of remake of file logical, save:: tavr_vars(1:NF_MAX_VARS) = .false. ! 時間平均フラグ. ! Flag for time average real, save:: deltime_value_vars(1:NF_MAX_VARS) = 1.0 ! Δt. Delta t real, save:: origin_value_vars(1:NF_MAX_VARS) = 0.0 ! 出力開始時刻. ! Start time of output type SLICE_INFO ! ! 空間切り出し情報管理用の構造型 ! Derived type for information of slice of space ! integer, pointer:: st(:) =>null() ! 空間方向の開始点. ! Start points of spaces. integer, pointer:: ed(:) =>null() ! 空間方向の終了点. ! End points of spaces. integer, pointer:: sd(:) =>null() ! 空間方向の刻み幅. ! Strides of spaces end type SLICE_INFO ! データの切り出し情報 ! Information of slices of data ! type(SLICE_INFO), save, target:: slice_vars(1:NF_MAX_VARS) type AXES_WEIGHT ! ! 座標重み情報管理用の構造型 ! Derived type for information of axes weight ! #{forloop("\\$num\\$", 1, $histput_dim, %Q{ real(DP), pointer:: wgt$num$(:) =>null() })} end type AXES_WEIGHT ! 座標重み情報 ! Information of axes weight ! type(AXES_WEIGHT), save, target:: weight_vars(1:NF_MAX_VARS) type SPACE_AVR_INFO ! ! 空間平均情報管理用の構造型 ! Derived type for information of average in space direction ! logical, pointer:: avr(:) =>null() ! 平均化のフラグ. ! Flag of average. end type SPACE_AVR_INFO ! データの切り出し情報 ! Information of slices of data ! type(SPACE_AVR_INFO), save, target:: space_avr_vars(1:NF_MAX_VARS) ! 登録変数を全て出力するためのフラグ. ! Flag for output all registered variables. ! logical, save:: all_output_save = .false. ! 時刻の進行が行われたかどうか ! * HistoryAutoProgress が一度でも呼ばれると .true. になる. ! * 一度 .true. になると, HistoryAutoAddVariable を呼ぶことはできない. ! ! Whether the progress of time was done or not. ! * Once "HistoryAutoProgress" is called, this argument becomes .true. ! * Once this argument becomes .true., "HistoryAutoAddVariable" can not be called. ! logical, save:: once_progressed = .false. ! 初期設定フラグ ! Initialization flag ! logical, save:: initialized = .false. character(*), parameter:: sub_sname = "HistAuto" character(*), parameter:: version = & & '$Name: gt4f90io-20080812 $' // & & '$Id: gt4_historyauto.rb2f90,v 1.25 2008-08-12 10:53:30 morikawa Exp $' interface HistoryAutoCreate module procedure HistoryAutoCreate1 end interface interface HistoryAutoClose module procedure HistoryAutoClose1 end interface interface HistoryAutoAddWeight #{foreach("\\$type\\$", "Double", "Real", "Int", %Q{ module procedure HistoryAutoAddWeight$type$ })} end interface interface HistoryAutoPutAxis #{foreach("\\$type\\$", "Double", "Real", "Int", %Q{ module procedure HistoryAutoPutAxis$type$ })} end interface interface HistoryAutoAddVariable module procedure HistoryAutoAddVariable1 end interface interface HistoryAutoAddAttr #{foreach("\\$type\\$", "Char", "Logical", %Q{ module procedure HistoryAutoAddAttr$type$0 })} #{foreach("\\$type\\$", "Int", "Real", "Double", %Q{ #{forloop("\\$num\\$", 0, 1, %Q{ module procedure HistoryAutoAddAttr$type$$num$ })}})} end interface interface HistoryAutoPut #{foreach("\\$type\\$", "Double", "Real", "Int", %Q{ #{forloop("\\$num\\$", 1, $histput_dim, %Q{ module procedure HistoryAutoPut$type$$num$ })} module procedure HistoryAutoPut$type$0 })} end interface interface HistoryAutoProgress module procedure HistoryAutoProgress end interface contains subroutine HistoryAutoCreate1( & & title, source, institution, & ! (in) & dims, dimsizes, longnames, units, & ! (in) & xtypes, conventions, gt_version,& ! (in) optional & all_output, & ! (in) optional & file_prefix, & ! (in) optional & namelist_filename, & ! (in) optional & current_time, delta_time, & ! (in) optional & interval, origin, terminus, & ! (in) optional & slice_start, slice_end, slice_stride, & ! (in) optional & space_average, & ! (in) optional & time_average, & ! (in) optional & newfile_interval, & ! (in) optional & rank & ! (in) optional & ) ! ! 複数のヒストリデータ出力を行うための初期化を行います. ! ! この HistoryAutoCreate には, モデル内で出力する ! 変数が依存する座標や座標重みなどを全てを設定してください. ! ! all_output に .true. を与えた場合や, ! namelist_filename を与えない (空文字を与える) 場合には, ! HistoryAutoAddVariable で登録される全ての変数が出力されます. ! 一方で namelist_filename に NAMELIST ファイル名を与える場合には, ! その NAMELIST ファイルから出力のオンオフや, ! 出力ファイル名, 出力間隔などを変更可能です. ! 変更可能な項目に関しては NAMELIST#gt4_historyauto_nml ! を参照して下さい. ! ! interval, origin, terminus, slice_start, slice_end, slice_stride, ! space_average, time_average, newfile_interval ! などの設定はデフォルト値として使用されます. ! これらの設定値は HistoryAutoAddVariable および ! NAMELIST#gt4_historyauto_nml で上書きされます. ! (優先度が高いのは NAMELIST#gt4_historyauto_nml , ! HistoryAutoAddVariable の引数, ! HistoryAutoCreate の引数の順です). ! ! ! Initialization for multiple history data output ! ! Set all axes and their weights depended by variables ! output from numerical models to this "HistoryAutoCreate". ! ! All variables registered by "HistoryAutoAddVariable" ! are output if .true. is given to "all_output" or ! "namelist_filename" is not given (or blanks are given) ! On the other hand, if a filename of NAMELIST file is ! given to "namelist_filename", on/off of output, ! output filename and output interval, etc. can be changed ! from the NAMELIST file. ! For available items, see "NAMELIST#gt4_historyauto_nml". ! ! Settings about ! "interval", "origin", "terminus", "slice_start", "slice_end", "slice_stride", ! "space_average", "time_average", "newfile_interval" ! etc. are used as default values. ! Their set values are overwritten by ! "HistoryAutoAddVariable" or ! "NAMELIST#gt4_historyauto_nml". ! ("NAMELIST#gt4_historyauto_nml" is high priority, ! arguments of "HistoryAutoAddVariable" are medium, ! arguments of "HistoryAutoCreate" are low). ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, DC_EALREADYINIT, & & GT_EARGSIZEMISMATCH, HST_ENOTIMEDIM, DC_ENEGATIVE use netcdf_f77, only: NF_EMAXDIMS use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar use dc_present, only: present_and_not_empty, present_and_true, & & present_select use dc_date, only: DCDiffTimeCreate, EvalbyUnit use dc_message, only: MessageNotify use dc_iounit, only: FileOpen use gt4_history, only: HistoryAxisCreate use gt4_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, & & HstNmlInfoEndDefine, HstNmlInfoPutLine, HstNmlInfoAllNameValid, & & HstNmlInfoInquire implicit none character(*), intent(in):: title ! データ全体の表題. ! Title of entire data character(*), intent(in):: source ! データを作成する際の手段. ! Source of data file character(*), intent(in):: institution ! ファイルを最終的に変更した組織/個人. ! Institution or person that changes files for the last time character(*), intent(in):: dims(:) ! 次元の名前. ! ! 配列の大きさに制限はありません. ! 個々の次元の文字数は dc_types#TOKEN まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で ! 補ってください. ! ! Names of dimensions. ! ! Length of array is unlimited. ! Limits of numbers of characters of each ! dimensions are "dc_types#TOKEN". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! integer, intent(in):: dimsizes (:) ! dims で指定したそれぞれの次元大きさ. ! ! 配列の大きさは dims の大きさと等しい ! 必要があります. '0' (数字のゼロ) を指定 ! するとその次元は無制限次元 (unlimited ! dimension) となります. (gt4_history ! では時間の次元に対して無制限次元を ! 用いることを想定しています). ただし, ! 1 つの NetCDF ファイル (バージョン 3) ! は最大で 1 つの無制限次元しか持てないので, ! 2 ヶ所以上に '0' を指定しないでください. ! その場合, 正しく gtool4 データが出力されません. ! ! Lengths of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". If '0' (zero) is ! specified, the dimension is treated as ! unlimited dimension. ! (In "gt4_history", unlimited dimension is ! expected to be used as time). ! Note that one NetCDF file (version 3) ! can not have two or more unlimited ! dimensions, so that do not specify '0' ! to two or more places. In that case, ! gtoo4 data is not output currently ! character(*), intent(in):: longnames (:) ! dims で指定したそれぞれの次元の名前. ! ! 配列の大きさは dims の大きさ ! と等しい必要があります. 文字数 ! は dc_types#STRING まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Names of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". ! Limits of numbers of characters are ! "dc_types#STRING". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in):: units(:) ! dims で指定したそれぞれの次元の単位. ! ! 配列の大きさは dims の大きさ ! と等しい必要があります. 文字数 ! は dc_types#STRING まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Units of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". ! Limits of numbers of characters are ! "dc_types#STRING". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in), optional:: xtypes(:) ! dims で指定したそれぞれの ! 次元のデータ型. ! ! デフォルトは float (単精度実数型) ! です. 有効なのは, ! double (倍精度実数型), ! int (整数型) です. 指定しない ! 場合や, 無効な型を指定した場合には, ! float となります. なお, 配列の大きさ ! は *dims* の大きさと等しい必要が ! あります. 配列内の文字数は全て ! 同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Data types of dimensions specified ! with "dims". ! ! Default value is "float" (single precision). ! Other valid values are ! "double" (double precision), ! "int" (integer). ! If no value or invalid value is specified, ! "float" is applied. ! Length of this array must be same as ! length of "dim". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in), optional:: conventions ! 出力するファイルの netCDF ! 規約 ! ! 省略した場合, ! もしくは空文字を与えた場合, ! 出力する netCDF 規約の ! Conventions 属性に値 ! gtool4_netCDF_Conventions ! が自動的に与えられます. ! ! NetCDF conventions of output file. ! ! If this argument is omitted or, ! blanks are given, ! gtool4_netCDF_Conventions is given to ! attribute "Conventions" of an output file ! automatically. ! character(*), intent(in), optional:: gt_version ! gtool4 netCDF 規約のバージョン ! ! 省略した場合, gt_version 属性に ! 規約の最新版のバージョンナンバー ! gtool4_netCDF_version ! が与えられます. ! (ただし, 引数 conventions に ! gtool4_netCDF_Conventions ! 以外が与えられる場合は ! gt_version 属性を作成しません). ! ! Version of gtool4 netCDF Conventions. ! ! If this argument is omitted, ! latest version number of gtool4 netCDF ! Conventions is given to attribute ! "gt_version" of an output file ! (However, gtool4_netCDF_Conventions is ! not given to an argument "conventions", ! attribute "gt_version" is not created). ! logical, intent(in), optional:: all_output ! 登録変数を全て出力するためのフラグ. ! ! .true. を指定すると, ! HistoryAutoAddVariable で登録された ! 変数が全て出力されるようになります. ! ! *namelist_filename* が指定される場合 ! には, デフォルトは .false. となります. ! この場合には, ! *namelist_filename* に指定された ! NAMELIST ファイルから読み込まれる ! NAMELIST#gt4_historyauto_nml ! で指定された変数のみ出力されます. ! ! *namelist_filename* が指定されない場合 ! には, .true. となります. ! ! ! Flag for output all registered variables. ! ! When .true. is specified, ! all variables registered by ! "HistoryAutoAddVariable" are output. ! ! If *namelist_filename* is specified, ! default value becomes .false. . ! In this case, ! only variables specified in ! "NAMELIST#gt4_historyauto_nml" ! loaded from a NAMELIST file ! *namelist_filename*. ! ! If *namelist_filename* is not specified, ! this value becomes .true. . ! character(*), intent(in), optional:: file_prefix ! ヒストリデータのファイル名の接頭詞. ! Prefixes of history data filenames character(*), intent(in), optional:: namelist_filename ! NAMELIST ファイルの名称. ! ! 省略した場合, もしくは空白文字を与えた場合, ! NAMELIST ファイルは読み込みません. ! ! Name of NAMELIST file. ! ! If this argument is omitted, ! or blanks are specified, ! no NAMELIST file is loaded. ! real, intent(in), optional:: current_time ! 数値モデル内の現在時刻 (単位: 秒). ! ! 省略した場合, 自動的にゼロが設定されます. ! ! Current time in a numerical model ! (unit: seconds). ! ! If this argument is omitted, ! zero is set automatically. ! real, intent(in), optional:: delta_time ! 数値モデル内のタイムステップ (単位: 秒). ! ! 省略した場合, 自動的に 1.0 が設定されます. ! ! Time step in a numerical model ! (unit: seconds). ! ! If this argument is omitted, ! 1.0 is set automatically. ! real, intent(in), optional:: interval ! 出力時間間隔. ! ! 省略した場合, ! 自動的に delta_time の値が設定されます. ! ! Interval of output time. ! ! If this argument is omitted, ! a value of "delta_time" is specified ! automatically. ! real, intent(in), optional:: origin ! 出力開始時刻. ! ! 省略した場合, 自動的に current_time の値が ! 設定されます. ! ! Start time of output. ! ! If this argument is omitted, ! a value of "current_time" is specified ! automatically. ! real, intent(in), optional:: terminus ! 出力終了時刻. ! ! 省略した場合, 数値モデルの実行が終了するまで ! 出力を行います. ! ! End time of output. ! ! If this argument is omitted, ! output is continued until a numerical model ! is finished. ! integer, intent(in), optional:: slice_start(:) ! 空間方向の開始点. ! ! 省略した場合, 座標データの開始点が設定されます. ! ! Start points of spaces. ! ! If this argument is omitted, ! start points of dimensions are set. ! integer, intent(in), optional:: slice_end(:) ! 空間方向の終了点. ! ! 省略した場合, 座標データの終了点が設定されます. ! ! End points of spaces. ! ! If this argument is omitted, ! End points of dimensions are set. ! integer, intent(in), optional:: slice_stride(:) ! 空間方向の刻み幅. ! ! 省略した場合, 1 が設定されます. ! ! Strides of spaces ! ! If this argument is omitted, ! 1 is set. ! logical, intent(in), optional:: space_average(:) ! 平均化のフラグ. ! ! .true. が指定される座標に対して平均化を ! 行います. ! 省略した場合, .false. が設定されます. ! ! Flag of average. ! ! Axes specified .true. are averaged. ! If this argument is omitted, ! .false. is set. ! logical, intent(in), optional:: time_average ! 出力データの時間平均フラグ. ! デフォルトは .false. ! Flag for time average of output data ! Default value is .false. integer, intent(in), optional:: newfile_interval ! ファイル分割時間間隔. ! ! 省略した場合, ! 時間方向へのファイル分割を行いません. ! ! Interval of time of separation of a file. ! ! If this argument is omitted, ! a files is not separated in time direction. ! character(*), intent(in), optional:: rank ! ランクの名称. ! ! Name of a rank. ! ! NAMELIST 変数群 ; NAMELIST group of variables character(STRING):: Name ! 変数名. ! 空白の場合には, この他の設定値は ! gt4_historyauto モジュールにおいて ! 出力されるデータ全ての ! デフォルト値となります. ! ! "Data1,Data2" のようにカンマで区切って複数 ! の変数を指定することも可能です. ! ! Variable identifier. ! If blank is given, other values are ! used as default values of output data ! in "gt4_historyauto". ! ! Multiple variables can be specified ! as "Data1,Data2" too. Delimiter is comma. character(STRING):: File ! 出力ファイル名. ! これはデフォルト値としては使用されません. ! *Name* に値が設定されている時のみ有効です. ! ! Output file name. ! This is not used as default value. ! This value is valid only when *Name* is ! specified. real:: IntValue ! ヒストリデータの出力間隔の数値. ! 負の値を与えると, 出力を抑止します. ! Numerical value for interval of history data output ! Negative values suppresses output. character(TOKEN):: IntUnit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output character(TOKEN):: Precision ! ヒストリデータの精度. ! Precision of history data character(STRING):: FilePrefix ! ヒストリデータのファイル名の接頭詞. ! Prefixes of history data filenames logical:: TimeAverage ! 出力データの時間平均フラグ. ! Flag for time average of output data logical:: AllOutput ! 登録変数を全て出力するためのフラグ. ! Flag for output all registered variables. real:: OriginValue ! 出力開始時刻. ! Start time of output. character(TOKEN):: OriginUnit ! 出力開始時刻の単位. ! Unit of start time of output. real:: TerminusValue ! 出力終了時刻. ! End time of output. character(TOKEN):: TerminusUnit ! 出力終了時刻の単位. ! Unit of end time of output. integer:: SliceStart(1:NF_MAX_DIMS) ! 空間方向の開始点. ! Start points of spaces. integer:: SliceEnd(1:NF_MAX_DIMS) ! 空間方向の終了点. ! End points of spaces. integer:: SliceStride(1:NF_MAX_DIMS) ! 空間方向の刻み幅. ! Strides of spaces. logical:: SpaceAverage(1:NF_MAX_DIMS) ! 平均化のフラグ. ! Flag of average. integer:: NewFileIntValue ! ファイル分割時間間隔. ! Interval of time of separation of a file. character(TOKEN):: NewFileIntUnit ! ファイル分割時間間隔の単位. ! Unit of interval of time of separation of a file. namelist /gt4_historyauto_nml/ & & Name, File, & & IntValue, IntUnit, & & Precision, & & FilePrefix, & & TimeAverage, AllOutput, & & OriginValue, OriginUnit, & & TerminusValue, TerminusUnit, & & SliceStart, SliceEnd, SliceStride, SpaceAverage, & & NewFileIntValue, NewFileIntUnit ! gt4_historyauto モジュールのヒストリデータ用 ! NAMELIST 変数群名. ! ! gt4_historyauto#HistoryAutoCreate ! を使用する際に, オプショナル引数 *namelist_filename* ! へ NAMELIST ファイル名を指定することで, ! そのファイルからこの NAMELIST 変数群を ! 読み込みます. ! ! NAMELIST group name for ! history data of "gt4_historyauto" module. ! ! If a NAMELIST filename is specified to ! an optional argument *namelist_filename* when ! "gt4_historyauto#HistoryAutoCreate" ! is used, this NAMELIST group is ! loaded from the file. ! 作業変数 ; Work variables integer:: stat character(STRING):: cause_c integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read character(TOKEN):: pos_nml ! NAMELIST 読み込み時のファイル位置. ! File position of NAMELIST read integer:: i, j character(TOKEN):: my_xtype real:: interval_work, origin_work type(DC_DIFFTIME):: origin_difftime character(*), parameter:: subname = "HistoryAutoCreate1" continue call BeginSub(subname, version = version) stat = DC_NOERR cause_c = "" ! このサブルーチンが 2 度呼ばれたらエラー ! Error is occurred when this subroutine is called twice ! if ( initialized ) then stat = DC_EALREADYINIT cause_c = 'gt4_historyauto' goto 999 end if ! 次元の数に関するエラー処理 ! Error handling for number of dimensions ! numdims = size(dims) if ( size(dimsizes) /= numdims ) then cause_c = 'dimsizes, dims' elseif ( size(longnames) /= numdims ) then cause_c = 'longnames, dims' elseif ( size(units) /= numdims ) then cause_c = 'units, dims' endif if ( trim(cause_c) /= "" ) then stat = GT_EARGSIZEMISMATCH goto 999 end if if ( numdims > NF_MAX_DIMS ) then stat = NF_EMAXDIMS goto 999 end if ! 時刻次元に関するエラー処理 ! Error handling for time dimension ! if ( dimsizes(numdims) /= 0 ) then call MessageNotify( 'W', subname, & & 'time dimension must be specified to the last of "dims"' ) stat = HST_ENOTIMEDIM goto 999 end if ! 現在時刻に関するエラー処理 ! Error handling for current time ! if ( present(current_time) ) then if ( current_time < 0.0 ) then call MessageNotify( 'W', subname, & & '"current_time=<%r>" must not be negative value.', & & r = (/ current_time /) ) stat = DC_ENEGATIVE cause_c = 'current_time' goto 999 end if end if ! 出力ファイルの基本メタデータの保管 ! Save basic meta data for output file ! title_save = title source_save = source institution_save = institution conventions_save = '' if ( present(conventions) ) conventions_save = conventions gt_version_save = '' if ( present(gt_version) ) gt_version_save = gt_version rank_save = '' if ( present(rank) ) rank_save = rank ! 座標軸データの保管 ! Save axes data ! time_unit_bycreate = units(numdims) do i = 1, numdims my_xtype = '' if ( present(xtypes) ) then if ( size(xtypes) >= i ) then my_xtype = xtypes(i) end if end if call HistoryAxisCreate( & & axis = gthst_axes(i), & ! (out) & name = dims(i), size = dimsizes(i), & ! (in) & longname = longnames(i), units = units(i), & ! (in) & xtype = my_xtype ) ! (in) allocate( data_axes(i) % a_axis( dimsizes(i) ) ) data_axes(i) % a_axis = (/ ( real( j, DP ), j = 1, dimsizes(i) ) /) end do ! 登録変数を全て出力するためのフラグの保管 ! Save flag for output all registered variables ! if ( present(all_output) ) all_output_save = all_output if ( .not. present_and_not_empty(namelist_filename) ) all_output_save = .true. AllOutput = all_output_save ! 時刻データの設定 ! Configure time data ! if ( present(current_time ) ) then call DCDiffTimeCreate( & & start_difftime, & ! (out) & current_time, 'sec' ) ! (in) else call DCDiffTimeCreate( & & start_difftime, & ! (out) & 0.0, 'sec' ) ! (in) end if current_difftime = start_difftime if ( present(delta_time) ) then call DCDiffTimeCreate( & & delta_difftime, & ! (out) & delta_time, 'sec' ) ! (in) else call DCDiffTimeCreate( & & delta_difftime, & ! (out) & 1.0, 'sec' ) ! (in) end if ! 出力時間間隔のデフォルト値設定 ! Configure default interval of output time ! if ( all_output_save ) then if ( present(interval) ) then interval_work = interval else interval_work = EvalbyUnit( delta_difftime, units(numdims) ) end if else interval_work = - 1.0 end if ! 出力開始時刻のデフォルト値設定 ! Configure default origin time of output ! if ( present(origin) ) then call DCDiffTimeCreate( & & origin_difftime, & ! (out) & origin, units(numdims) ) ! (in) origin_work = EvalbyUnit( origin_difftime, 'sec' ) else origin_work = EvalbyUnit( current_difftime, 'sec' ) !!$ origin_work = EvalbyUnit( current_difftime, units(numdims) ) end if ! gt4_historyauto_nml へデフォルト値の設定 ! Configure default values for "gt4_historyauto_nml" ! call HstNmlInfoCreate( gthstnml ) ! (out) call HstNmlInfoAdd( & & gthstnml = gthstnml, & ! (inout) & name = '', & ! (in) optional & precision = 'float', & ! (in) optional & fileprefix = file_prefix, & ! (in) optional & interval_value = interval_work, & ! (in) optional & interval_unit = units(numdims), & ! (in) optional & origin_value = origin_work, & ! (in) optional & origin_unit = 'sec', & ! (in) optional !!$ & origin_unit = units(numdims), & ! (in) optional & terminus_value = terminus, & ! (in) optional & terminus_unit = units(numdims), & ! (in) optional & time_average = time_average, & ! (in) optional & slice_start = slice_start, & ! (in) optional & slice_end = slice_end, & ! (in) optional & slice_stride = slice_stride, & ! (in) optional & space_average = space_average, & ! (in) optional & newfile_intvalue = newfile_interval, & ! (in) optional & newfile_intunit = units(numdims) ) ! (in) optional ! NAMELIST ファイルの読み込み ! Load NAMELIST file ! if ( present_and_not_empty(namelist_filename) ) then call FileOpen( unit_nml, & ! (out) & namelist_filename, mode = 'r' ) ! (in) iostat_nml = 0 pos_nml = '' call MessageNotify( 'M', sub_sname, '----- "gt4_historyauto_nml" is loaded from "%c" -----', & & c1 = trim(namelist_filename) ) do while ( trim(pos_nml) /= 'APPEND' .and. iostat_nml == 0 ) Name = '' File = '' call HstNmlInfoInquire( & & gthstnml = gthstnml, & ! (in) & interval_value = IntValue, & ! (out) optional & interval_unit = IntUnit, & ! (out) optional & precision = Precision, & ! (out) optional & time_average = TimeAverage, & ! (out) optional & origin_value = OriginValue, & ! (out) optional & origin_unit = OriginUnit, & ! (out) optional & terminus_value = TerminusValue, & ! (out) optional & terminus_unit = TerminusUnit, & ! (out) optional & slice_start = SliceStart, & ! (out) optional & slice_end = SliceEnd, & ! (out) optional & slice_stride = SliceStride, & ! (out) optional & space_average = SpaceAverage, & ! (out) optional & newfile_intvalue = NewFileIntValue, & ! (out) optional & newfile_intunit = NewFileIntUnit, & ! (out) optional & fileprefix = FilePrefix ) ! (out) optional read( unit = unit_nml, & ! (in) & nml = gt4_historyauto_nml, & ! (out) & iostat = iostat_nml ) ! (out) inquire( unit = unit_nml, & ! (in) & position = pos_nml ) ! (out) if ( iostat_nml == 0 ) then ! 情報の登録 ! Register information ! call HstNmlInfoAdd( & & gthstnml = gthstnml, & ! (inout) & name = Name, & ! (in) optional & file = File, & ! (in) optional & interval_value = IntValue, & ! (in) optional & interval_unit = IntUnit, & ! (in) optional & precision = Precision, & ! (in) optional & time_average = TimeAverage, & ! (in) optional & origin_value = OriginValue, & ! (in) optional & origin_unit = OriginUnit, & ! (in) optional & terminus_value = TerminusValue, & ! (in) optional & terminus_unit = TerminusUnit, & ! (in) optional & slice_start = SliceStart, & ! (in) optional & slice_end = SliceEnd, & ! (in) optional & slice_stride = SliceStride, & ! (in) optional & space_average = SpaceAverage, & ! (in) optional & newfile_intvalue = NewFileIntValue, & ! (in) optional & newfile_intunit = NewFileIntUnit, & ! (in) optional & fileprefix = FilePrefix ) ! (in) optional ! 登録変数を全て出力するためのフラグの保管 ! Save flag for output all registered variables ! if ( trim(Name) == '' ) then all_output_save = AllOutput end if ! 印字 ; Print ! if ( trim(File) == '' ) File = trim(FilePrefix) // '.nc' if ( trim(Name) == '' ) then call MessageNotify( 'M', sub_sname, 'Global Settings:' ) call MessageNotify( 'M', sub_sname, ' AllOutput = %b', l = (/ AllOutput /) ) call MessageNotify( 'M', sub_sname, ' FilePrefix = %c', c1 = trim(FilePrefix ) ) else call MessageNotify( 'M', sub_sname, 'Individual Settings:' ) call MessageNotify( 'M', sub_sname, ' Name = %c', c1 = trim(Name ) ) call MessageNotify( 'M', sub_sname, ' File = %c', c1 = trim(File ) ) end if call MessageNotify( 'M', sub_sname, ' Interval = %r [%c]', & & r = (/ IntValue /), c1 = trim( IntUnit ) ) call MessageNotify( 'M', sub_sname, ' Precision = %c', c1 = trim(Precision ) ) call MessageNotify( 'M', sub_sname, ' TimeAverage = %b', l = (/ TimeAverage /) ) call MessageNotify( 'M', sub_sname, ' Origin = %r [%c]', & & r = (/ OriginValue /), c1 = trim( OriginUnit ) ) call MessageNotify( 'M', sub_sname, ' Terminus = %r [%c]', & & r = (/ TerminusValue /), c1 = trim( TerminusUnit ) ) call MessageNotify( 'M', sub_sname, ' SliceStart = (/ %*d /)', & & i = SliceStart(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' SliceEnd = (/ %*d /)', & & i = SliceEnd(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' SliceStride = (/ %*d /)', & & i = SliceStride(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' SpaceAverage = (/ %*b /)', & & l = SpaceAverage(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' NewFileInterval = %d [%c]', & & i = (/ NewFileIntValue /), c1 = trim( NewFileIntUnit ) ) call MessageNotify( 'M', sub_sname, '' ) else call MessageNotify( 'M', sub_sname, '----- loading is finished (iostat=%d) -----', & & i = (/iostat_nml/) ) end if end do close( unit_nml ) ! NAMELIST ファイルを読み込まない場合 ! NAMELIST file is not loaded ! else call MessageNotify( 'M', sub_sname, '----- "gt4_historyauto_nml" is not loaded" -----' ) Name = '' File = '' call HstNmlInfoInquire( & & gthstnml = gthstnml, & ! (in) & interval_value = IntValue, & ! (out) optional & interval_unit = IntUnit, & ! (out) optional & precision = Precision, & ! (out) optional & time_average = TimeAverage, & ! (out) optional & origin_value = OriginValue, & ! (out) optional & origin_unit = OriginUnit, & ! (out) optional & terminus_value = TerminusValue, & ! (out) optional & terminus_unit = TerminusUnit, & ! (out) optional & slice_start = SliceStart, & ! (out) optional & slice_end = SliceEnd, & ! (out) optional & slice_stride = SliceStride, & ! (out) optional & space_average = SpaceAverage, & ! (out) optional & newfile_intvalue = NewFileIntValue, & ! (out) optional & newfile_intunit = NewFileIntUnit, & ! (out) optional & fileprefix = FilePrefix ) ! (out) optional ! 印字 ; Print ! call MessageNotify( 'M', sub_sname, 'Global Settings:' ) call MessageNotify( 'M', sub_sname, ' AllOutput = %b', l = (/ AllOutput /) ) call MessageNotify( 'M', sub_sname, ' FilePrefix = %c', c1 = trim(FilePrefix ) ) call MessageNotify( 'M', sub_sname, ' Interval = %r [%c]', & & r = (/ IntValue /), c1 = trim( IntUnit ) ) call MessageNotify( 'M', sub_sname, ' Precision = %c', c1 = trim(Precision ) ) call MessageNotify( 'M', sub_sname, ' TimeAverage = %b', l = (/ TimeAverage /) ) call MessageNotify( 'M', sub_sname, ' Origin = %r [%c]', & & r = (/ OriginValue /), c1 = trim( OriginUnit ) ) call MessageNotify( 'M', sub_sname, ' Terminus = %r [%c]', & & r = (/ TerminusValue /), c1 = trim( TerminusUnit ) ) call MessageNotify( 'M', sub_sname, ' SliceStart = (/ %*d /)', & & i = SliceStart(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' SliceEnd = (/ %*d /)', & & i = SliceEnd(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' SliceStride = (/ %*d /)', & & i = SliceStride(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' SpaceAverage = (/ %*b /)', & & l = SpaceAverage(1:numdims-1), n = (/ numdims-1 /) ) call MessageNotify( 'M', sub_sname, ' NewFileInterval = %d [%c]', & & i = (/ NewFileIntValue /), c1 = trim( NewFileIntUnit ) ) call MessageNotify( 'M', sub_sname, '' ) end if ! 終了処理, 例外処理 ! Termination and Exception handling ! initialized = .true. 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname, 'stat=%d', i = (/stat/) ) end subroutine HistoryAutoCreate1 subroutine HistoryAutoClose1 ! ! HistoryAutoCreate で始まったデータ出力の終了処理を行います. ! プログラムを終了する前に必ずこのサブルーチンを呼んでください. ! ! Terminates data output with "HistoryAutoCreate". ! Call this subroutine certainly before a progrem is finished. ! use dc_trace, only: BeginSub, EndSub use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT use gt4_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoGetNames, & & HstNmlInfoAssocGtHist, HstNmlInfoPutLine use gt4_history, only: GT_HISTORY, HistoryClose, HistoryInitialized, & & HistoryAxisClear, HistoryVarinfoClear ! ヒストリファイルへのデータ出力設定 ! Configure the settings for history data output ! character(STRING):: name = '' ! 変数名. Variable identifier character(TOKEN), pointer:: varnames_array(:) =>null() ! 変数名リスト配列. ! List of variables (array) integer:: i, vnmax type(GT_HISTORY), pointer:: gthist =>null() ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module ! 作業変数 ! Work variables ! integer:: stat character(STRING):: cause_c character(*), parameter:: subname = 'HistoryAutoClose1' continue call BeginSub( subname ) stat = DC_NOERR cause_c = '' ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gt4_historyauto' goto 999 end if ! ヒストリファイルへのデータ出力の終了処理 ! Terminate the settings for history data output ! call HstNmlInfoGetNames( gthstnml, & ! (in) & varnames_array ) ! (out) vnmax = size( varnames_array ) do i = 1, vnmax name = varnames_array(i) if ( trim( name ) == '' ) exit nullify( gthist ) call HstNmlInfoAssocGtHist( & & gthstnml = gthstnml, & ! (in) & name = name, & ! (in) & history = gthist ) ! (out) if ( HistoryInitialized( gthist ) ) then call HistoryClose( history = gthist ) ! (inout) end if end do ! ヒストリファイルへのデータ出力設定の割付解除 ! Deallocate the settings for history data output ! call HstNmlInfoClose( gthstnml ) ! (inout) ! 座標軸情報のクリア ! Create axes information ! do i = 1, numdims call HistoryAxisClear( gthst_axes(i) ) deallocate( data_axes(i) % a_axis ) end do numdims = 0 ! 座標重み情報のクリア ! Create axes weights information ! do i = 1, numwgts call HistoryVarinfoClear( gthst_weights(i) ) deallocate( data_weights(i) % a_axis ) end do numwgts = 0 ! 変数情報のクリア ! Create variables information ! do i = 1, numvars call HistoryVarinfoClear( gthst_vars(i) ) if ( associated( slice_vars(i) % st ) ) deallocate( slice_vars(i) % st ) if ( associated( slice_vars(i) % ed ) ) deallocate( slice_vars(i) % ed ) if ( associated( slice_vars(i) % sd ) ) deallocate( slice_vars(i) % sd ) #{forloop("\\$num\\$", 1, $histput_dim, %Q{ if ( associated( weight_vars(i) % wgt$num$ ) ) deallocate( weight_vars(i) % wgt$num$ ) })} if ( associated( space_avr_vars(i) % avr ) ) deallocate( space_avr_vars(i) % avr ) varname_vars(i) = '' output_valid_vars(i) = .false. output_timing_vars(i) = .false. intstep_vars(i) = 1 originstep_vars(i) = 0 terminusstep_vars(i) = -1 newfile_intstep_vars(i) = -1 tavr_vars(i) = .false. deltime_value_vars(i) = 1.0 origin_value_vars(i) = 0.0 end do numvars = 0 ! 時刻データのクリア ! Clear time data ! Nstep = 0 ! 終了処理, 例外処理 ! Termination and Exception handling ! initialized = .false. once_progressed = .false. all_output_save = .false. 999 continue call StoreError( stat, subname, cause_c = cause_c ) call EndSub( subname ) end subroutine HistoryAutoClose1 __EndOfFortran90Code__ types = ["Real", "Double", "Int"] types.each{ |type| print <<"__EndOfFortran90Code__" subroutine HistoryAutoAddWeight#{type}( & & dim, weight, & ! (in) & units, xtype & ! (in) optional & ) ! ! 座標の重みデータを設定します. ! ! Set weights of axes. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, & & GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gt4_history, only: HistoryAxisInquire, HistoryAxisAddAttr, & & HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標重みを設定する座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis to which "weight" are set. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! #{$type_intent_in[type]}, intent(in):: weight(:) ! 座標重みデータ. ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! xtype もしくは座標データの型へと ! 変換されます. ! ! Weight of axis. ! ! Integer, single or double precision are ! acceptable as data type. ! Note that when this is output to a file, ! data type is converted into "xtype" or ! type of the axis. ! character(*), intent(in), optional:: units ! 座標重みの単位. ! 省略した場合には, 座標の単位が ! 使用されます. ! ! Units of axis weight. ! If this argument is omitted, ! unit of the dimension is used. ! character(*), intent(in), optional:: xtype ! 座標重みのデータ型. ! 省略した場合には, 座標のデータ型が ! 使用されます. ! ! Data type of weight of the dimension. ! If this argument is omitted, ! data type of the dimension is used. ! character(STRING):: name, longname character(TOKEN):: dim_units, dim_xtype integer:: dim_size integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddWeight#{type}" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gt4_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( & & axis = gthst_axes(i), & ! (in) & name = name, & ! (out) & size = dim_size, & ! (out) & longname = longname, & ! (out) & units = dim_units, & ! (out) & xtype = dim_xtype ) ! (out) if ( trim(dim) == trim(name) ) then if ( dim_size /= size(weight) ) then stat = GT_EARGSIZEMISMATCH cause_c = 'weight' end if if ( present(units) ) dim_units = units if ( present(xtype) ) dim_xtype = xtype call HistoryVarinfoCreate( & & varinfo = gthst_weights(numwgts + 1), & ! (out) & name = trim(dim) // wgtsuf, dims = (/ dim /), & ! (in) & longname = 'weight for integration or average in ' // & & trim(longname), & ! (in) & units = dim_units, xtype = dim_xtype ) ! (in) call HistoryAxisAddAttr( & & axis = gthst_axes(i), & ! (inout) & attrname = 'gt_calc_weight', & ! (in) & value = trim(dim) // wgtsuf ) ! (in) allocate( data_weights(numwgts + 1) % a_axis( dim_size ) ) data_weights(numwgts + 1) % a_axis = weight numwgts = numwgts + 1 goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddWeight#{type} __EndOfFortran90Code__ } types = ["Real", "Double", "Int"] types.each{ |type| print <<"__EndOfFortran90Code__" subroutine HistoryAutoPutAxis#{type}( & & dim, array & ! (in) & ) ! ! 座標データを設定します. ! ! Set data of an axis. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, & & GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gt4_history, only: HistoryAxisInquire, HistoryAxisAddAttr, & & HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! #{$type_intent_in[type]}, intent(in):: array(:) ! 座標データ ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! HistoryAutoCreate の *xtypes* で指定した ! データ型へ変換されます. ! ! Data of axis ! ! Integer, single or double precision are ! acceptable as data type. ! Note that when this is output to a file, ! data type is converted into "xtypes" ! specified in "HistoryAutoCreate" ! character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoPutAxis#{type}" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gt4_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( & & axis = gthst_axes(i), & ! (in) & name = name ) ! (out) if ( trim(dim) == trim(name) ) then data_axes(i) % a_axis = array goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoPutAxis#{type} __EndOfFortran90Code__ } print <<"__EndOfFortran90Code__" subroutine HistoryAutoAddVariable1( & & varname, dims, longname, units, & ! (in) & xtype, time_units, time_average, & ! (in) optional & file, & ! (in) optional & origin, terminus, interval, & ! (in) optional & slice_start, slice_end, slice_stride, & ! (in) optional & space_average, & ! (in) optional & newfile_interval & ! (in) optional & ) ! ! ヒストリデータ出力するための変数登録を行います. ! ! HistoryAutoProgress を呼ぶ前にこのサブルーチンを使用してください. ! ! Register variables for history data output ! ! Use this subroutine before "HistoryAutoProgress" is called. ! ! モジュール引用 ; USE statements ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_EVARINUSE, & & HST_EALREADYPROGRESS, DC_ENOTINIT, HST_EMAXDIMSDEPENDED, & & HST_EINDIVISIBLE use dc_message, only: MessageNotify use dc_string, only: StrInclude, JoinChar, toChar use dc_date, only: DCDiffTimeCreate, operator(/), mod, EvalSec, & & operator(-), EvalbyUnit use netcdf_f77, only: NF_EMAXVARS use gt4_history, only: HistoryVarinfoCreate, HistoryVarinfoInquire, & & HistoryAxisInquire use gt4_history_nmlinfo, only: HstNmlInfoSetValidName, & & HstNmlInfoDefineMode, HstNmlInfoReDefine, HstNmlInfoEndDefine, & & HstNmlInfoAdd, HstNmlInfoInquire, HstNmlInfoOutputValid, & & HstNmlInfoAssocGtHist ! 宣言文 ; Declaration statements ! implicit none character(*), intent(in):: varname ! 変数名. Variable name character(*), intent(in):: dims(:) ! 変数が依存する次元の名前. ! 時間の次元は配列の最後に指定すること. ! ! Names of dependency dimensions of a variable. ! Dimension of time must be specified ! to last of an array. character(*), intent(in):: longname ! 変数の記述的名称. ! ! Descriptive name of a variable character(*), intent(in):: units ! 変数の単位. ! ! Units of a variable character(*), intent(in), optional:: xtype ! ! 変数のデータ型 ! ! デフォルトは float (単精度実数型) であ ! る. 有効なのは, double (倍精度実数型), ! int (整数型) である. 指定しない場合や, ! 無効な型を指定した場合には, float (単 ! 精度実数型) となる. ! ! Data types of dimensions specified ! with "dims". ! ! Default value is "float" (single precision). ! Other valid values are ! "double" (double precision), ! "int" (integer). ! If no value or invalid value is specified, ! "float" is applied. ! character(*), intent(in), optional:: time_units ! 時刻次元の単位. ! Units of time dimension. logical, intent(in), optional:: time_average ! ! 出力データを時間平均する場合には ! .true. を与えます. デフォルトは ! .false. です. ! ! If output data is averaged, specify ! ".true.". Default is ".false.". ! character(*), intent(in), optional:: file ! 出力ファイル名. ! Output file name. real, intent(in), optional:: origin ! 出力開始時刻. ! ! 省略した場合, 自動的に current_time の値が ! 設定されます. ! ! Start time of output. ! ! If this argument is omitted, ! a value of "current_time" is specified ! automatically. ! real, intent(in), optional:: terminus ! 出力終了時刻. ! ! 省略した場合, 数値モデルの実行が終了するまで ! 出力を行います. ! ! End time of output. ! ! If this argument is omitted, ! output is continued until a numerical model ! is finished. ! real, intent(in), optional:: interval ! 出力時間間隔. ! ! 省略した場合, ! 自動的に delta_time の値が設定されます. ! ! Interval of output time. ! ! If this argument is omitted, ! a value of "delta_time" is specified ! automatically. ! integer, intent(in), optional:: slice_start(:) ! 空間方向の開始点. ! ! 省略した場合, 座標データの開始点が設定されます. ! ! Start points of spaces. ! ! If this argument is omitted, ! start points of dimensions are set. ! integer, intent(in), optional:: slice_end(:) ! 空間方向の終了点. ! ! 省略した場合, 座標データの終了点が設定されます. ! ! End points of spaces. ! ! If this argument is omitted, ! End points of dimensions are set. ! integer, intent(in), optional:: slice_stride(:) ! 空間方向の刻み幅. ! ! 省略した場合, 1 が設定されます. ! ! Strides of spaces ! ! If this argument is omitted, ! 1 is set. ! logical, intent(in), optional:: space_average(:) ! 平均化のフラグ. ! ! .true. が指定される座標に対して平均化を ! 行います. ! 省略した場合, .false. が設定されます. ! ! Flag of average. ! ! Axes specified .true. are averaged. ! If this argument is omitted, ! .false. is set. ! integer, intent(in), optional:: newfile_interval ! ファイル分割時間間隔. ! ! 省略した場合, ! 時間方向へのファイル分割を行いません. ! ! Interval of time of separation of a file. ! ! If this argument is omitted, ! a files is not separated in time direction. ! ! 作業変数 ! Work variables ! character(TOKEN):: interval_unit_work ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output character(TOKEN):: origin_unit_work ! 出力開始時刻の単位. ! Unit of start time of output. character(TOKEN):: terminus_unit_work ! 出力終了時刻の単位. ! Unit of end time of output. character(TOKEN):: newfile_intunit_work ! ファイル分割時間間隔の単位. ! Unit of interval of time of separation of a file. real:: interval_value ! ヒストリデータの出力間隔の数値. ! Numerical value for interval of history data output real:: origin_value ! ヒストリデータの出力開始時刻の数値. ! Numerical value for start time of history data output real:: terminus_value ! 出力終了時刻の数値. ! Numerical value for end time of output. integer:: newfile_intvalue ! ファイル分割時間間隔. ! Interval of time of separation of a file. type(DC_DIFFTIME):: interval_difftime, origin_difftime, terminus_difftime, newfileint_difftime character(TOKEN):: time_name ! 時刻次元の名称. ! Name of time dimension character(STRING), allocatable:: dims_work(:) ! 変数が依存する次元の名前. ! Names of dependency dimensions of a variable. character(TOKEN):: precision ! ヒストリデータの精度. ! Precision of history data logical:: time_average_work ! 出力データの時間平均フラグ. ! Flag for time average of output data logical:: space_average_work(1:numdims-1) integer:: slice_start_work(1:numdims-1) ! 空間方向の開始点. ! Start points of spaces. integer:: slice_end_work(1:numdims-1) ! 空間方向の終了点. ! End points of spaces. integer:: slice_stride_work(1:numdims-1) ! 空間方向の刻み幅. ! Strides of spaces logical:: define_mode, varname_not_found integer:: cause_i, stat, i, j, k, cnt, cnt2, dim_size character(TOKEN), pointer:: dims_noavr(:) =>null(), dims_avr(:) =>null() character(STRING):: longname_avrmsg character(STRING):: name, cause_c character(*), parameter:: subname = "HistoryAutoAddVariable1" continue call BeginSub(subname, 'varname=%c', c1 = trim(varname), version = version) stat = DC_NOERR cause_c = "" cause_i = 0 ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gt4_historyauto' goto 999 end if ! 既に HistoryAutoProgress が呼ばれていたらエラー ! Error is occurred if "HistoryAutoProgress" is called already ! if ( once_progressed ) then call MessageNotify( 'W', subname, & & '"HistoryAutoAddVariable" (varname = %c) must be called before "HistoryAutoProgress"', & & c1 = trim(varname) ) stat = HST_EALREADYPROGRESS cause_c = 'HistoryAutoProgress' goto 999 end if ! 重複のチェック ! Check duplication ! do i = 1, numvars call HistoryVarinfoInquire( & & varinfo = gthst_vars(i), & ! (in) & name = name ) ! (out) if ( trim(varname) == trim(name) ) then stat = HST_EVARINUSE cause_c = varname goto 999 end if end do ! 変数の数の限界チェック ! Check limit of number of variables ! if ( numvars + 1 > NF_MAX_VARS ) then stat = NF_EMAXVARS goto 999 end if ! 時刻の次元に関する修正 ! Correction for time dimension ! call HistoryAxisInquire( & & axis = gthst_axes(numdims), & ! (in) & name = time_name ) ! (out) if ( size(dims) > 0 ) then if ( StrInclude( dims, time_name ) ) then if ( trim( dims(size(dims)) ) == trim( time_name ) ) then allocate( dims_work(size(dims)) ) dims_work = dims else allocate( dims_work(size(dims)) ) cnt = 1 do i = 1, size(dims) if ( trim( dims(i) ) /= trim( time_name ) ) then dims_work( cnt ) = dims( i ) cnt = cnt + 1 end if end do dims_work(size(dims)) = time_name call MessageNotify( 'W', subname, & & 'last entity of "dims=<%c>" must be time dimension (varname=<%c>). ' // & & ' "dims" are resequenced forcibly => <%c>', & & c1 = trim( JoinChar(dims, ',') ), c2 = trim( varname ), & & c3 = trim( JoinChar(dims_work, ',') ) ) end if else allocate( dims_work(size(dims)+1) ) dims_work(1:size(dims)) = dims dims_work(size(dims)+1) = time_name call MessageNotify( 'W', subname, & & 'time dimension is not found in "dims=<%c>" (varname=<%c>). ' // & & ' time dimensin "%c" is appended to "dims" forcibly.', & & c1 = trim( JoinChar(dims, ',') ), c2 = trim( varname ), & & c3 = trim( time_name ) ) end if else allocate( dims_work(1) ) dims_work(1) = time_name call MessageNotify( 'W', subname, & & 'time dimension is not found (varname=<%c>). ' // & & ' time dimensin "%c" is appended to "dims" forcibly.', & & c1 = trim( varname ), & & c2 = trim( time_name ) ) end if ! 依存する次元の数の限界チェック ! Check limit of number of depended dimensions ! if ( size( dims_work ) - 1 > MAX_DIMS_DEPENDED_BY_VAR ) then call MessageNotify( 'W', subname, & & 'number of dimensions' // & & ' on which one variable depends must not be greater than %d (varname=<%c>, dims=<%c>). ', & & i = (/ #{$histput_dim} + 1 /), & & c1 = trim( varname ), c2 = trim( JoinChar(dims_work, ',') ) ) stat = HST_EMAXDIMSDEPENDED cause_i = size( dims_work ) cause_c = varname end if ! 全ての変数を出力する際には, ここで登録 ! Register here if all variables are output ! if ( all_output_save ) then call HstNmlInfoInquire( & & gthstnml = gthstnml, name = varname, & ! (in) & err = varname_not_found ) ! (out) optional if ( varname_not_found ) then define_mode = HstNmlInfoDefineMode( gthstnml ) if ( .not. define_mode ) call HstNmlInfoReDefine( gthstnml ) ! (inout) call HstNmlInfoInquire( & & gthstnml = gthstnml, & ! (in) & interval_unit = interval_unit_work, & ! (out) optional & origin_unit = origin_unit_work , & ! (out) optional & terminus_unit = terminus_unit_work, & ! (out) optional & newfile_intunit = newfile_intunit_work ) ! (out) optional ! 時刻の単位を設定 ! Configure unit of time ! if ( present( interval ) ) then interval_unit_work = time_unit_bycreate if ( present(time_units) ) interval_unit_work = time_units end if if ( present( origin ) ) then origin_unit_work = time_unit_bycreate if ( present(time_units) ) origin_unit_work = time_units end if if ( present( terminus ) ) then terminus_unit_work = time_unit_bycreate if ( present(time_units) ) terminus_unit_work = time_units end if if ( present( newfile_interval ) ) then newfile_intunit_work = time_unit_bycreate if ( present(time_units) ) newfile_intunit_work = time_units end if call HstNmlInfoAdd( & & gthstnml = gthstnml, & ! (inout) & name = varname, & ! (in) optional & file = file, & ! (in) optional & precision = xtype, & ! (in) optional & interval_value = interval, & ! (in) optional & interval_unit = interval_unit_work, & ! (in) optional & origin_value = origin, & ! (in) optional & origin_unit = origin_unit_work, & ! (in) optional & terminus_value = terminus, & ! (in) optional & terminus_unit = terminus_unit_work, & ! (in) optional & slice_start = slice_start, & ! (in) optional & slice_end = slice_end, & ! (in) optional & slice_stride = slice_stride, & ! (in) optional & time_average = time_average, & ! (in) optional & space_average = space_average, & ! (in) optional & newfile_intvalue = newfile_interval, & ! (in) optional & newfile_intunit = newfile_intunit_work ) ! (in) optional if ( .not. define_mode ) call HstNmlInfoEndDefine( gthstnml ) ! (inout) end if end if ! 平均化に伴う次元の縮退を反映した変数情報の作り直し ! Remake information of variables that reflects reduction of dimensions ! correspond to average ! call HstNmlInfoInquire( & & gthstnml = gthstnml, name = varname, & ! (in) & precision = precision, & ! (out) optional & time_average = time_average_work, & ! (out) optional & space_average = space_average_work, & ! (out) optional & slice_start = slice_start_work, & ! (out) & slice_end = slice_end_work, & ! (out) & slice_stride = slice_stride_work, & ! (out) & err = varname_not_found ) ! (out) optional if ( varname_not_found ) then call HstNmlInfoInquire( & & gthstnml = gthstnml, name = '', & ! (in) & precision = precision, & ! (out) optional & time_average = time_average_work, & ! (out) optional & space_average = space_average_work, & ! (out) optional & slice_start = slice_start_work, & ! (out) & slice_end = slice_end_work, & ! (out) & slice_stride = slice_stride_work ) ! (out) end if if ( .not. associated( space_avr_vars(numvars + 1) % avr ) ) & & allocate( space_avr_vars(numvars + 1) % avr( size( dims_work ) - 1 ) ) space_avr_vars(numvars + 1) % avr = .false. do i = 1, size( dims_work ) - 1 do j = 1, numdims - 1 call HistoryAxisInquire( & & axis = gthst_axes(j), & ! (in) & name = name ) ! (out) if ( trim(dims_work(i)) == trim(name) ) then space_avr_vars(numvars + 1) % avr( i ) = space_average_work( j ) exit end if end do end do allocate( dims_noavr ( size(dims_work) - count(space_avr_vars(numvars + 1) % avr) ) ) if ( count(space_avr_vars(numvars + 1) % avr) < 1 ) then dims_noavr = dims_work longname_avrmsg = '' else allocate( dims_avr( count(space_avr_vars(numvars + 1) % avr) ) ) cnt = 1 ; cnt2 = 1 do i = 1, size( dims_work ) - 1 if ( .not. space_avr_vars(numvars + 1) % avr(i) ) then dims_noavr( cnt ) = dims_work( i ) cnt = cnt + 1 else dims_avr( cnt2 ) = dims_work( i ) cnt2 = cnt2 + 1 end if end do dims_noavr( cnt ) = dims_work( size ( dims_work ) ) longname_avrmsg = ' averaged in ' // trim( JoinChar( dims_avr, ',' ) ) // '-direction' deallocate( dims_avr ) end if ! HistoryPut の際のデータの切り出し情報作成 ! Create information of slices of data for "HistoryPut" ! if ( .not. associated( slice_vars(numvars + 1) % st ) ) & & allocate( slice_vars(numvars + 1) % st( NF_MAX_DIMS ) ) if ( .not. associated( slice_vars(numvars + 1) % ed ) ) & & allocate( slice_vars(numvars + 1) % ed( NF_MAX_DIMS ) ) if ( .not. associated( slice_vars(numvars + 1) % sd ) ) & & allocate( slice_vars(numvars + 1) % sd( NF_MAX_DIMS ) ) slice_vars(numvars + 1) % st = 1 slice_vars(numvars + 1) % ed = 1 slice_vars(numvars + 1) % sd = 1 if ( size(dims_work) > 1 ) then slice_subscript_search: do i = 1, size( dims_work ) - 1 do j = 1, numdims - 1 call HistoryAxisInquire( & & axis = gthst_axes(j), & ! (in) & name = name, & ! (out) & size = dim_size ) ! (out) if ( slice_end_work(j) < 1 ) slice_end_work(j) = dim_size if ( trim(dims_work(i)) == trim(name) ) then slice_vars(numvars + 1) % st( i ) = slice_start_work( j ) slice_vars(numvars + 1) % ed( i ) = slice_end_work( j ) slice_vars(numvars + 1) % sd( i ) = slice_stride_work( j ) cycle slice_subscript_search end if end do end do slice_subscript_search end if ! HistoryPut の際の座標重み情報作成 ! Create information of axes weight for "HistoryPut" ! #{forloop("\\$num\\$", 1, $histput_dim, %Q{ if ( .not. associated( weight_vars(numvars + 1) % wgt$num$ ) ) & & allocate( weight_vars(numvars + 1) % wgt$num$( 1 ) ) weight_vars(numvars + 1) % wgt$num$ = 1.0_DP if ( size(dims_work) >= $num$ ) then do j = 1, numdims - 1 call HistoryAxisInquire( & & axis = gthst_axes(j), & ! (in) & name = name, & ! (out) & size = dim_size ) ! (out) if ( trim(dims_work($num$)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt$num$ ) allocate( weight_vars(numvars + 1) % wgt$num$( dim_size ) ) weight_vars(numvars + 1) % wgt$num$ = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( & & varinfo = gthst_weights(k), & ! (in) & name = name ) ! (out) if ( trim(dims_work($num$)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt$num$ = data_weights( k ) % a_axis exit end if end do exit end if end do end if })} ! 変数名の有効性を設定 ! Set validation of the variable name ! call HstNmlInfoSetValidName( & & gthstnml = gthstnml, name = varname ) ! (in) ! 変数情報の登録 ! Register information of variable ! call HistoryVarinfoCreate( & & varinfo = gthst_vars(numvars + 1), & ! (out) & name = varname, dims = dims_noavr, & ! (in) & longname = trim(longname) // longname_avrmsg , & ! (in) & units = units, xtype = precision, & ! (in) & time_average = time_average_work ) ! (in) optional varname_vars(numvars + 1) = varname tavr_vars(numvars + 1) = time_average_work deallocate( dims_noavr ) deallocate( dims_work ) ! 出力の有効かどうかを確認する ! Confirm whether the output is effective ! output_valid_vars(numvars + 1) = HstNmlInfoOutputValid( gthstnml, varname ) ! 各ステップ数を算出する. ! Calculate number of each step ! if ( output_valid_vars(numvars + 1) ) then call HstNmlInfoInquire( & & gthstnml = gthstnml, & ! (in) & name = varname, & ! (in) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit_work, & ! (out) & origin_value = origin_value, & ! (out) & origin_unit = origin_unit_work, & ! (out) & terminus_value = terminus_value, & ! (out) & terminus_unit = terminus_unit_work, & ! (out) & newfile_intvalue = newfile_intvalue, & ! (out) & newfile_intunit = newfile_intunit_work ) ! (out) ! 出力間隔ステップ数を算出する. ! Calculate number of step of interval of output ! call DCDiffTimeCreate( & & interval_difftime, & ! (out) & interval_value, interval_unit_work ) ! (in) deltime_value_vars(numvars + 1) = EvalbyUnit( delta_difftime, interval_unit_work ) intstep_vars(numvars + 1) = nint( interval_difftime / delta_difftime ) if ( EvalSec( mod(interval_difftime, delta_difftime) ) > max_remainder_range ) then call MessageNotify( 'W', subname, & & 'interval=<%r [%c]> can not be divided by deltime=<%f [s]>', & & r = (/ interval_value /), d = (/ EvalSec(delta_difftime) /), & & c1 = trim(interval_unit_work) ) stat = HST_EINDIVISIBLE cause_c = 'interval=' // trim(toChar(interval_value)) // & & ' [' // trim(interval_unit_work) // ']' goto 999 end if ! ファイルを作成するステップ数を算出する. ! Calculate number of step of interval of output ! if ( origin_value > 0.0 ) then call DCDiffTimeCreate( & & origin_difftime, & ! (out) & origin_value, origin_unit_work ) ! (in) origin_value_vars(numvars + 1) = EvalbyUnit( origin_difftime, interval_unit_work ) originstep_vars(numvars + 1) = & & nint( ( origin_difftime - start_difftime ) / delta_difftime ) if ( EvalSec( mod( ( origin_difftime - start_difftime ), & & delta_difftime ) ) > max_remainder_range& & ) then call MessageNotify( 'W', subname, & & 'origin=<%r [%c]> - start=<%d [%c]> can not be divided by deltime=<%f [s]>', & & r = (/ origin_value /), & & d = (/ EvalbyUnit(start_difftime, origin_unit_work), & & EvalSec(delta_difftime) /), & & c1 = trim(origin_unit_work), c2 = trim(origin_unit_work) ) stat = HST_EINDIVISIBLE cause_c = 'origin=' // trim(toChar(origin_value)) // & & ' [' // trim(origin_unit_work) // ']' goto 999 end if end if ! ファイルをクローズするステップ数を算出する. ! Calculate number of step of closure of file ! if ( terminus_value > 0.0 ) then call DCDiffTimeCreate( & & terminus_difftime, & ! (out) & terminus_value, terminus_unit_work ) ! (in) terminusstep_vars(numvars + 1) = & & nint( ( terminus_difftime - start_difftime ) / delta_difftime ) + 1 if ( EvalSec( mod( ( terminus_difftime - start_difftime ), & & delta_difftime ) ) > max_remainder_range& & ) then call MessageNotify( 'W', subname, & & 'terminus=<%r [%c]> - start=<%d [%c]> can not be divided by deltime=<%f [s]>', & & r = (/ terminus_value /), & & d = (/ EvalbyUnit(start_difftime, terminus_unit_work), & & EvalSec(delta_difftime) /), & & c1 = trim(terminus_unit_work), c2 = trim(terminus_unit_work) ) stat = HST_EINDIVISIBLE cause_c = 'terminus=' // trim(toChar(terminus_value)) // & & ' [' // trim(terminus_unit_work) // ']' goto 999 end if end if ! ファイルを新規に作り直すステップ数の算出 ! Calculate number of step of remake of file if ( newfile_intvalue > 0.0 ) then call DCDiffTimeCreate( & & newfileint_difftime, & ! (out) & real( newfile_intvalue ), newfile_intunit_work ) ! (in) newfile_intstep_vars(numvars + 1) = & & nint( ( newfileint_difftime ) / delta_difftime ) if ( EvalSec( mod( newfileint_difftime, delta_difftime ) ) > max_remainder_range ) then call MessageNotify( 'W', subname, & & 'newfile_interval=<%d [%c]> can not be divided by deltime=<%f [s]>', & & i = (/ newfile_intvalue /), d = (/ EvalSec(delta_difftime) /), & & c1 = trim(newfile_intunit_work) ) stat = HST_EINDIVISIBLE cause_c = 'newfile_interval=' // trim(toChar(newfile_intvalue)) // & & ' [' // trim(newfile_intunit_work) // ']' goto 999 end if if ( EvalSec( mod( newfileint_difftime, interval_difftime ) ) > max_remainder_range ) then call MessageNotify( 'W', subname, & & 'newfile_interval=<%d [%c]> can not be divided by interval=<%r [%c]>', & & i = (/ newfile_intvalue /), r = (/ interval_value /), & & c1 = trim(newfile_intunit_work), c2 = trim(interval_unit_work) ) stat = HST_EINDIVISIBLE cause_c = 'newfile_interval=' // trim(toChar(newfile_intvalue)) // & & ' [' // trim(newfile_intunit_work) // ']' goto 999 end if if ( .not. newfile_intstep_vars(numvars + 1) > intstep_vars(numvars + 1) ) then call MessageNotify( 'W', subname, & & 'newfile_interval=<%d [%c]> must be greater than interval=<%r [%c]>', & & i = (/ newfile_intvalue /), r = (/ interval_value /), & & c1 = trim(newfile_intunit_work), c2 = trim(interval_unit_work) ) stat = HST_EINDIVISIBLE cause_c = 'newfile_interval=' // trim(toChar(newfile_intvalue)) // & & ' [' // trim(newfile_intunit_work) // ']' goto 999 end if end if end if ! GT_HISTORY 変数の取得 ! Get "GT_HISTORY" variable ! if ( output_valid_vars(numvars + 1) ) then define_mode = HstNmlInfoDefineMode( gthstnml ) if ( define_mode ) call HstNmlInfoEndDefine( gthstnml ) ! (inout) call HstNmlInfoAssocGtHist( & & gthstnml = gthstnml, name = varname, & ! (in) & history = gthst_history_vars(numvars + 1) % gthist ) ! (out) if ( define_mode ) call HstNmlInfoReDefine( gthstnml ) ! (inout) end if ! 登録変数の数を更新 ! Update number of registered variables ! numvars = numvars + 1 999 continue call StoreError(stat, subname, cause_c = cause_c, cause_i = cause_i) call EndSub(subname, 'stat=%d', i = (/stat/) ) end subroutine HistoryAutoAddVariable1 __EndOfFortran90Code__ types = ["Char", "Logical", "Int", "Real", "Double"] def toChar(type, value) return "trim(#{value})" if type == "Char" return "trim(toChar(#{value}))" end def Num2Array(type, value) return value if type == "Char" return value if type == "Logical" return "(/#{value}/)" end types.each{ |type| for num in 0..1 next if num == 1 && type == "Char" next if num == 1 && type == "Logical" print <<"__EndOfFortran90Code__" subroutine HistoryAutoAddAttr#{type}#{num}( & & varname, attrname, value & ! (in) & ) ! #{ifelse(type, "Char", %Q{ ! ! 座標変数および座標重み変数に属性を付加します. ! このサブルーチンを用いる前に, HistoryAutoCreate による初期設定が ! 必要です. ! ! * 座標変数については, HistoryAutoCreate の "dims" に与えられた ! もののみ指定可能です. ! ! * 座標重み変数については, HistoryAutoAddWeight で与えられた ! もののみ指定可能です. ! ! * *HistoryAutoAddAttr* は複数のサブルーチンの総称名です. *value* ! にはいくつかの型を与えることが可能です. ! 下記のサブルーチンを参照ください. ! ! Add attributes axes or weights of axes. ! Initialization by "HistoryAutoCreate" is needed ! before use of this subroutine. ! ! * About axes, "dims" specified by "HistoryAutoCreate" can be ! specified. ! ! * About weights of axes, "dims" specified by "HistoryAutoAddWeight" ! can be specified. ! ! * "HistoryAutoAddAttr" is a generic name of multiple subroutines. ! Then some data type can be specified to "value". ! })} ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gt4_history, only: HistoryAxisAddAttr, HistoryAxisInquire, & & HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname #{ifelse(type, "Char", %Q{ ! 変数の名前. ! ! ここで指定するものは, ! HistoryAutoCreate の *dims* , ! または HistoryAutoAddWeight の ! *varname* で既に指定されてい ! なければなりません. ! ! Name of a variable. ! ! This must be specified with *dims* ! in HistoryAutoCreate, or ! *varname* in "HistoryAutoAddWeight". ! })} character(*), intent(in):: attrname #{ifelse(type, "Char", %Q{ ! 属性の名前. ! Name of an attribute. })} #{$type_intent_in[type]}, intent(in):: value#{array_colon("#{num}")} #{ifelse(type, "Char", %Q{ ! 属性の値. ! Value of an attribute. })} character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttr#{type}#{num}" continue call BeginSub(subname, & & 'varname=<%c> attrname=<%c>, value=<%c>', & & c1=trim(varname), c2=trim(attrname), c3=#{toChar(type, "value")}) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gt4_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( & & axis = gthst_axes(i), & ! (in) & name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( & & axis = gthst_axes(i), & ! (inout) & attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( & & varinfo = gthst_weights(i), & ! (in) & name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( & & varinfo = gthst_weights(i), & ! (inout) & attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttr#{type}#{num} __EndOfFortran90Code__ end } undef toChar undef Num2Array types = ["Real", "Double", "Int"] def ValueOrArray(num) return "value" if num == 0 return "array" end def ArgsToPut(num) return "(/value/)" if num == 0 return "array" end types.each{ |type| for num in 0..$histput_dim print <<"__EndOfFortran90Code__" subroutine HistoryAutoPut#{type}#{num}( & & varname, #{ValueOrArray(num)}, & ! (in) & err & ! (out) optional & ) ! #{ifelse(num, 1, %Q{ #{ifelse(type, "Double", %Q{ ! ! データの出力を行います. ! このサブルーチンを用いる前に, "HistoryAutoCreate" ! による初期設定が必要です. ! ! *varname* は HistoryAutoAddVariable で指定されている必要があります. ! ! *HistoryAutoPut* は複数のサブルーチンの総称名です. *array* には ! 0 ～ #{$histput_dim} 次元のデータを与えることが可能です. ! (下記のサブルーチンを参照ください). ! また, 整数, 単精度実数, 倍精度実数を与えることが可能です. ! ただし, 0 次元のデータを与える際の引数キーワードは ! *value* を用いてください. ! ! Output data. ! Initialization by "HistoryAutoCreate" is needed ! before use of this subroutine. ! ! "varname" must be specified by "HistoryAutoAddVariable". ! ! "HistoryAutoPut" is a generic name of multiple subroutines. ! Then 0 -- #{$histput_dim} dimensional data can be given to "array". ! (See bellow subroutines). ! And, integer, sinble or double precision can be given. ! However, if 0 dimensional data is given, use "value" as a ! keyword argument. ! })}})} ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, & & HST_EBADVARNAME, DC_ENOTINIT use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), & & operator(>), operator(<), mod, operator(==) use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, & & HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, & & HistoryClose use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, & & HstNmlInfoDefineMode implicit none character(*), intent(in):: varname #{ifelse(num, 1, %Q{ #{ifelse(type, "Double", %Q{ ! 変数の名前. ! ! ただし, ここで指定するものは, ! HistoryAutoAddVariable の ! *varname* で既に指定されてい ! なければなりません. ! ! Name of a variable. ! ! This must be specified ! *varname* in "HistoryAutoAddVariable". })}})} #{$type_intent_in[type]}, intent(in), target:: #{ValueOrArray(num)}#{array_colon("#{num}")} #{ifelse(num, 1, %Q{ #{ifelse(type, "Double", %Q{ ! 出力データ. ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! HistoryAutoAddVariable の *xtypes* で指定した ! データ型へ変換されます. ! ! Output data. ! ! Integer, single or double precision are ! acceptable as data type. ! Note that when this is output to a file, ! data type is converted into "xtype" ! specified in "HistoryAutoAddVariable" ! })}})} logical, intent(out), optional:: err ! 例外処理用フラグ. ! デフォルトでは, この手続き内でエラーが ! 生じた場合, プログラムは強制終了します. ! 引数 *err* が与えられる場合, ! プログラムは強制終了せず, 代わりに ! *err* に .true. が代入されます. ! ! Exception handling flag. ! By default, when error occur in ! this procedure, the program aborts. ! If this *err* argument is given, ! .true. is substituted to *err* and ! the program does not abort. type(GT_HISTORY), pointer:: gthist =>null() ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module #{ifelse(num, 0, %Q{ }, %Q{ #{$type_intent_in[type]}, pointer:: #{ValueOrArray(num)}_slice#{array_colon("#{num}")} =>null() type(SLICE_INFO), pointer:: sv =>null() #{$type_intent_in[type]}, pointer:: #{ValueOrArray(num)}_avr#{array_colon("#{num}")} =>null() })} integer:: stat, i integer:: vnum character(STRING):: cause_c integer, save:: svnum = 1 character(*), parameter:: subname = "HistoryAutoPut#{type}#{num}" continue call BeginSub(subname, 'varname=%c', c1 = trim(varname) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gt4_historyauto' goto 999 end if ! 変数 ID のサーチ ! Search variable ID ! VarSearch: do do i = svnum, numvars if ( trim( varname_vars(i) ) == trim(varname) ) then vnum = i exit VarSearch end if end do do i = 1, svnum - 1 if ( trim( varname_vars(i) ) == trim(varname) ) then vnum = i exit VarSearch end if end do stat = HST_EBADVARNAME cause_c = varname goto 999 end do VarSearch svnum = vnum ! 初回のみ呼び出す. ! Called at only first time ! if ( Nstep == 0 ) then ! 定義モードからデータモードへ ! Transit from define mode to data mode ! if ( HstNmlInfoDefineMode( gthstnml ) ) then call HstNmlInfoEndDefine( gthstnml ) ! (inout) end if ! 出力タイミングのチェックとファイルの作成 ! Check output timing and create files ! call HstVarsOutputCheck( vnum ) ! (in) optional end if ! 出力が有効かどうかを確認する ! Confirm whether the output is effective ! if ( .not. output_timing_vars(vnum) ) goto 999 ! GT_HISTORY 変数の取得 ! Get "GT_HISTORY" variable ! gthist => gthst_history_vars(vnum) % gthist ! 空間切り出し ! Slice of spaces ! #{ifelse(num, 0, %Q{ ! array only }, %Q{ sv => slice_vars(vnum) #{forloop("\\$num\\$", 1, num, %Q{ !!$ write(*,*) ' sv%st($num$), sv%ed($num$), sv%sd($num$)=', sv%st($num$), sv%ed($num$), sv%sd($num$) })} array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) & #{forloop("\\$num\\$", 2, num, %Q{ & , sv%st($num$):sv%ed($num$):sv%sd($num$) & })} & ) })} ! 空間平均 ! Spatial average ! #{ifelse(num, 0, %Q{ ! array only }, %Q{ if ( count(space_avr_vars(vnum) % avr) == 0 ) then array_avr => array_slice else call AverageReduce#{type}#{num}( & & array_slice, space_avr_vars(vnum) % avr, & ! (in) #{forloop("\\$num\\$", 1, num, %Q{ & weight_vars(vnum) % wgt$num$( sv%st($num$):sv%ed($num$):sv%sd($num$) ) , & ! (in) })} & array_avr ) ! (out) end if ! 座標重みを取得 ; Get weights of axes })} ! 出力 ! OutPut ! if ( tavr_vars(vnum) ) then call HistoryPut( & & varname, & ! (in) #{ifelse(num, 0, %Q{ & (/value/), & ! (in) }, %Q{ & array_avr, & ! (in) })} & time = ( Nstep - originstep_vars(vnum) ) & & * deltime_value_vars(vnum) + origin_value_vars(vnum), & ! (in) optional & history = gthist ) ! (inout) optional else call HistoryPut( & & varname, & ! (in) #{ifelse(num, 0, %Q{ & (/value/), & ! (in) }, %Q{ & array_avr, & ! (in) })} & history = gthist ) ! (inout) optional end if nullify( gthist ) ! 結合解除 ! Release associations ! #{ifelse(num, 0, %Q{ }, %Q{ nullify( array_avr, array_slice ) })} 999 continue call StoreError(stat, subname, cause_c = cause_c, err = err) call EndSub(subname) end subroutine HistoryAutoPut#{type}#{num} __EndOfFortran90Code__ end } undef ValueOrArray undef ArgsToPut print <<"__EndOfFortran90Code__" subroutine HistoryAutoProgress ! ! 時刻を進めます. ! ! 時刻は HistoryAutoCreate の delta_time で指定された分 ! (省略した場合は 1.0) だけ進みます. ! ! HistoryAutoAddVariable はサブルーチンを呼ぶ前に, ! 使用してください. ! ! 一度目に呼んだ際には, 以下の事を行います. ! ! * NAMELIST から読み込んだ値に無効なものが存在したかどうかをチェック ! * HistoryAutoAddVariable で登録した変数群を印字 ! ! ! Progress time. ! ! Time is progressed to the extent that specified with ! "delta_time" of "HistoryAutoCreate" (1.0 when omitting ! "delta_time"). ! ! Use "HistoryAutoAddVariable" before this subroutine is called. ! ! When this subroutine called at first, following things are done. ! ! * Check that invalid values are loaded from NAMELIST or not. ! * Print registered variables by "HistoryAutoAddVariable" ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_EBADVARNAME, DC_ENOTINIT use dc_message, only: MessageNotify use dc_date, only: operator(*), operator(+) use dc_string, only: JoinChar use gt4_history, only: HistoryVarinfoInquire use gt4_history_nmlinfo, only: HstNmlInfoAllNameValid implicit none logical:: allvar_invalid ! 無効な変数名のチェックフラグ. ! Check flag of invalid variable names. integer, parameter:: names_limit = 100 character(names_limit):: names_invalid ! 無効な変数名. ! Invalid variable names. character(STRING):: name, units, longname, var_info_str character(TOKEN), pointer:: dims(:) =>null() integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoProgress" continue call BeginSub(subname) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gt4_historyauto' goto 999 end if ! 無効な変数名のチェック (初回のみ) ! Check invalid variable names (at only first time) ! if ( Nstep == 0 ) then call HstNmlInfoAllNameValid( & & gthstnml = gthstnml, & ! (inout) & invalid = allvar_invalid, names = names_invalid ) ! (out) if ( len_trim(names_invalid) > (names_limit - 5) ) then names_invalid = names_invalid(1:names_limit - 5) // ' ....' end if if ( allvar_invalid ) then stat = HST_EBADVARNAME cause_c = names_invalid call MessageNotify( 'W', subname, & & 'names "%c" from NAMELIST "gt4_historyauto_nml" are invalid.', & & c1 = trim(names_invalid) ) goto 999 end if end if ! 登録された変数の印字 (初回のみ) ! Print registered variables (at only first time) ! if ( Nstep == 0 ) then call MessageNotify( 'M', sub_sname, '-------------------------------------------' ) call MessageNotify( 'M', sub_sname, '----- Registered variables for output -----' ) call MessageNotify( 'M', sub_sname, '-------------------------------------------' ) do i = 1, numvars call HistoryVarinfoInquire( & & varinfo = gthst_vars(i), & ! (in) & name = name, & ! (out) optional & dims = dims, & ! (out) optional & longname = longname, & ! (out) optional & units = units ) ! (out) optional var_info_str = trim( longname ) // ' [' // & & trim( units ) // '] {' // & & trim( JoinChar( dims, ',' ) ) // '}' deallocate( dims ) call MessageNotify( 'M', sub_sname, ' %c (%c)', & & c1 = trim(name), c2 = trim(var_info_str) ) end do call MessageNotify( 'M', sub_sname, '-----' ) end if ! 時刻を進める ! Progress time ! Nstep = Nstep + 1 current_difftime = start_difftime + delta_difftime * Nstep if ( .not. once_progressed ) once_progressed = .true. ! 出力タイミングのチェックとファイルの作成 ! Check output timing and create files ! call HstVarsOutputCheck 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname, 'stat=%d', i = (/stat/) ) end subroutine HistoryAutoProgress !------------------------------------------------------------------- !------------- 内部サブルーチン ; Internal Subroutines ------------- !------------------------------------------------------------------- subroutine HstVarsOutputCheck ( vnum_op ) ! ! 現在が各変数にとって出力のタイミングかどうか, ! 調査して output_timing_vars へ反映する. ! vnum_op を与えた場合, その変数のみについて作業を行う. ! ! また, ファイルのオープンクローズのタイミングであれば, ! それらもこのサブルーチン内で行う. ! ! It is investigated whether current time is output timing for ! each variable, and the information is reflected to ! "output_timing_vars". ! If "vnum_op" is given, works are done for only the variable. ! ! And if current time is timing of open/close of files, ! they are done in this subroutine. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR use gt4_history, only: HistoryInitialized, HistoryClose implicit none integer, intent(in), optional:: vnum_op ! 変数 ID. Variable ID integer:: stat, i, startnum, endnum character(STRING):: cause_c character(*), parameter:: subname = "HstVarsOutputCheck" continue call BeginSub(subname) stat = DC_NOERR cause_c = "" startnum = 1 endnum = numvars if ( present(vnum_op) ) then startnum = vnum_op endnum = vnum_op end if do i = startnum, endnum if ( .not. output_valid_vars(i) ) cycle if ( originstep_vars(i) > Nstep ) cycle if ( terminusstep_vars(i) > 0 .and. terminusstep_vars(i) < Nstep ) cycle if ( originstep_vars(i) == Nstep ) then call HstFileCreate( gthst_history_vars(i) % gthist, & ! (inout) & varname_vars(i) ) ! (in) output_timing_vars(i) = .true. cycle end if if ( terminusstep_vars(i) == Nstep ) then if ( HistoryInitialized( gthst_history_vars(i) % gthist ) ) then call HistoryClose( gthst_history_vars(i) % gthist ) ! (inout) end if output_timing_vars(i) = .false. cycle end if if ( newfile_intstep_vars(i) > 0 ) then if ( mod( Nstep, newfile_intstep_vars(i) ) == 0 ) then if ( HistoryInitialized( gthst_history_vars(i) % gthist ) ) then call HistoryClose( gthst_history_vars(i) % gthist ) ! (inout) end if call HstFileCreate( gthst_history_vars(i) % gthist, & ! (inout) & varname_vars(i) ) ! (in) output_timing_vars(i) = .true. cycle end if end if if ( tavr_vars(i) ) then output_timing_vars(i) = .true. cycle end if if ( mod( Nstep, intstep_vars(i) ) == 0 ) then output_timing_vars(i) = .true. cycle end if output_timing_vars(i) = .false. end do 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HstVarsOutputCheck subroutine HstFileCreate( & & gthist, & ! (inout) & varname & ! (in) & ) ! ! ファイル作成用内部サブルーチン ! ! Internal subroutine for creation of files ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_EBADVARNAME, & & HST_EBADSLICE use dc_date_types, only: DC_DIFFTIME use dc_date, only: DCDiffTimeCreate, EvalbyUnit use dc_string, only: CPrintf, StrInclude, toChar, JoinChar use dc_message, only: MessageNotify use gt4_history_nmlinfo, only: & & HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoPutLine use gt4_history, only: GT_HISTORY, & & HistoryCreate, HistoryAddVariable, HistoryAddAttr, & & HistoryInitialized, HistoryPut, & & HistoryAxisCreate, HistoryAxisInquire, HistoryAxisCopy, & & HistoryVarinfoInquire, HistoryVarinfoCreate, & & HistoryVarinfoCopy, HistoryVarinfoInitialized, & & HistoryVarinfoClear implicit none type(GT_HISTORY), intent(inout):: gthist ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module character(*), intent(in):: varname ! 変数の名前. ! Variable name real:: interval_value ! ヒストリデータの出力間隔の数値. ! Numerical value for interval of history data output character(TOKEN):: interval_unit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output real:: origin_value ! ヒストリデータの出力開始時刻の数値. ! Numerical value for start time of history data output character(TOKEN):: origin_unit ! ヒストリデータの出力開始時刻の単位. ! Unit for start time of history data output type(DC_DIFFTIME):: origin_difftime integer:: newfile_intvalue ! ファイル分割時間間隔. ! Interval of time of separation of a file. character(TOKEN):: newfile_intunit ! ファイル分割時間間隔の単位. ! Unit of interval of time of separation of a file. character(STRING):: file, file_base, file_suffix, file_newfile_time, file_rank ! 出力ファイル名. ! Output file name. character(TOKEN):: time_name ! 時刻次元の名称. ! Name of time dimension integer:: stat, i, j, k, vnum, numdims_slice, dim_size, cnt character(STRING):: name, units, longname, cause_c, wgt_name character(TOKEN):: xtype type(GT_HISTORY_AXIS), pointer:: gthst_axes_slices(:) =>null() type(GT_HISTORY_AXIS_DATA), pointer:: data_axes_slices(:) =>null() type(GT_HISTORY_AXIS_DATA), pointer:: data_weights_slices(:) =>null() real(DP):: wgt_sum, wgt_sum_s logical:: slice_valid integer:: slice_start(1:numdims-1) ! 空間方向の開始点. ! Start points of spaces. integer:: slice_end(1:numdims-1) ! 空間方向の終了点. ! End points of spaces. integer:: slice_stride(1:numdims-1) ! 空間方向の刻み幅. ! Strides of spaces character(*), parameter:: subname = "HstFileCreate" continue call BeginSub(subname, 'varname=%c', c1 = trim(varname) ) stat = DC_NOERR cause_c = "" ! varname から変数情報の探査 ! Search information of a variable from "varname" ! vnum = 0 do i = 1, numvars call HistoryVarinfoInquire( & & varinfo = gthst_vars(i), & ! (in) & name = name ) ! (out) if ( trim(varname) == trim(name) ) vnum = i end do if ( vnum == 0 ) then stat = HST_EBADVARNAME cause_c = varname goto 999 end if ! 出力が有効かどうかを確認する ! Confirm whether the output is effective ! if ( .not. HstNmlInfoOutputValid( gthstnml, varname ) ) then goto 999 end if ! 空間方向のスライスに対応して, 座標および座標重み情報の作り直し ! Remake axes and weights information correspond to spatial slices ! call HstNmlInfoInquire( & & gthstnml = gthstnml, & ! (in) & name = varname, & ! (in) & slice_start = slice_start, & ! (out) & slice_end = slice_end, & ! (out) & slice_stride = slice_stride ) ! (out) ! ファイルが未作成の場合は, まずファイル作成 ! At first, the file is created if the file is not created yet ! if ( .not. HistoryInitialized( gthist ) ) then if ( all( slice_start == (/ ( 1, i = 1, numdims -1 ) /) ) & & .and. all( slice_end < (/ ( 1, i = 1, numdims -1 ) /) ) & & .and. all( slice_stride == (/ ( 1, i = 1, numdims -1 ) /) ) ) then gthst_axes_slices => gthst_axes data_axes_slices => data_axes data_weights_slices => data_weights slice_valid = .false. else allocate( gthst_axes_slices (1:numdims) ) allocate( data_axes_slices (1:numdims) ) allocate( data_weights_slices (1:numdims) ) do i = 1, numdims-1 ! スライス値の有効性をチェック ! Check validity of slices ! if ( slice_start(i) < 1 ) then stat = HST_EBADSLICE cause_c = CPrintf('slice_start=%d', & & i = (/ slice_start(i) /) ) goto 999 end if if ( slice_stride(i) < 1 ) then stat = HST_EBADSLICE cause_c = CPrintf('slice_stride=%d', & & i = (/ slice_stride(i) /) ) goto 999 end if ! 再生成の必要性をチェック ! Check necessity of remaking ! if ( ( slice_start(i) == 1 ) & & .and. ( slice_end(i) < 1 ) & & .and. ( slice_stride(i) == 1 ) ) then call HistoryAxisCopy( & & axis_dest = gthst_axes_slices(i) , & ! (out) & axis_src = gthst_axes(i) ) ! (in) data_axes_slices (i) = data_axes (i) cycle end if ! 座標情報の再生成 ! Remake information of axis ! call HistoryAxisInquire( & & axis = gthst_axes(i), & ! (in) & name = name, & ! (out) & size = dim_size, & ! (out) & longname = longname, & ! (out) & units = units, & ! (out) & xtype = xtype ) ! (out) ! 終点のスライス値の補正 ; Correct end points of slices if ( slice_end(i) < 1 ) slice_end(i) = dim_size if ( slice_end(i) > dim_size ) then call MessageNotify( 'W', subname, & & 'slice options to (%c) are undesirable ' // & & '(@slice_end=%d). @slice_end is corrected forcibly to (%d) ', & & c1 = trim(name), & & i = (/ slice_end(i), dim_size /) ) slice_end(i) = dim_size end if ! スライス値の有効性をチェック ; Check validity of slices if ( slice_start(i) > slice_end(i) ) then stat = HST_EBADSLICE cause_c = CPrintf('slice_start=%d, slice_end=%d', & & i = (/ slice_start(i), slice_end(i) /) ) goto 999 end if numdims_slice = int( ( slice_end(i) - slice_start(i) + 1 ) / slice_stride(i) ) ! スライス値の有効性をチェック ; Check validity of slices if ( numdims_slice < 1 ) then call MessageNotify( 'W', subname, & & 'slice options to (%c) are invalid. ' // & & '(@slice_start=%d @slice_end=%d @slice_stride=%d)', & & c1 = trim(name), & & i = (/ slice_start(i), slice_end(i), slice_stride(i) /) ) stat = HST_EBADSLICE cause_c = CPrintf('slice_start=%d, slice_end=%d, slice_stride=%d', & & i = (/ slice_start(i), slice_end(i), slice_stride(i) /) ) goto 999 end if call HistoryAxisCreate( & & axis = gthst_axes_slices(i), & ! (out) & name = name, & ! (in) & size = numdims_slice, & ! (in) & longname = longname, & ! (in) & units = units, & ! (in) & xtype = xtype ) ! (in) ! 座標データの再生成 ! Regenerate data of axis ! allocate( data_axes_slices(i) % a_axis( numdims_slice ) ) cnt = 1 do j = slice_start(i), slice_end(i), slice_stride(i) data_axes_slices(i) % a_axis( cnt ) = data_axes(i) % a_axis( j ) cnt = cnt + 1 end do ! 座標重みデータの再生成 ! Remake information of axis data ! do j = 1, numwgts call HistoryVarinfoInquire( & & varinfo = gthst_weights(j), & ! (in) & name = wgt_name ) ! (out) optional if ( trim(name) // wgtsuf == trim(wgt_name) ) then ! 座標重みの計算は結構いい加減... ! Calculation about axis weight is irresponsible... ! wgt_sum = sum( data_weights(j) % a_axis ) allocate( data_weights_slices(j) % a_axis( numdims_slice ) ) cnt = 1 do k = slice_start(i), slice_end(i), slice_stride(i) data_weights_slices(j) % a_axis( cnt ) = data_weights(j) % a_axis( k ) cnt = cnt + 1 end do wgt_sum_s = sum( data_weights_slices(j) % a_axis ) data_weights_slices(j) % a_axis = data_weights_slices(j) % a_axis * ( wgt_sum / wgt_sum_s ) end if end do end do ! 空間切り出しされていない座標に関する座標重みデータを作成 ! Make data of axis weight not sliced ! do i = 1, numwgts if ( .not. associated( data_weights_slices(i) % a_axis ) ) then allocate( data_weights_slices(i) % a_axis( size(data_weights(i) % a_axis ) ) ) data_weights_slices(i) % a_axis = data_weights (i) % a_axis end if end do ! 時刻次元のコピー ! Copy time dimension ! gthst_axes_slices(numdims) = gthst_axes(numdims) slice_valid = .true. end if ! HistoryCreate のための設定値の取得 ! Get the settings for "HistoryCreate" ! call HstNmlInfoInquire( & & gthstnml = gthstnml, & ! (in) & name = varname, & ! (in) & file = file, & ! (out) & origin_value = origin_value, & ! (out) & origin_unit = origin_unit, & ! (out) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit, & ! (out) & newfile_intvalue = newfile_intvalue, & ! (out) & newfile_intunit = newfile_intunit ) ! (out) ! データ出力時刻の設定 ! Configure data output time ! if ( origin_value > 0.0 ) then call DCDiffTimeCreate( & & origin_difftime, & ! (out) & origin_value, origin_unit ) ! (in) else origin_difftime = start_difftime end if if ( newfile_intvalue < 1 ) then origin_value = EvalbyUnit( origin_difftime, interval_unit ) else origin_value = EvalbyUnit( current_difftime, interval_unit ) end if ! ファイル名の設定 ! Configure file name ! if ( len_trim( file ) - index(file, '.nc', .true.) == 2 ) then file_base = file(1:len_trim( file ) - 3) file_suffix = '.nc' else file_base = file file_suffix = '' end if if ( trim(rank_save) == '' ) then file_rank = '' else file_rank = '_rank' // trim( adjustl(rank_save) ) end if if ( newfile_intvalue > 0 ) then file_newfile_time = & & CPrintf( '_time%08d', & & i = (/ int( EvalbyUnit( current_difftime, newfile_intunit ) ) /) ) else file_newfile_time = '' end if file = trim(file_base) // trim(file_rank) // trim(file_newfile_time) // trim(file_suffix) ! HistoryCreate によるファイル作成 ! Files are created by "HistoryCreate" ! call HistoryCreate( & & history = gthist, & ! (inout) & file = file, title = title_save, & ! (in) & source = source_save, institution = institution_save, & ! (in) & axes = gthst_axes_slices(1:numdims), & ! (in) & origin = origin_value, & ! (in) & interval = interval_value ) ! (in) ! 時刻の単位を変更 ! Change unit of time ! call HistoryAxisInquire( & & axis = gthst_axes(numdims), & ! (in) & name = time_name ) ! (out) call HistoryAddAttr( & & history = gthist, & ! (inout) & varname = time_name, attrname = 'units', & ! (in) & value = interval_unit ) ! (in) ! 座標データを出力 ! Output axes data ! do i = 1, numdims - 1 call HistoryAxisInquire( & & axis = gthst_axes_slices(i), & ! (in) & name = name ) ! (out) call HistoryPut( & & history = gthist, & ! (inout) optional & varname = name, & ! (in) & array = data_axes_slices(i) % a_axis ) ! (in) end do if ( slice_valid ) then deallocate( gthst_axes_slices ) deallocate( data_axes_slices ) else nullify( gthst_axes_slices ) nullify( data_axes_slices ) end if ! 座標重みデータを追加 ! Add axes weights data ! do i = 1, numwgts call HistoryAddVariable( & & history = gthist, & ! (inout) & varinfo = gthst_weights(i) ) ! (in) call HistoryVarinfoInquire( & & varinfo = gthst_weights(i), & ! (in) & name = name ) ! (out) call HistoryPut( & & history = gthist, & ! (inout) optional & varname = name, & ! (in) & array = data_weights_slices(i) % a_axis ) ! (in) end do if ( slice_valid ) then deallocate( data_weights_slices ) else nullify( data_weights_slices ) end if ! ファイル作成おしまい; Creation of file is finished end if ! 変数情報を追加 ! Add information of variables ! call HistoryAddVariable( & & varinfo = gthst_vars(vnum), & ! (in) & history = gthist ) ! (inout) optional 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HstFileCreate __EndOfFortran90Code__ def make_array_colon_i(int, iint, char) return unless int return unless iint #STDERR.print int, ", ", iint, "\n" #STDERR.print int.class, ", ", iint.class, "\n" return if int < 1 return "(#{char})" if int < 2 int -= 1 if iint == 1 body = "(#{char}" else body = "(:" end count = 2 int.times{ if iint == count body << ",#{char}" else body << ",:" end count += 1 } body << ")" #STDERR.print body, "\n" return body end def array_collon_i(num, body) rbody = "" lines = body.split(/\n/) lines.each{ |l| if l =~ /(\$array_collon_i([0-9]+)\$)/ iint = $2.to_i collon = make_array_colon_i(num, iint, 'i') rbody << l.gsub(/\$array_collon_i([0-9]+)\$/, collon) else rbody << l end rbody << "\n" } return rbody end def array_collon_1(num, body) rbody = "" lines = body.split(/\n/) lines.each{ |l| if l =~ /(\$array_collon_1([0-9]+)\$)/ iint = $2.to_i collon = make_array_colon_i(num, iint, '1') rbody << l.gsub(/\$array_collon_1([0-9]+)\$/, collon) else rbody << l end rbody << "\n" } return rbody end types = ["Real", "Double", "Int"] types.each{ |type| for num in 1..$histput_dim print <<"__EndOfFortran90Code__" subroutine AverageReduce#{type}#{num}( & & array, space_average, & ! (in) #{forloop("\\$num\\$", 1, num, %Q{ & weight$num$, & ! (in) })} & array_avr & ! (out) ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 ～ weight#{$histput_dim} が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none #{$type_intent_in[type]}, intent(in), target:: array#{array_colon("#{num}")} logical, intent(in):: space_average(#{num}) #{forloop("\\$num\\$", 1, num, %Q{ real(DP), intent(in):: weight$num$(:) })} #{$type_intent_in[type]}, pointer:: array_avr#{array_colon("#{num}")} ! (out) #{$type_intent_in[type]}, pointer:: array_avr_work#{array_colon("#{num}")} #{forloop("\\$num\\$", 1, num, %Q{ #{$type_intent_in[type]}, pointer:: array_avr_work$num$#{array_colon("#{num}")} })} integer:: array_shape(#{num}) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array #{array_collon_1(num, %Q{ #{array_collon_i(num, %Q{ #{forloop("\\$num\\$", 1, num, %Q{ if ( space_average($num$) ) then dim_size = array_shape($num$) array_shape($num$) = 1 allocate( array_avr_work$num$( array_shape(1) & #{forloop("\\$numary\\$", 2, num, %Q{ & , array_shape($numary$) & })} & ) ) array_avr_work$num$ = 0#{$type_numsuf[type]} weight_sum = 0.0_DP do i = 1, dim_size array_avr_work$num$$array_collon_1$num$$ = array_avr_work$num$$array_collon_1$num$$ + array_avr_work$array_collon_i$num$$ * weight$num$(i) weight_sum = weight_sum + weight$num$(i) end do array_avr_work$num$ = array_avr_work$num$ / weight_sum array_avr_work => array_avr_work$num$ end if })} })} })} allocate( array_avr( array_shape(1) & #{forloop("\\$num\\$", 2, num, %Q{ & , array_shape($num$) & })} & ) ) array_avr = array_avr_work nullify( array_avr_work ) #{forloop("\\$num\\$", 1, num, %Q{ if ( associated( array_avr_work$num$ ) ) deallocate( array_avr_work$num$ ) })} end subroutine AverageReduce#{type}#{num} __EndOfFortran90Code__ end } print <<"__EndOfFortran90Code__" end module gt4_historyauto __EndOfFortran90Code__ print <<"__EndOfFooter__" !-- ! vi:set readonly sw=4 ts=8: ! #{rb2f90_emacs_readonly}! !++ __EndOfFooter__