| Path: | main/dcpam_hs94.f90 |
| Last Update: | Mon Jun 09 11:31:39 +0900 2008 |
| Authors: | Yasuhiro MORIKAWA |
| Version: | $Id: dcpam_hs94.f90,v 1.40 2008-06-09 02:31:39 morikawa Exp $ |
| Tag Name: | $Name: dcpam4-20080609-1 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2007. All rights reserved. |
| License: | See COPYRIGHT |
| Subroutine : | |||
| nmlfile : | character(*), intent(in)
| ||
| gthstnml : | type(GTHST_NMLINFO), intent(inout)
| ||
| err : | logical, intent(out), optional
|
NAMELIST ファイル nmlfile から値を入力するための サブルーチンです. 想定しています.
値が NAMELIST ファイル内で指定されていない場合には, 入力された値がそのまま返ります.
なお, nmlfile に空文字が与えられた場合, または 与えられた nmlfile を読み込むことができない場合, プログラムはエラーを発生させます.
This is a subroutine to input values from NAMELIST file nmlfile.
A value not specified in NAMELIST file is returned without change.
If nmlfile is empty, or nmlfile can not be read, error is occurred.
This procedure input/output NAMELIST#dcpam_ape_history_nml .
Original external subprogram is main/dcpam_ape.f90#GTHistNmlRead
| Subroutine : | |||
| nmlfile : | character(*), intent(in)
| ||
| gthstnml : | type(GTHST_NMLINFO), intent(inout)
| ||
| err : | logical, intent(out), optional
|
NAMELIST ファイル nmlfile から値を入力するための サブルーチンです. 想定しています.
値が NAMELIST ファイル内で指定されていない場合には, 入力された値がそのまま返ります.
なお, nmlfile に空文字が与えられた場合, または 与えられた nmlfile を読み込むことができない場合, プログラムはエラーを発生させます.
This is a subroutine to input values from NAMELIST file nmlfile.
A value not specified in NAMELIST file is returned without change.
If nmlfile is empty, or nmlfile can not be read, error is occurred.
This procedure input/output NAMELIST#dcpam_hs94_history_nml .
subroutine GTHistNmlRead( nmlfile, gthstnml, err )
!
! NAMELIST ファイル *nmlfile* から値を入力するための
! サブルーチンです. 想定しています.
!
! 値が NAMELIST ファイル内で指定されていない場合には,
! 入力された値がそのまま返ります.
!
! なお, *nmlfile* に空文字が与えられた場合, または
! 与えられた *nmlfile* を読み込むことができない場合,
! プログラムはエラーを発生させます.
!
! This is a subroutine to input values from
! NAMELIST file *nmlfile*.
!
! A value not specified in NAMELIST file is returned
! without change.
!
! If *nmlfile* is empty, or *nmlfile* can not be read,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_iounit, only: FileOpen
use dc_message, only: MessageNotify
use dc_present, only: present_and_true
use dc_date, only: DCDiffTimeCreate
use dc_error, only: StoreError, DC_NOERR, DC_ENOFILEREAD, DC_ENOTINIT
use gt4_history_nmlinfo, only: GTHST_NMLINFO, HstNmlInfoAdd, HstNmlInfoInquire, HstNmlInfoInitialized, HstNmlInfoPutLine
implicit none
character(*), intent(in):: nmlfile
! NAMELIST ファイルの名称.
! NAMELIST file name
type(GTHST_NMLINFO), intent(inout):: gthstnml
! NAMELIST#dcpam_hs94_history_nml
! から入手される個別のデータ出力情報.
!
! 初期設定やデフォルト値の設定などを
! 行った後に与えること.
!
! Individual data output information from
! "NAMELIST#dcpam_hs94_history_nml".
!
! Before this argument is given to
! this procedure, initialize and
! configure the defaut settings.
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.
character(STRING):: name
! 変数名.
! 空白の場合には, この他の設定値は
! dcmodel_sample_code モジュールにおいて
! 出力されるデータ全ての
! デフォルト値となります.
!
! "Data1,Data2" のようにカンマで区切って複数
! の変数を指定することも可能です.
!
! Variable identifier.
! If blank is given, other values are
! used as default values of output data
! in "dcmodel_sample_code".
!
! 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:: interval_value
! ヒストリデータの出力間隔の数値.
! 負の値を与えると, 出力を抑止します.
! Numerical value for interval of history data output
! Negative values suppresses output.
character(TOKEN):: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
character(TOKEN):: precision
! ヒストリデータの精度.
! Precision of history data
logical:: average
! 出力データの平均化フラグ.
! Flag for average of output data
character(STRING):: fileprefix
! ヒストリデータのファイル名の接頭詞.
! Prefixes of history data filenames
namelist /dcpam_hs94_history_nml/ name, file, interval_value, interval_unit, precision, fileprefix, average
! ヒストリデータ用 NAMELIST 変数群名.
!
! プログラムの実行時にコマンドライン引数
! -N または --namelist にファイル名を
! 指定することで, そのファイルから
! この NAMELIST 変数群を読み込みます.
!
! NAMELIST group name for history data.
!
! If a NAMELIST filename is specified to
! command line options '-N' or '--namelist'
! 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
character(*), parameter:: subname = 'GTHistNmlRead'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
!----------------------------------------------------------------
! NAMELIST ファイルのオープン
! Open NAMELIST file
!----------------------------------------------------------------
call FileOpen( unit = unit_nml, file = nmlfile, mode = 'r', err = err ) ! (out)
if ( present_and_true(err) ) then
stat = DC_ENOFILEREAD
cause_c = nmlfile
goto 999
end if
!-----------------------------------------------------------------
! NAMELIST 変数群の取得
! Get NAMELIST group
!-----------------------------------------------------------------
!-------------------------
! 出力データの個別情報の取得
! Get individual information of output data
rewind( unit_nml )
iostat_nml = 0
pos_nml = ''
do while ( trim(pos_nml) /= 'APPEND' .and. iostat_nml == 0 )
name = ''
file = ''
call HstNmlInfoInquire( gthstnml = gthstnml, interval_value = interval_value, interval_unit = interval_unit, precision = precision, average = average, fileprefix = fileprefix ) ! (out)
read( unit = unit_nml, nml = dcpam_hs94_history_nml, iostat = iostat_nml ) ! (out)
inquire( unit_nml, position = pos_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_hs94_history_nml', c2=trim(nmlfile) )
write(STDOUT, nml = dcpam_hs94_history_nml)
call HstNmlInfoAdd( gthstnml = gthstnml, name = name, file = file, interval_value = interval_value, interval_unit = interval_unit, precision = precision, average = average, fileprefix = fileprefix ) ! (in)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" any more (iostat=%d).', c1='dcpam_hs94_history_nml', c2=trim(nmlfile), i = (/iostat_nml/) )
end if
end do
close( unit_nml )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine GTHistNmlRead
| Main Program : |
Note that Japanese and English are described in parallel.
dcpam のメインプログラムのサンプルです. Held and Suarez (1994) ベンチマークテストを行ないます.
This is sample main program of dcpam. Held and Suarez (1994) benchmark test is performed.
This procedure input/output NAMELIST#dcpam_hs94_grid_nml, NAMELIST#dcpam_hs94_initdata_nml, NAMELIST#dcpam_hs94_geodata_nml, NAMELIST#dcpam_hs94_time_nml, NAMELIST#dcpam_hs94_restart_nml .
program dcpam_hs94
!
! <b>Note that Japanese and English are described in parallel.</b>
!
! dcpam のメインプログラムのサンプルです.
! Held and Suarez (1994) ベンチマークテストを行ないます.
!
! This is sample main program of dcpam.
! Held and Suarez (1994) benchmark test is performed.
!
!---------------------------------------------------------
! 初期値生成
! Generate initial data
!---------------------------------------------------------
use initial_data, only: INIDAT, IniDataCreate, IniDataGetAxes, IniDataGet, IniDataClose, IniDataPutLine
!---------------------------------------------------------
! 力学過程
! Dynamical core
!---------------------------------------------------------
use dyn_spectral_as83, only: DYNSPAS83, DynSpAsCreate, Dynamics, VorDiv2UV, UV2VorDiv, DynSpAsClose, DynSpAsEqualAxes, DynSpAsGetAxes, DynSpAsPutLine
!---------------------------------------------------------
! 物理過程
! Physical processes
!---------------------------------------------------------
!-------------------------------------
! Held and Suarez (1994)
use phy_hs94, only: PHYHS94, PhyHsCreate, PhyHsClose, PhyHsForcing, PhyHsPutLine
!---------------------------------------------------------
! GCM 用ユーティリティ
! Utilities for GCM
!---------------------------------------------------------
!-------------------------------------
! 物理定数
! Physical constants
use constants, only: CONST, Create, Get, PutLine
!-------------------------------------
! タイムフィルター
! Time filter
use timefilter, only: TFILTER, Create, Filter, Progress, PutLine
!---------------------------------------------------------
! データ I/O
! Data I/O
!---------------------------------------------------------
use gt4_history_nmlinfo, only: GTHST_NMLINFO, HstNmlInfoPutLine
use gt4_history, only: GT_HISTORY, HistoryGet
!---------------------------------------------------------
! 汎用ユーティリティ
! Common utilities
!---------------------------------------------------------
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_args, only: ARGS, DCArgsOpen, DCArgsHelpMsg, DCArgsOption, DCArgsDebug, DCArgsHelp, DCArgsStrict, DCArgsClose
use dc_trace, only: DbgMessage, BeginSub, EndSub
use dc_message,only: MessageNotify
use dc_string, only: toChar, Printf, StoA, PutLine
use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit, mod, toChar, operator(*), operator(==), operator(<), operator(>), operator(/), operator(+), operator(-)
use dc_date_types, only: DC_DIFFTIME
use dc_clock, only: CLOCK, DCClockCreate, DCClockClose, DCClockStart, DCClockStop, DCClockResult, DCClockPredict, operator(+)
use dc_iounit, only: FileOpen
use dc_hash, only: HASH, DCHashPut, DCHashRewind, DCHashNext, DCHashDelete
implicit none
!-------------------------------------------------------------------
! 実験の表題, モデルの名称, 所属機関名
! Title of a experiment, name of model, sub-organ
!-------------------------------------------------------------------
character(*), parameter:: title = 'dcpam_hs94 $Name: dcpam4-20080609-1 $ :: ' // 'DCPAM sample program: Held and Suarez (1994) benchmark test'
character(*), parameter:: source = 'dcpam4 (See http://www.gfd-dennou.org/library/dcpam)'
character(*), parameter:: institution = 'GFD Dennou Club (See http://www.gfd-dennou.org)'
!-------------------------------------------------------------------
! 格子点数・最大全波数
! Grid points and maximum truncated wavenumber
!-------------------------------------------------------------------
integer:: nmax = 10 ! 最大全波数.
! Maximum truncated wavenumber
integer:: imax = 32 ! 経度格子点数.
! Number of grid points in longitude
integer:: jmax = 16 ! 緯度格子点数.
! Number of grid points in latitude
integer:: kmax = 20 ! 鉛直層数.
! Number of vertical level
namelist /dcpam_hs94_grid_nml/ nmax, imax, jmax, kmax
! 格子点, 最大波数の設定.
!
! Configure grid points and maximum truncated wavenumber
!---------------------------------------------------------
! 物理定数
! Physical constants
!---------------------------------------------------------
real(DP):: PI ! $ \pi $ . 円周率. Circular constant
real(DP):: RPlanet ! $ a $ . 惑星半径. Radius of planet
real(DP):: Omega ! $ \Omega $ . 回転角速度. Angular velocity
real(DP):: Grav ! $ g $ . 重力加速度. Gravitational acceleration
real(DP):: Cp ! $ C_p $ . 大気定圧比熱. Specific heat of air at constant pressure
real(DP):: RAir ! $ R $ . 大気気体定数. Gas constant of air
real(DP):: EpsV ! $ \epsilon_v $ . 水蒸気分子量比. Molecular weight ratio of water vapor
integer:: VisOrder ! 超粘性の次数. Order of hyper-viscosity
real(DP):: EFoldTime ! 最大波数に対する e-folding time. E-folding time for maximum wavenumber
!---------------------------------------------------------
! 初期値データ (リスタートデータ)
! Initial data (Restart data)
!---------------------------------------------------------
logical:: initial_data_prepared = .false.
! 初期値データ (リスタートデータ)
! ファイルの有無.
! Presence or absence of
! initial data (restart data) file.
character(STRING):: init_nc = 'dcpam_hs94_restart.nc'
! 初期値データ (リスタートデータ)
! netCDF ファイル名.
! NetCDF filename for
! initial data (restart data) file.
character(TOKEN):: init_nc_time_varname = 'time'
! 時刻の変数名.
! 空にした場合, データ入力時に時刻指定を
! 行いません.
!
! Variable name of time.
! If this variable is null character,
! time is not specified when data is input.
!
real(DP):: init_nc_timeB = -90.0_DP
! 初期値データ ( $ t-\Delta t $ ) の時刻.
! Time of initial data ( $ t-\Delta t $ )
real(DP):: init_nc_timeN = 0.0_DP
! 初期値データ ( $ t $ ) の時刻.
! Time of initial data ( $ t $ )
namelist /dcpam_hs94_initdata_nml/ initial_data_prepared, init_nc, init_nc_time_varname, init_nc_timeB, init_nc_timeN
! 初期値データ, リスタートデータの設定.
!
! Configure initial data or restart data
type(INIDAT):: ini_dat
!---------------------------------------------------------
! 地形データ (地表 $ \Phi $ )
! Geography data (surface $ \Phi $ )
!---------------------------------------------------------
logical:: geography_data_prepared = .false.
! 地形データ (地表 $ \Phi $ ) の有無.
! Presence or absence of geography data (surface $ \Phi $ )
character(STRING):: geo_nc = 'geo.nc'
! 地形データ netCDF ファイル.
! NetCDF file for geography data
character(TOKEN):: geo_varname = 'Phis'
! 地形データの変数名.
! Variable name of geography data
namelist /dcpam_hs94_geodata_nml/ geography_data_prepared, geo_nc, geo_varname
! 地形データの設定.
!
! Configure geography data
!---------------------------------------------------------
! OPENMP による並列計算
! Parallel computing with OPENMP
!---------------------------------------------------------
integer:: openmp_threads = 1 ! OPENMP での最大スレッド数.
! Maximum number of threads in OPENMP
!-------------------------------------------------------------------
! 現在時刻, 時間ステップ $ \Delta t $ ,
! 積分終了時刻, 予測時間表示の設定
! Configure current time, time step $ \Delta t $ ,
! finish time of integral, predicted CPU time
!-------------------------------------------------------------------
type(DC_DIFFTIME):: current_time
! 現在時刻. Current time.
type(DC_DIFFTIME):: start_time
! 開始時刻. Current time.
real(DP):: start_time_value = 0.0_DP
! 開始時刻の値. Value of start time
character(TOKEN):: start_time_unit = 'min'
! 開始時刻の単位. Unit of start time
type(DC_DIFFTIME):: delta_time
! $ \Delta t $ . タイムステップ. Time step
real(DP):: delta_time_value = 90.0_DP
! $ \Delta t $ . タイムステップの値. Value of time step
character(TOKEN):: delta_time_unit = 'min'
! タイムステップの単位. Unit of time step
type(DC_DIFFTIME):: total_time
! 積分終了時刻. Finish time of integral
real(DP):: total_time_value = 7.0_DP
! 積分終了時刻の値. Value of finish time of integral
character(TOKEN):: total_time_unit = 'days'
! 積分終了時刻の単位. Unit of finish time of integral
type(DC_DIFFTIME):: predict_show_interval_time
! 終了予測日時表示間隔.
! Interval of predicted date output
real(DP):: predict_show_interval_value = 1.0_DP
! 終了予測日時表示間隔.
! Interval of predicted date output
character(TOKEN):: predict_show_interval_unit = 'days'
! 終了予測日時表示間隔 (単位).
! Unit for interval of predicted date output
namelist /dcpam_hs94_time_nml/ start_time_value, start_time_unit, delta_time_value, delta_time_unit, total_time_value, total_time_unit, predict_show_interval_value, predict_show_interval_unit
! 時刻の設定
!
! Configure time
!---------------------------------------------------------
! ヒストリファイルへのデータ出力設定
! Configure the settings for history data output
!---------------------------------------------------------
real:: history_interval_value = 0.125
! ヒストリデータの出力間隔の数値.
! Numerical value for interval of history data output
character(TOKEN):: history_interval_unit = 'days'
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
character(TOKEN):: history_precision = 'float'
! ヒストリデータの精度.
! Precision of history data
character(STRING):: history_fileprefix = ''
! ヒストリデータのファイル名の接頭詞.
! Prefix of history data filenames
character(STRING):: history_varlist = 'U, V, Temp, Ps, SigmaDot'
! ヒストリデータの出力変数リスト.
! カンマで区切って並べる.
! (例: "U, V, Temp, QVap, Ps" ).
!
! List of variables output to history data.
! Delimiter is comma.
! (exp. "U, V, Temp, QVap, Ps" ).
!---------------------------------------------------------
! リスタートファイルへのデータ出力設定
! Configure the settings for restart data output
!---------------------------------------------------------
real:: restart_interval_value = 1440.0_DP
! リスタートデータの出力間隔の数値.
! Numerical value for interval of restart data output
character(TOKEN):: restart_interval_unit = 'min'
! リスタートデータの出力間隔の単位.
! Unit for interval of restart data output
character(STRING):: restart_filename = 'dcpam_hs94_restart.nc'
! リスタートデータのファイル名
! filename of restart data
!---------------------------------------------------------
! 配列の定義
! Declaration of array
!---------------------------------------------------------
!-------------------------------------
! 座標変数
! Coordinate variables
real(DP), allocatable:: x_Lon (:) ! 経度. Longitude
real(DP), allocatable:: x_Lon_Weight (:)
! 経度積分用座標重み.
! Weight for integration in longitude
real(DP), allocatable:: y_Lat (:) ! 緯度. Latitude
real(DP), allocatable:: y_Lat_Weight (:)
! 緯度積分用座標重み.
! Weight for integration in latitude
real(DP), allocatable:: z_Sigma (:)
! $ \sigma $ レベル (整数).
! Full $ \sigma $ level
real(DP), allocatable:: r_Sigma (:)
! $ \sigma $ レベル (半整数).
! Half $ \sigma $ level
real(DP), allocatable:: z_DelSigma (:)
! $ \Delta \sigma $ (整数).
! $ \Delta \sigma $ (Full)
!-------------------------------------
! 予報変数
! Prediction variables
real(DP), allocatable:: xyz_UB (:,:,:)
! $ U (t-\Delta t) $ . 東西風速. Zonal wind
real(DP), allocatable:: xyz_VB (:,:,:)
! $ V (t-\Delta t) $ . 南北風速. Meridional wind
real(DP), allocatable:: xyz_VorB (:,:,:)
! $ \zeta (t-\Delta t) $ . 渦度. Vorticity
real(DP), allocatable:: xyz_DivB (:,:,:)
! $ D (t-\Delta t) $ . 発散. Divergence
real(DP), allocatable:: xyz_TempB (:,:,:)
! $ T (t-\Delta t) $ . 温度. Temperature
real(DP), allocatable:: xyz_QVapB (:,:,:)
! $ q (t-\Delta t) $ . 比湿. Specific humidity
real(DP), allocatable:: xy_PsB (:,:)
! $ p_s (t-\Delta t) $ . 地表面気圧. Surface pressure
real(DP), allocatable:: xyz_UN (:,:,:)
! $ U (t) $ . 東西風速. Zonal wind
real(DP), allocatable:: xyz_VN (:,:,:)
! $ V (t) $ . 南北風速. Meridional wind
real(DP), allocatable:: xyz_VorN (:,:,:)
! $ \zeta (t) $ . 渦度. Vorticity
real(DP), allocatable:: xyz_DivN (:,:,:)
! $ D (t) $ . 発散. Divergence
real(DP), allocatable:: xyz_TempN (:,:,:)
! $ T (t) $ . 温度. Temperature
real(DP), allocatable:: xyz_QVapN (:,:,:)
! $ q (t) $ . 比湿. Specific humidity
real(DP), allocatable:: xy_PsN (:,:)
! $ p_s (t) $ . 地表面気圧. Surface pressure
real(DP), allocatable:: xyz_UA (:,:,:)
! $ U (t+\Delta t) $ . 東西風速. Zonal wind
real(DP), allocatable:: xyz_VA (:,:,:)
! $ V (t+\Delta t) $ . 南北風速. Meridional wind
real(DP), allocatable:: xyz_VorA (:,:,:)
! $ \zeta (t+\Delta t) $ . 渦度. Vorticity
real(DP), allocatable:: xyz_DivA (:,:,:)
! $ D (t+\Delta t) $ . 発散. Divergence
real(DP), allocatable:: xyz_TempA (:,:,:)
! $ T (t+\Delta t) $ . 温度. Temperature
real(DP), allocatable:: xyz_QVapA (:,:,:)
! $ q (t+\Delta t) $ . 比湿. Specific humidity
real(DP), allocatable:: xy_PsA (:,:)
! $ p_s (t+\Delta t) $ . 地表面気圧. Surface pressure
!-------------------------------------
! Held and Suarez (1994) による変化
! Tendency by Held and Suarez (1994)
real(DP), allocatable:: xyz_DUDtHS94 (:,:,:)
! $ \DP{U}{t} $ .
! Held and Suarez (1994) のレイリー摩擦による東西風速変化.
! Zonal wind tendency due to Rayleigh damping of Held and Suarez (1994)
real(DP), allocatable:: xyz_DVDtHS94 (:,:,:)
! $ \DP{V}{t} $ .
! Held and Suarez (1994) のレイリー摩擦による南北風速変化.
! Meridional wind tendency due to Rayleigh damping of Held and Suarez (1994)
real(DP), allocatable:: xyz_DVorDtHS94 (:,:,:)
! $ \DP{\zeta}{t} $ .
! Held and Suarez (1994) のレイリー摩擦による渦度変化.
! Vorticity tendency due to Rayleigh damping of Held and Suarez (1994)
real(DP), allocatable:: xyz_DDivDtHS94 (:,:,:)
! $ \DP{D}{t} $ .
! Held and Suarez (1994) のレイリー摩擦による発散変化.
! Divergence tendency due to Rayleigh damping of Held and Suarez (1994)
real(DP), allocatable:: xyz_DTempDtHS94 (:,:,:)
! $ \DP{T}{t} $ .
! Held and Suarez (1994) のニュートン冷却による温度変化.
! Temperature tendency due to Newtonian relaxation of Held and Suarez (1994)
!-------------------------------------
! 地形データ (地表 $ \Phi $ ) 変数
! Geography data (surface $ \Phi $ ) variables
real(DP), allocatable:: xy_Phis (:,:)
! $ \Phi_s $ . 地表ジオポテンシャル.
! Surface geo-potential
!-----------------------------------------------------------------
! データ出力設定
! Configure the settings for data output
!-----------------------------------------------------------------
type(GTHST_NMLINFO), pointer:: gthstnml =>null()
! 個別のデータ出力情報.
!
! Individual data output information
type(GT_HISTORY), pointer:: gthist =>null()
! gt4_history#GT_HISTORY 変数.
! "gt4_history#GT_HISTORY" variable
type(HASH):: registered_varnames
! ヒストリデータとして出力できる変数名のリスト.
!
! List of names of variables that can be output
! as history data
!---------------------------
! ヒストリファイルへのデータ出力設定
! Configure the settings for history data output
type(GTHST_NMLINFO), pointer:: gthstnml_history =>null()
! 個別のデータ出力情報.
!
! Individual data output information
!---------------------------
! リスタートファイルへのデータ出力設定
! Configure the settings for restart data output
type(GTHST_NMLINFO), pointer:: gthstnml_restart =>null()
! 個別のデータ出力情報.
!
! Individual data output information
!---------------------------
! データ出力に関する作業変数
! Work variables for data output
character(STRING):: name = ''
! 変数名. Variable identifier
character(STRING):: longname = ''
! 変数の記述的名称. Descriptive name of variables
character(STRING), allocatable:: dims(:)
! 座標軸の名称. Name of axes
character(STRING):: units = ''
! 単位. Units
character(TOKEN):: precision
! ヒストリデータの精度.
! Precision of history data
logical:: average
! 出力データの平均化フラグ.
! Flag for average of output data
real:: time
! 時刻. Time
!---------------------------------------------------------
! 作業変数
! Work variables
!---------------------------------------------------------
type(ARGS):: arg ! コマンドライン引数.
! Command line options
logical:: OPT_namelist ! -N, --namelist オプションの有無.
! Existence of '-N', '--namelist' option
character(STRING):: VAL_namelist
! -N, --namelist オプションの値.
! Value of '-N', '--namelist' option
integer:: unit_nml ! NAMELIST ファイルオープン用装置番号.
! Unit number for NAMELIST file open
integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT.
! IOSTAT of NAMELIST read
character(STRING):: init_nc_rangeB
! 初期値入力の際の切り出し指定 ( $ t-\Delta t $ ).
! Range of initial data input ( $ t-\Delta t $ )
character(STRING):: init_nc_rangeN
! 初期値入力の際の切り出し指定 ( $ t $ ).
! Range of initial data input ( $ t $ )
type(CONST):: const_earth ! 物理定数. Physical constants.
type(DYNSPAS83):: dyn ! 力学過程.
! Dynamical core
type(PHYHS94):: phy_hs ! 物理過程 (Held and Suarez (1994))
! Physical process (Held and Suarez (1994))
type(TFILTER):: tfilt ! タイムフィルター.
! Time filter
type(CLOCK):: clk_setup, clk_histget, clk_histput, clk_dyn, clk_phy, clk_tfilt
! CPU 時間モニター.
! CPU time monitor
logical:: wa_module_initialized = .false.
! wa_module (SPMODEL ライブラリ) 初期化フラグ.
! "wa_module" (SPMODEL library)
! initialization flag.
character(*), parameter:: version = '$Name: dcpam4-20080609-1 $' // '$Id: dcpam_hs94.f90,v 1.40 2008-06-09 02:31:39 morikawa Exp $'
character(*), parameter:: subname = 'dcpam_hs94'
continue
!---------------------------------------------------------
! コマンドライン引数の処理
! Command line options handling
!---------------------------------------------------------
call cmdline_optparse ! これは内部サブルーチン. This is an internal subroutine
call BeginSub( subname, version=version )
!-------------------------------------------------------------------
! CPU 時間モニターの初期設定
! Configure the settings for CPU time monitor
!-------------------------------------------------------------------
call DCClockCreate( clk = clk_setup, name = 'Setup' ) ! (in)
call DCClockCreate( clk = clk_histget, name = 'HistoryGet' ) ! (in)
call DCClockCreate( clk = clk_histput, name = 'HistoryPut' ) ! (in)
call DCClockCreate( clk = clk_dyn, name = 'Dynamics' ) ! (in)
call DCClockCreate( clk = clk_phy, name = 'Physics' ) ! (in)
call DCClockCreate( clk = clk_tfilt, name = 'TimeFilter' ) ! (in)
!-------------------------------------------------------------------
! 格子点数・最大全波数の設定
! Configure the grid points and maximum truncated wavenumber
!-------------------------------------------------------------------
call DCClockStart( clk = clk_setup ) ! (inout)
!-------------------------
! NAMELIST の読み込み
! Load NAMELIST
if ( .not. trim(VAL_namelist) == '' ) then
call FileOpen( unit = unit_nml, file = VAL_namelist, mode = 'r' ) ! (in)
read( unit = unit_nml, nml = dcpam_hs94_grid_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_hs94_grid_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_hs94_grid_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_hs94_grid_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-------------------------------------------------------------------
! 現在時刻, 時間ステップ $ \Delta t $ ,
! 積分終了時刻, 予測時間表示の設定
! Configure current time, time step $ \Delta t $ ,
! finish time of integral, predicted CPU time
!-------------------------------------------------------------------
!-------------------------
! NAMELIST の読み込み
! Load NAMELIST
if ( .not. trim(VAL_namelist) == '' ) then
call FileOpen( unit = unit_nml, file = VAL_namelist, mode = 'r' ) ! (in)
read( unit = unit_nml, nml = dcpam_hs94_time_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_hs94_time_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_hs94_time_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_hs94_time_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-------------------------
! DC_DIFFTIME 型変数の設定
! Configure DC_DIFFTIME type variables
call DCDiffTimeCreate( diff = current_time, value = start_time_value, unit = start_time_unit ) ! (in)
call DCDiffTimeCreate( diff = start_time, value = start_time_value, unit = start_time_unit ) ! (in)
call DCDiffTimeCreate( diff = delta_time, value = delta_time_value, unit = delta_time_unit ) ! (in)
call DCDiffTimeCreate( diff = total_time, value = total_time_value, unit = total_time_unit ) ! (in)
call DCDiffTimeCreate( diff = predict_show_interval_time, value = predict_show_interval_value, unit = predict_show_interval_unit) ! (in)
!-------------------------------------------------------------------
! 地形データ (地表 $ \Phi $ ) の取得
! Get geography data (surface $ \Phi $ )
!-------------------------------------------------------------------
!-------------------------
! NAMELIST の読み込み
! Load NAMELIST
if ( .not. trim(VAL_namelist) == '' ) then
call FileOpen( unit = unit_nml, file = VAL_namelist, mode = 'r' ) ! (in)
read( unit = unit_nml, nml = dcpam_hs94_geodata_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_hs94_geodata_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_hs94_geodata_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_hs94_geodata_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-------------------------
! ファイルの読み込み
! Load a file
allocate( xy_Phis(0:imax-1, 0:jmax-1) )
if ( geography_data_prepared ) then
call HistoryGet( file = geo_nc, varname = geo_varname, array = xy_Phis ) ! (out)
else
xy_Phis = 0.0_DP
end if
!-------------------------------------------------------------------
! 物理定数の設定
! Configure the physical constants
!-------------------------------------------------------------------
call Create( constant = const_earth, Cp = 1004.6_DP, RAir = 287.04_DP, VisOrder = 8, EFoldTime = 8640.0_DP, nmlfile = VAL_namelist ) ! (in)
call Printf( STDOUT, 'constant=' )
call PutLine( constant = const_earth, unit = STDOUT, indent = ' ' ) ! (in)
call Get( constant = const_earth, PI = PI, RPlanet = RPlanet, Grav = Grav, Omega = Omega, Cp = Cp, RAir = RAir, EpsV = EpsV, VisOrder = VisOrder, EFoldTime = EFoldTime ) ! (out)
!-------------------------------------------------------------------
! タイムフィルターの設定
! Configure the settings for time filter
!-------------------------------------------------------------------
call Create( tfilt = tfilt, filter_param = 0.05_DP, int_time = delta_time, cur_time = current_time, nmlfile = VAL_namelist ) ! (in)
call Printf( STDOUT, 'tfilt=' )
call PutLine( tfilt = tfilt, unit = STDOUT, indent = ' ' ) ! (in)
!-------------------------------------------------------------------
! 緯度経度変数, 鉛直レベル変数の割付
! (リスタートファイル, ヒストリファイル出力用)
! Allocate variablesa of latitude and longitude and vertical level
! for output of restart file and history files
!-------------------------------------------------------------------
allocate( x_Lon(0:imax-1) )
allocate( x_Lon_Weight (0:imax-1) )
allocate( y_Lat(0:jmax-1) )
allocate( y_Lat_Weight (0:jmax-1) )
allocate( z_Sigma(0:kmax-1) )
allocate( r_Sigma(0:kmax) )
allocate( z_DelSigma(0:kmax-1) )
!-------------------------------------------------------------------
! 予報変数の割付
! Allocate prediction variables
!-------------------------------------------------------------------
allocate( xyz_UB(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_VB(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_VorB(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_DivB(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_TempB(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_QVapB(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xy_PsB(0:imax-1, 0:jmax-1) )
allocate( xyz_UN(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_VN(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_VorN(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_DivN(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_TempN(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_QVapN(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xy_PsN(0:imax-1, 0:jmax-1) )
allocate( xyz_UA(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_VA(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_VorA(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_DivA(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_TempA(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_QVapA(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xy_PsA(0:imax-1, 0:jmax-1) )
allocate( xyz_DUDtHS94(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_DVDtHS94(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_DTempDtHS94(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_DVorDtHS94(0:imax-1, 0:jmax-1, 0:kmax-1) )
allocate( xyz_DDivDtHS94(0:imax-1, 0:jmax-1, 0:kmax-1) )
call DCClockStop( clk = clk_setup ) ! (inout)
!-------------------------------------------------------------------
! 軸データおよび初期値データの取得もしくは生成
! Get or generate axes data and initial data
!-------------------------------------------------------------------
call DCClockStart( clk = clk_histget ) ! (inout)
!-------------------------
! NAMELIST の読み込み
! Load NAMELIST
if ( .not. trim(VAL_namelist) == '' ) then
call FileOpen( unit = unit_nml, file = VAL_namelist, mode = 'r' ) ! (in)
read( unit = unit_nml, nml = dcpam_hs94_initdata_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_hs94_initdata_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_hs94_initdata_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_hs94_initdata_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-------------------------
! ファイルの読み込み
! Load a file
if ( initial_data_prepared ) then
!-------------------------
! 座標軸の読み込み
! Load axes
call HistoryGet( file = init_nc, varname = 'lon', array = x_Lon ) ! (out)
x_Lon = x_Lon * PI / 180.0_DP ! ※ 本当は units = 'degree' を解釈しなければ...
call HistoryGet( file = init_nc, varname = 'lon_weight', array = x_Lon_Weight ) ! (out)
call HistoryGet( file = init_nc, varname = 'lat', array = y_Lat ) ! (out)
y_Lat = y_Lat * PI / 180.0_DP ! ※ 本当は units = 'degree' を解釈しなければ...
call HistoryGet( file = init_nc, varname = 'lat_weight', array = y_Lat_Weight ) ! (out)
call HistoryGet( file = init_nc, varname = 'sig', array = z_Sigma ) ! (out)
call HistoryGet( file = init_nc, varname = 'sigm', array = r_Sigma ) ! (out)
!-------------------------
! データの読み込み
! Load data
if ( .not. trim(init_nc_time_varname) == '' ) then
init_nc_rangeB = trim(init_nc_time_varname) // '=' // trim(toChar(init_nc_timeB))
init_nc_rangeN = trim(init_nc_time_varname) // '=' // trim(toChar(init_nc_timeN))
else
init_nc_rangeB = ''
init_nc_rangeN = ''
end if
call HistoryGet( file = init_nc, varname = 'U', array = xyz_UB, range = init_nc_rangeB ) ! (in)
call HistoryGet( file = init_nc, varname = 'U', array = xyz_UN, range = init_nc_rangeN ) ! (in)
call HistoryGet( file = init_nc, varname = 'V', array = xyz_VB, range = init_nc_rangeB ) ! (in)
call HistoryGet( file = init_nc, varname = 'V', array = xyz_VN, range = init_nc_rangeN ) ! (in)
!!$ call HistoryGet( &
!!$ & file = init_nc, varname = 'Vor', & ! (in)
!!$ & array = xyz_VorB, & ! (out)
!!$ & range = init_nc_rangeB ) ! (in)
!!$ call HistoryGet( &
!!$ & file = init_nc, varname = 'Vor', & ! (in)
!!$ & array = xyz_VorN, & ! (out)
!!$ & range = init_nc_rangeN ) ! (in)
!!$ call HistoryGet( &
!!$ & file = init_nc, varname = 'Div', & ! (in)
!!$ & array = xyz_DivB, & ! (out)
!!$ & range = init_nc_rangeB ) ! (in)
!!$ call HistoryGet( &
!!$ & file = init_nc, varname = 'Div', & ! (in)
!!$ & array = xyz_DivN, & ! (out)
!!$ & range = init_nc_rangeN ) ! (in)
call HistoryGet( file = init_nc, varname = 'Temp', array = xyz_TempB, range = init_nc_rangeB ) ! (in)
call HistoryGet( file = init_nc, varname = 'Temp', array = xyz_TempN, range = init_nc_rangeN ) ! (in)
call HistoryGet( file = init_nc, varname = 'QVap', array = xyz_QVapB, range = init_nc_rangeB ) ! (in)
call HistoryGet( file = init_nc, varname = 'QVap', array = xyz_QVapN, range = init_nc_rangeN ) ! (in)
call HistoryGet( file = init_nc, varname = 'Ps', array = xy_PsB, range = init_nc_rangeB ) ! (in)
call HistoryGet( file = init_nc, varname = 'Ps', array = xy_PsN, range = init_nc_rangeN ) ! (in)
else
call IniDataCreate( ini_dat = ini_dat, nmax = nmax, imax = imax, jmax = jmax, kmax = kmax, Cp = Cp, RAir = RAir, r_SigmaSet = (/ 1.00_DP, 0.95_DP, 0.90_DP, 0.85_DP, 0.80_DP, 0.75_DP, 0.70_DP, 0.65_DP, 0.60_DP, 0.55_DP, 0.50_DP, 0.45_DP, 0.40_DP, 0.35_DP, 0.30_DP, 0.25_DP, 0.20_DP, 0.15_DP, 0.10_DP, 0.05_DP, 0.0_DP /), nmlfile = VAL_namelist ) ! (in)
wa_module_initialized = .true.
call IniDataGetAxes( ini_dat = ini_dat, x_Lon = x_Lon, x_Lon_Weight = x_Lon_Weight, y_Lat = y_Lat, y_Lat_Weight = y_Lat_Weight, z_Sigma = z_Sigma, r_Sigma = r_Sigma ) ! (out)
call IniDataGet( ini_dat = ini_dat, xyz_U = xyz_UB, xyz_V = xyz_VB, xyz_Temp = xyz_TempB, xyz_QVap = xyz_QVapB, xy_Ps = xy_PsB ) ! (out)
call IniDataGet( ini_dat = ini_dat, xyz_U = xyz_UN, xyz_V = xyz_VN, xyz_Temp = xyz_TempN, xyz_QVap = xyz_QVapN, xy_Ps = xy_PsN ) ! (out)
call IniDataClose( ini_dat ) ! (inout)
end if
call DCClockStop( clk = clk_histget ) ! (inout)
!----------------------------------------------------------------
! データ出力設定
! Configure the settings for data output
!----------------------------------------------------------------
!---------------------------
! ヒストリファイルへのデータ出力設定
! Configure the settings for history data output
call history_output_init ! これは内部サブルーチン. This is an internal subroutine
call Printf( STDOUT, 'gthstnml_history=' )
call HstNmlInfoPutLine( gthstnml = gthstnml_history, unit = STDOUT, indent = ' ' ) ! (in)
!---------------------------
! リスタートファイルへのデータ出力設定
! Configure the settings for restart data output
call restart_output_init ! これは内部サブルーチン. This is an internal subroutine
call Printf( STDOUT, 'gthstnml_restart=' )
call HstNmlInfoPutLine( gthstnml = gthstnml_restart, unit = STDOUT, indent = ' ' ) ! (in)
!-------------------------------------------------------------------
! 力学過程の設定
! Configure the settings for dynamical core
!-------------------------------------------------------------------
call DCClockStart( clk = clk_setup ) ! (inout)
!-------------------------
! dyn_spectral_as83 の設定
! Configure 'dyn_spectral_as83'
call DynSpAsCreate( dyn_sp_as = dyn, nmax = nmax, imax = imax, jmax = jmax, kmax = kmax, PI = PI, RPlanet = RPlanet, Omega = Omega, Cp = Cp, RAir = RAir, EpsV = EpsV, VisOrder = VisOrder, EFoldTime = EFoldTime, DelTime = EvalSec(delta_time), xy_Phis = xy_Phis, current_time_value = real( start_time_value ), current_time_unit = start_time_unit, history_varlist = 'SigmaDot', history_interval_value = history_interval_value, history_interval_unit = history_interval_unit, history_precision = history_precision, history_fileprefix = history_fileprefix, openmp_threads = openmp_threads, wa_module_initialized = wa_module_initialized, nmlfile = VAL_namelist ) ! (in)
call Printf( STDOUT, 'dyn_sp_as=' )
call DynSpAsPutLine( dyn_sp_as = dyn, unit = STDOUT, indent = ' ' ) ! (in)
call DynSpAsEqualAxes( dyn_sp_as = dyn, x_Lon = x_Lon, y_Lat = y_Lat, z_Sigma = z_Sigma, r_Sigma = r_Sigma ) ! (in)
!---------------------------------------------------------
! 物理過程の設定
! Configure the settings for physical processes
!---------------------------------------------------------
!-------------------------------------
! Held and Suarez (1994)
call PhyHsCreate( phy_hs = phy_hs, imax = imax, jmax = jmax, kmax = kmax, x_Lon = x_Lon, y_Lat = y_Lat, z_Sigma = z_Sigma, DelTime = EvalSec(delta_time), Cp = Cp, RAir = RAir, history_varlist = '', current_time_value = real( start_time_value ), current_time_unit = start_time_unit, history_interval_value = history_interval_value, history_interval_unit = history_interval_unit, history_precision = history_precision, history_fileprefix = history_fileprefix, nmlfile = VAL_namelist ) ! (in)
call Printf( STDOUT, 'phy_hs=' )
call PhyHsPutLine( phy_hs = phy_hs, unit = STDOUT, indent = ' ' ) ! (in)
!----------------------------------------------------------------
! 初期データの出力
! Output initial data
!----------------------------------------------------------------
!-------------------------
! 東西風速と南北風速から渦度と発散を計算
! Calculate vorticity and divergence from
! zonal and meridional wind at step $ t $
call UV2VorDiv( dyn_sp_as = dyn, xyz_U = xyz_UB, xyz_V = xyz_VB, xyz_Vor = xyz_VorB, xyz_Div = xyz_DivB ) ! (out)
call UV2VorDiv( dyn_sp_as = dyn, xyz_U = xyz_UN, xyz_V = xyz_VN, xyz_Vor = xyz_VorN, xyz_Div = xyz_DivN ) ! (out)
!!$ !-------------------------
!!$ ! 渦度と発散から東西風速と南北風速を計算 (ステップ $ t $ )
!!$ ! Calculate zonal and meridional wind from vorticity and divergence
!!$ ! at step $ t $
!!$ call VorDiv2UV( dyn_sp_as = dyn, & ! (inout)
!!$ & xyz_Vor = xyz_VorN, xyz_Div = xyz_DivN, & ! (in)
!!$ & xyz_U = xyz_UN, xyz_V = xyz_VN ) ! (out)
call history_output_inidata ! これは内部サブルーチン. This is an internal subroutine
call DCClockStop( clk = clk_setup ) ! (inout)
MainLoop : do while ( current_time < total_time )
!----------------------------------------------------------------
! 物理過程
! Physical processes
!----------------------------------------------------------------
!-----------------------------------
! Held and Suarez(1994) の加熱、散逸
! Heating and dissipation by Held and Suarez(1994)
call DCClockStart( clk = clk_phy ) ! (inout)
call PhyHsForcing( phy_hs = phy_hs, xyz_U = xyz_UB, xyz_V = xyz_VB, xyz_Temp = xyz_TempB, xy_Ps = xy_PsB, xyz_DUDt = xyz_DUDtHS94, xyz_DVDt = xyz_DVDtHS94, xyz_DTempDt = xyz_DTempDtHS94 ) ! (out)
!-------------------------
! 東西風速と南北風速から渦度と発散を計算
! Calculate vorticity and divergence from
! zonal and meridional wind at step $ t $
call UV2VorDiv( dyn_sp_as = dyn, xyz_U = xyz_DUDtHS94, xyz_V = xyz_DVDtHS94, xyz_Vor = xyz_DVorDtHS94, xyz_Div = xyz_DDivDtHS94 ) ! (out)
call UV2VorDiv( dyn_sp_as = dyn, xyz_U = xyz_UB, xyz_V = xyz_VB, xyz_Vor = xyz_VorB, xyz_Div = xyz_DivB ) ! (out)
call UV2VorDiv( dyn_sp_as = dyn, xyz_U = xyz_UN, xyz_V = xyz_VN, xyz_Vor = xyz_VorN, xyz_Div = xyz_DivN ) ! (out)
call DCClockStop( clk = clk_phy ) ! (inout)
!----------------------------------------------------------------
! 力学過程演算
! Dynamical core
!----------------------------------------------------------------
call DCClockStart( clk = clk_dyn ) ! (inout)
call Dynamics( dyn_sp_as = dyn, xyz_VorB = xyz_VorB, xyz_DivB = xyz_DivB, xyz_TempB = xyz_TempB, xyz_QVapB = xyz_QVapB, xy_PsB = xy_PsB, xyz_VorN = xyz_VorN, xyz_DivN = xyz_DivN, xyz_TempN = xyz_TempN, xyz_QVapN = xyz_QVapN, xy_PsN = xy_PsN, xyz_DVorDt = xyz_DVorDtHS94, xyz_DDivDt = xyz_DDivDtHS94, xyz_DTempDt = xyz_DTempDtHS94, xyz_VorA = xyz_VorA, xyz_DivA = xyz_DivA, xyz_TempA = xyz_TempA, xyz_QVapA = xyz_QVapA, xy_PsA = xy_PsA ) ! (out)
call DCClockStop( clk = clk_dyn ) ! (inout)
!----------------------------------------------------------------
! タイムフィルター
! Time filter
!----------------------------------------------------------------
call DCClockStart( clk = clk_tfilt ) ! (inout)
call Filter( tfilt = tfilt, before = xyz_VorB, now = xyz_VorN, after = xyz_VorA ) ! (in)
call Filter( tfilt = tfilt, before = xyz_DivB, now = xyz_DivN, after = xyz_DivA ) ! (in)
call Filter( tfilt = tfilt, before = xyz_TempB, now = xyz_TempN, after = xyz_TempA ) ! (in)
call Filter( tfilt = tfilt, before = xyz_QVapB, now = xyz_QVapN, after = xyz_QVapA ) ! (in)
call Filter( tfilt = tfilt, before = xy_PsB, now = xy_PsN, after = xy_PsA ) ! (in)
call Progress( tfilt = tfilt, time = delta_time ) ! (in)
call DCClockStop( clk = clk_tfilt ) ! (inout)
!----------------------------------------------------------------
! データ出力
! Output data
!----------------------------------------------------------------
call DCClockStart( clk = clk_histput ) ! (inout)
!-------------------------
! 渦度と発散から東西風速と南北風速を計算
! Calculate zonal and meridional wind from vorticity and divergence
! at step
call VorDiv2UV( dyn_sp_as = dyn, xyz_Vor = xyz_VorN, xyz_Div = xyz_DivN, xyz_U = xyz_UN, xyz_V = xyz_VN ) ! (out)
call VorDiv2UV( dyn_sp_as = dyn, xyz_Vor = xyz_VorA, xyz_Div = xyz_DivA, xyz_U = xyz_UA, xyz_V = xyz_VA ) ! (out)
!-------------------------
! ヒストリファイルへのデータ出力
! Output history data
call history_output ! これは内部サブルーチン. This is an internal subroutine
!-------------------------
! リスタートファイルへのデータ出力
! Output restart data
call restart_output ! これは内部サブルーチン. This is an internal subroutine
call DCClockStop( clk = clk_histput ) ! (inout)
!-----------------------------------------------------------------
! プログラム終了までの予測 CPU 時間および予測日時を表示
! Print predicted CPU time and date to finish of program
!-----------------------------------------------------------------
if ( mod(current_time + delta_time, predict_show_interval_time) == 0 ) then
call DCClockPredict( clk = clk_setup + clk_histget + clk_histput + clk_dyn + clk_phy + clk_tfilt, progress = real( ( current_time + delta_time - start_time ) / ( total_time - start_time ) ) ) ! (in)
end if
!----------------------------------------------------------------
! 予測変数の時刻付け替え
! Exchange time of prediction variables
!----------------------------------------------------------------
xyz_UB = xyz_UN
xyz_UN = xyz_UA
xyz_UA = 0.0_DP
xyz_VB = xyz_VN
xyz_VN = xyz_VA
xyz_VA = 0.0_DP
xyz_TempB = xyz_TempN
xyz_TempN = xyz_TempA
xyz_TempA = 0.0_DP
xyz_QVapB = xyz_QVapN
xyz_QVapN = xyz_QVapA
xyz_QVapA = 0.0_DP
xy_PsB = xy_PsN
xy_PsN = xy_PsA
xy_PsA = 0.0_DP
!----------------------------------------------------------------
! 現在時刻の更新
! Update current time
!----------------------------------------------------------------
current_time = current_time + delta_time
enddo MainLoop
!----------------------------------------------------------------
! ヒストリファイルへのデータ出力の終了処理
! Terminate history data output
!----------------------------------------------------------------
call history_output_close ! これは内部サブルーチン. This is an internal subroutine
!----------------------------------------------------------------
! リスタートファイルへのデータ出力の終了処理
! Terminate restart data output
!----------------------------------------------------------------
call restart_output_close ! これは内部サブルーチン. This is an internal subroutine
!----------------------------------------------------------------
! CPU 時間の総計を表示
! Print total CPU time
!----------------------------------------------------------------
call DCClockResult( clks = (/clk_setup, clk_histget, clk_histput, clk_dyn, clk_phy, clk_tfilt/), total_auto = .true.) ! (in)
call EndSub( subname )
contains
subroutine cmdline_optparse
!
! コマンドライン引数の処理を行います
!
! Handle command line options
!
call DCArgsOpen( arg = arg ) ! (out)
call DCArgsHelpMsg( arg = arg, category = 'Title', msg = title ) ! (in)
call DCArgsHelpMsg( arg = arg, category = 'Usage', msg = './' // trim(subname) // ' [Options]' ) ! (in)
call DCArgsHelpMsg( arg = arg, category = 'Description', msg = 'This program runs Held and Suarez (1994) benchmark test. ' // 'By default, ' // 'the resolution is T' // trim(toChar(nmax)) // 'L' // trim(toChar(kmax)) // '. ' // 'For details, see below. ' // 'In order to change the settings, use NAMELIST file. ' // 'Some samples are prepared as dcpam_hs94_***.nml .' )
call DCArgsHelpMsg( arg = arg, category = 'Details about time', msg = 'By default, integration time is ' // trim(toChar(total_time_value)) // ' ' // trim(total_time_unit) // ', ' // 'time step is ' // trim(toChar(delta_time_value)) // ' ' // trim(delta_time_unit) // '. ' )
call DCArgsHelpMsg( arg = arg, category = 'Details about an initial data file', msg = 'By default, no initial data file is needed. ' // 'Initial data is generated internally.' )
call DCArgsHelpMsg( arg = arg, category = 'Details about output files', msg = 'By default, a restart file is "' // trim(restart_filename) // '", ' // 'and history data are "' // trim(history_varlist) // '". ' // 'All variables that can be output are displayed ' // 'in messages when the program is executed. ' )
call DCArgsHelpMsg( arg = arg, category = 'Source', msg = source ) ! (in)
call DCArgsHelpMsg( arg = arg, category = 'Institution', msg = institution ) ! (in)
call DCArgsOption( arg = arg, options = StoA('-N', '--namelist'), flag = OPT_namelist, value = VAL_namelist, help = "NAMELIST filename") ! (in)
call DCArgsDebug( arg = arg ) ! (inout)
call DCArgsHelp( arg = arg ) ! (inout)
call DCArgsStrict( arg = arg ) ! (inout)
call DCArgsClose( arg = arg ) ! (inout)
end subroutine cmdline_optparse
subroutine history_output_init
!
! ヒストリデータ出力の初期設定を行います.
!
! History data output is initialized.
!
use dc_present, only: present_and_true, present_and_not_empty
use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit
use gt4_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, HstNmlInfoPutLine, HstNmlInfoEndDefine, HstNmlInfoInquire
use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryPut, HistoryAddAttr, HistoryInitialized
!-----------------------------------
! 作業変数
! Work variables
logical:: end
interface
subroutine GTHistNmlRead( nmlfile, gthstnml, err )
use gt4_history_nmlinfo, only: GTHST_NMLINFO
character(*), intent(in):: nmlfile
type(GTHST_NMLINFO), intent(inout):: gthstnml
logical, intent(out), optional:: err
end subroutine GTHistNmlRead
end interface
continue
!-----------------------------------------------------------------
! デフォルト値の設定
! Configure default values
!-----------------------------------------------------------------
allocate( gthstnml_history )
gthstnml => gthstnml_history
call HstNmlInfoCreate( gthstnml = gthstnml ) ! (out)
call HstNmlInfoAdd( gthstnml = gthstnml, name = '', interval_value = history_interval_value, interval_unit = history_interval_unit, precision = history_precision, average = .false., fileprefix = '' ) ! (in)
!-------------------------
! デフォルトで出力する変数のリスト
! List of variables that are output by default
call HstNmlInfoAdd( gthstnml = gthstnml, name = history_varlist ) ! (in)
!-----------------------------------------------------------------
! NAMELIST からの値の読み込み
! Load values from NAMELIST
!-----------------------------------------------------------------
if ( present_and_not_empty(VAL_namelist) ) then
call MessageNotify( 'M', subname, 'Loading NAMELIST file "%c" ...', c1 = trim(VAL_namelist) )
call GTHistNmlRead ( nmlfile = VAL_namelist, gthstnml = gthstnml ) ! (inout)
end if
call HstNmlInfoEndDefine( gthstnml = gthstnml ) ! (inout)
!-----------------------------------------------------------------
! 主プログラム上のヒストリデータ出力関連情報の更新
! Update history data output information on the main program
!-----------------------------------------------------------------
call HstNmlInfoInquire( gthstnml = gthstnml, interval_value = history_interval_value, interval_unit = history_interval_unit, precision = history_precision, fileprefix = history_fileprefix ) ! (out)
!-----------------------------------------------------------------
! データ出力の初期設定
! Initialize data output
!-----------------------------------------------------------------
!-------------------------
! xyz_U の出力設定
! Configure the settings for "xyz_U" output
name = 'U'
longname = 'eastward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'eastward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_V の出力設定
! Configure the settings for "xyz_V" output
name = 'V'
longname = 'northward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'northward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Vor の出力設定
! Configure the settings for "xyz_Vor" output
name = 'Vor'
longname = 'vorticity'
units = 's-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'atmosphere_relative_vorticity' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Div の出力設定
! Configure the settings for "xyz_Div" output
name = 'Div'
longname = 'divergence'
units = 's-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'divergence_of_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Temp の出力設定
! Configure the settings for "xyz_Temp" output
name = 'Temp'
longname = 'temperature'
units = 'K'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'air_temperature' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_QVap の出力設定
! Configure the settings for "xyz_QVap" output
name = 'QVap'
longname = 'specific humidity'
units = 'kg kg-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'specific_humidity' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Ps の出力設定
! Configure the settings for "xyz_Ps" output
name = 'Ps'
longname = 'surface pressure'
units = 'Pa'
allocate( dims(3) )
dims = StoA( 'lon', 'lat', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'surface_air_pressure' ) ! (in)
end if
deallocate( dims )
!-----------------------------------------------------------------
! このモジュールから出力される変数名のリストを表示
! Print list of names of variables output from this module
!-----------------------------------------------------------------
call Printf( STDOUT, ' *** MESSAGE *** +---- "%c" output varnames list -----', c1 = subname )
call DCHashRewind( hashv = registered_varnames ) ! (inout)
do
call DCHashNext( hashv = registered_varnames, key = name, value = longname, end = end ) ! (out)
if ( end ) exit
call Printf( STDOUT, ' *** MESSAGE *** | "%c" (%c)', c1 = trim(name), c2 = trim(longname) )
enddo
call DCHashDelete( hashv = registered_varnames ) ! (inout)
call Printf( STDOUT, ' *** MESSAGE *** `----------------------------------------' )
nullify( gthstnml )
end subroutine history_output_init
subroutine restart_output_init
!
! リスタートデータ出力の初期設定を行います.
!
! Restart data output is initialized.
!
use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit
use gt4_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, HstNmlInfoPutLine, HstNmlInfoEndDefine
use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryPut, HistoryAddAttr, HistoryInitialized
namelist /dcpam_hs94_restart_nml/ restart_interval_value, restart_interval_unit, restart_filename
! リスタートファイルへのデータ出力設定
!
! Configure the settings for restart data output
continue
!-----------------------------------------------------------------
! デフォルト値の設定
! Configure default values
!-----------------------------------------------------------------
allocate( gthstnml_restart )
gthstnml => gthstnml_restart
call HstNmlInfoCreate( gthstnml = gthstnml ) ! (out)
!-----------------------------------------------------------------
! NAMELIST の読み込み
! Load NAMELIST
!-----------------------------------------------------------------
if ( .not. trim(VAL_namelist) == '' ) then
call FileOpen( unit = unit_nml, file = VAL_namelist, mode = 'r' ) ! (in)
read( unit = unit_nml, nml = dcpam_hs94_restart_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_hs94_restart_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_hs94_restart_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_hs94_restart_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-----------------------------------------------------------------
! 出力する変数の登録
! Register variables that are output
!-----------------------------------------------------------------
call HstNmlInfoAdd( gthstnml = gthstnml, name = '', file = restart_filename, interval_value = restart_interval_value, interval_unit = restart_interval_unit, precision = 'double', average = .false., fileprefix = '' ) ! (in)
call HstNmlInfoAdd( gthstnml = gthstnml, name = 'U, V, Temp, QVap, Ps', file = restart_filename ) ! (in)
call HstNmlInfoEndDefine( gthstnml = gthstnml ) ! (inout)
!-----------------------------------------------------------------
! データ出力の初期設定
! Initialize data output
!-----------------------------------------------------------------
!-------------------------
! xyz_U の出力設定
! Configure the settings for "xyz_U" output
name = 'U'
longname = 'eastward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'eastward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_V の出力設定
! Configure the settings for "xyz_V" output
name = 'V'
longname = 'northward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'northward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Temp の出力設定
! Configure the settings for "xyz_Temp" output
name = 'Temp'
longname = 'temperature'
units = 'K'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'air_temperature' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_QVap の出力設定
! Configure the settings for "xyz_QVap" output
name = 'QVap'
longname = 'specific humidity'
units = 'kg kg-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'specific_humidity' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Ps の出力設定
! Configure the settings for "xyz_Ps" output
name = 'Ps'
longname = 'surface pressure'
units = 'Pa'
allocate( dims(3) )
dims = StoA( 'lon', 'lat', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'surface_air_pressure' ) ! (in)
end if
deallocate( dims )
nullify( gthstnml )
end subroutine restart_output_init
subroutine output_init
!
! 変数 *name* に関して出力ファイルの初期設定を行います.
! 出力ファイル名や出力間隔などの情報は gthstnml
! から取り出されます.
!
! 変数 *name* に関して出力が行われる場合には,
! *gthist* に出力先ファイルの gt4_history#GT_HISTORY
! 型変数を結合させます. そうでない場合は, *gthist* を空状態にします.
!
! また, 出力データの精度を precision に,
! 出力データ平均化の可否を average に設定します.
!
! 標準出力に表示される変数リスト *registered_varnames* に
! *name*, *longname*, *dims*, *units* が登録されます.
!
! An output file is initialized for a variable *name*.
! Information such as the output filename and output intervals
! is taken out of "gthstnml".
!
! When output is done for the variable *name*, *gthist* is
! associated with the "gt4_history#GT_HISTORY" variable of
! the output file. Otherwise, *gthist* is nullified.
!
! Moreover, the accuracy of output data is set to *precision*, and
! right or wrong of averaging the output data is set to *average*.
!
! *name*, *longname*, *dims*, *units* are registered to
! a list of variables *registered_varnames* that is printed to
! standard output.
!
use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit
use dc_string, only: JoinChar
use gt4_history_nmlinfo, only: HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoAssocGtHist, HstNmlInfoPutLine
use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryPut, HistoryAddAttr, HistoryInitialized
!-----------------------------------
! 作業変数
! Work variables
character(STRING):: file
! ヒストリデータのファイル名.
! History data filenames
character(STRING):: dims_str
! 座標軸のリスト.
! List of axes
real:: interval_value
! ヒストリデータの出力間隔の数値.
! Numerical value for interval of history data output
character(TOKEN):: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
real(DP), parameter:: PI = 3.1415926535897930_DP
! $ \pi $ . 円周率. Circular constant
continue
!-----------------------------------------------------------------
! 標準出力に表示される変数の登録
! Register a variable name for print to standard output
!-----------------------------------------------------------------
if ( allocated(dims) ) then
dims_str = JoinChar( dims, ',' )
else
dims_str = ''
end if
call DCHashPut( hashv = registered_varnames, key = name, value = trim( longname ) // ' [' // trim( units ) // '] {' // trim( dims_str ) // '}' ) ! (in)
!-----------------------------------------------------------------
! 変数の初期化
! Initialize variable
!-----------------------------------------------------------------
nullify( gthist )
precision = 'float'
average = .false.
!-----------------------------------------------------------------
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!-----------------------------------------------------------------
if ( .not. HstNmlInfoOutputValid( gthstnml, name ) ) then
return
end if
!-----------------------------------------------------------------
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!-----------------------------------------------------------------
call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = name, history = gthist ) ! (out)
call HstNmlInfoInquire( gthstnml = gthstnml, name = name, precision = precision, average = average ) ! (out)
!-----------------------------------------------------------------
! GT_HISTORY 変数の初期設定の確認
! Check initialization of "GT_HISTORY" variable
!-----------------------------------------------------------------
if ( HistoryInitialized( gthist ) ) then
!---------------------------------------------------------------
! HistoryAddVariable による変数作成
! A variable is created by "HistoryAddVariable"
!---------------------------------------------------------------
call HistoryAddVariable( history = gthist, varname = name, dims = dims, longname = longname, units = units, xtype = precision, average = average ) ! (in)
return
end if
!-----------------------------------------------------------------
! HistoryCreate のための設定値の取得
! Get the settings for "HistoryCreate"
!-----------------------------------------------------------------
call HstNmlInfoInquire( gthstnml = gthstnml, name = name, file = file, interval_unit = interval_unit, interval_value = interval_value ) ! (out)
!-----------------------------------------------------------------
! HistoryCreate によるファイル作成
! Files are created by "HistoryCreate"
!-----------------------------------------------------------------
call HistoryCreate( history = gthist, file = file, title = title, source = source, institution = institution, dims = StoA( 'lon', 'lat', 'sig', 'sigm', 'time' ), dimsizes = (/ imax, jmax, kmax, kmax + 1, 0 /), longnames = StoA( 'longitude', 'latitude', 'sigma at layer midpoints', 'sigma at layer end-points (half level)', 'time' ), units = StoA( 'degree_east', 'degree_north', '1', '1', interval_unit ), origin = real( EvalbyUnit( current_time, interval_unit) ), interval = interval_value ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lon', attrname = 'standard_name', value = 'longitude' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lat', attrname = 'standard_name', value = 'latitude' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sig', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sigm', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'time', attrname = 'standard_name', value = 'time' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sig', attrname = 'positive', value = 'down' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sigm', attrname = 'positive', value = 'down' ) ! (in)
call HistoryPut( history = gthist, varname = 'lon', array = x_Lon / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist, varname = 'lat', array = y_Lat / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist, varname = 'sig', array = z_Sigma ) ! (in)
call HistoryPut( history = gthist, varname = 'sigm', array = r_Sigma ) ! (in)
call HistoryAddVariable( history = gthist, varname = 'lon_weight', dims = StoA('lon'), longname = 'weight for integration in longitude', units = 'radian', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lon', attrname = 'gt_calc_weight', value = 'lon_weight' ) ! (in)
call HistoryPut( history = gthist, varname = 'lon_weight', array = x_Lon_Weight ) ! (in)
call HistoryAddVariable( history = gthist, varname = 'lat_weight', dims = StoA('lat'), longname = 'weight for integration in latitude', units = 'radian', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lat', attrname = 'gt_calc_weight', value = 'lat_weight' ) ! (in)
call HistoryPut( history = gthist, varname = 'lat_weight', array = y_Lat_Weight ) ! (in)
!-----------------------------------------------------------------
! HistoryAddVariable による変数作成
! A variable is created by "HistoryAddVariable"
!-----------------------------------------------------------------
if ( HistoryInitialized( gthist ) ) then
call HistoryAddVariable( history = gthist, varname = name, dims = dims, longname = longname, units = units, xtype = precision, average = average ) ! (in)
else
nullify( gthist )
end if
end subroutine output_init
subroutine history_output_inidata
!
! ヒストリデータ (初期値) を出力します.
!
! Output history data (initial).
!
use gt4_history, only: HistoryPut
continue
gthstnml => gthstnml_history
!-------------------------
! xyz_U の出力
! Output "xyz_U"
name = 'U'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_UN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_V の出力
! Output "xyz_V"
name = 'V'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Vor の出力
! Output "xyz_Vor"
name = 'Vor'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VorN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Div の出力
! Output "xyz_Div"
name = 'Div'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_DivN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Temp の出力
! Output "xyz_Temp"
name = 'Temp'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_TempN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_QVap の出力
! Output "xyz_QVap"
name = 'QVap'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_QVapN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Ps の出力
! Output "xyz_Ps"
name = 'Ps'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xy_PsN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
nullify( gthstnml )
end subroutine history_output_inidata
subroutine history_output
!
! ヒストリデータを出力します.
!
! Output history data.
!
use gt4_history, only: HistoryPut
continue
gthstnml => gthstnml_history
!-------------------------
! xyz_U の出力
! Output "xyz_U"
name = 'U'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_UA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_V の出力
! Output "xyz_V"
name = 'V'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Vor の出力
! Output "xyz_Vor"
name = 'Vor'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VorA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Div の出力
! Output "xyz_Div"
name = 'Div'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_DivA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Temp の出力
! Output "xyz_Temp"
name = 'Temp'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_TempA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_QVap の出力
! Output "xyz_QVap"
name = 'QVap'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_QVapA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Ps の出力
! Output "xyz_Ps"
name = 'Ps'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xy_PsA, time = time, quiet = .false. ) ! (in)
end if
nullify( gthstnml )
end subroutine history_output
subroutine restart_output
!
! リスタートデータを出力します.
!
! Output restart data.
!
use gt4_history_nmlinfo, only: HstNmlInfoAssocGtHist
use gt4_history, only: HistoryPut, HistorySetTime
type(DC_DIFFTIME):: restart_interval_time
! リスタートデータの出力間隔.
! Interval of restart data output
continue
nullify( gthist )
gthstnml => gthstnml_restart
name = 'Temp'
!-----------------------------------------------------------------
! 出力ステップのチェック
! Check output step
!-----------------------------------------------------------------
call DCDiffTimeCreate( diff = restart_interval_time, value = real( restart_interval_value, DP ), unit = restart_interval_unit) ! (in)
if ( .not. mod( current_time + delta_time, restart_interval_time ) == 0 ) then
return
end if
call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = name, history = gthist ) ! (out)
!-----------------------------------------------------------------
! ステップ $ t $ の出力
! Output at step $ t $
!-----------------------------------------------------------------
call HistorySetTime( history = gthist, time = real( EvalbyUnit(current_time, restart_interval_unit) ) ) ! (in)
call HistoryPut( history = gthist, varname = 'U', array = xyz_UN ) ! (in)
call HistoryPut( history = gthist, varname = 'V', array = xyz_VN ) ! (in)
call HistoryPut( history = gthist, varname = 'Temp', array = xyz_TempN ) ! (in)
call HistoryPut( history = gthist, varname = 'QVap', array = xyz_QVapN ) ! (in)
call HistoryPut( history = gthist, varname = 'Ps', array = xy_PsN ) ! (in)
!-----------------------------------------------------------------
! ステップ $ t + \Delta t $ の出力
! Output at step $ t + \Delta t $
!-----------------------------------------------------------------
call HistorySetTime( history = gthist, time = real( EvalbyUnit(current_time + delta_time, restart_interval_unit) ) ) ! (in)
call HistoryPut( history = gthist, varname = 'U', array = xyz_UA ) ! (in)
call HistoryPut( history = gthist, varname = 'V', array = xyz_VA ) ! (in)
call HistoryPut( history = gthist, varname = 'Temp', array = xyz_TempA ) ! (in)
call HistoryPut( history = gthist, varname = 'QVap', array = xyz_QVapA ) ! (in)
call HistoryPut( history = gthist, varname = 'Ps', array = xy_PsA ) ! (in)
nullify( gthstnml )
nullify( gthist )
!-----------------------------------------------------------------
! ファイル出力に関してメッセージを表示
! Print message of file output
!-----------------------------------------------------------------
call MessageNotify( 'M', subname, 'Restart data => "%c" (time=%f, %f %a)', d=(/ EvalbyUnit(current_time, restart_interval_unit), EvalbyUnit(current_time + delta_time, restart_interval_unit) /), ca=StoA( trim(restart_interval_unit) ), c1=trim(restart_filename) )
end subroutine restart_output
subroutine output_check
!
! 変数 *name* を出力するかどうかをチェックします.
! 出力に関する情報は gthstnml から取り出されます.
!
! 変数 *name* に関して出力するよう設定されている場合には,
! *gthist* に出力先ファイルの gt4_history#GT_HISTORY
! 型変数を結合させます. そうでない場合は, *gthist* を空状態にします.
!
! また, 現在時刻を *time* に設定します.
!
! Check whether to output variable *name*.
! Information about output is taken out of "gthstnml".
!
! When output is done for the variable *name*, *gthist* is
! associated with "gt4_history#GT_HISTORY" variable of
! the output file. Otherwise, *gthist* is nullified.
!
! Moreover, current time is set to *time*.
!
use gt4_history_nmlinfo, only: HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoAssocGtHist
use gt4_history, only: HistoryInitialized
character(TOKEN):: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
continue
nullify( gthist )
time = 0.0
if ( HstNmlInfoOutputValid( gthstnml, name ) ) then
call HstNmlInfoInquire( gthstnml = gthstnml, name = name, interval_unit = interval_unit ) ! (out)
time = real( EvalbyUnit( current_time + delta_time, interval_unit ) )
call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = name, history = gthist ) ! (out)
if ( .not. HistoryInitialized( gthist ) ) nullify( gthist )
end if
end subroutine output_check
subroutine history_output_close
!
! ヒストリデータ出力の終了設定を行います.
!
! History data output is terminated.
!
use gt4_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoNames, HstNmlInfoAssocGtHist, HstNmlInfoPutLine
use gt4_history, only: HistoryInitialized, HistoryClose
use dc_string, only: Split
character(STRING):: varnames
! 変数名リスト.
! List of variables
character(TOKEN), pointer:: varnames_array(:) =>null()
! 変数名リスト配列.
! List of variables (array)
integer:: i, vnmax
continue
gthstnml => gthstnml_history
varnames = HstNmlInfoNames( gthstnml )
call Split( str = varnames, sep = ',', carray = 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, name = name, history = gthist ) ! (out)
if ( HistoryInitialized( gthist ) ) then
call HistoryClose( history = gthist ) ! (inout)
nullify( gthist )
end if
end do
nullify( gthstnml )
end subroutine history_output_close
subroutine restart_output_close
!
! リスタートデータ出力の終了設定を行います.
!
! Restart data output is terminated.
!
use gt4_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoNames, HstNmlInfoAssocGtHist, HstNmlInfoPutLine
use gt4_history, only: HistoryInitialized, HistoryClose
use dc_string, only: Split
character(STRING):: varnames
! 変数名リスト.
! List of variables
character(TOKEN), pointer:: varnames_array(:) =>null()
! 変数名リスト配列.
! List of variables (array)
integer:: i, vnmax
continue
gthstnml => gthstnml_restart
varnames = HstNmlInfoNames( gthstnml )
call Split( str = varnames, sep = ',', carray = 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, name = name, history = gthist ) ! (out)
if ( HistoryInitialized( gthist ) ) then
call HistoryClose( history = gthist ) ! (inout)
nullify( gthist )
end if
end do
nullify( gthstnml )
end subroutine restart_output_close
end program dcpam_hs94
| Subroutine : |
コマンドライン引数の処理を行います
Handle command line options
subroutine cmdline_optparse
!
! コマンドライン引数の処理を行います
!
! Handle command line options
!
call DCArgsOpen( arg = arg ) ! (out)
call DCArgsHelpMsg( arg = arg, category = 'Title', msg = title ) ! (in)
call DCArgsHelpMsg( arg = arg, category = 'Usage', msg = './' // trim(subname) // ' [Options]' ) ! (in)
call DCArgsHelpMsg( arg = arg, category = 'Description', msg = 'This program runs Held and Suarez (1994) benchmark test. ' // 'By default, ' // 'the resolution is T' // trim(toChar(nmax)) // 'L' // trim(toChar(kmax)) // '. ' // 'For details, see below. ' // 'In order to change the settings, use NAMELIST file. ' // 'Some samples are prepared as dcpam_hs94_***.nml .' )
call DCArgsHelpMsg( arg = arg, category = 'Details about time', msg = 'By default, integration time is ' // trim(toChar(total_time_value)) // ' ' // trim(total_time_unit) // ', ' // 'time step is ' // trim(toChar(delta_time_value)) // ' ' // trim(delta_time_unit) // '. ' )
call DCArgsHelpMsg( arg = arg, category = 'Details about an initial data file', msg = 'By default, no initial data file is needed. ' // 'Initial data is generated internally.' )
call DCArgsHelpMsg( arg = arg, category = 'Details about output files', msg = 'By default, a restart file is "' // trim(restart_filename) // '", ' // 'and history data are "' // trim(history_varlist) // '". ' // 'All variables that can be output are displayed ' // 'in messages when the program is executed. ' )
call DCArgsHelpMsg( arg = arg, category = 'Source', msg = source ) ! (in)
call DCArgsHelpMsg( arg = arg, category = 'Institution', msg = institution ) ! (in)
call DCArgsOption( arg = arg, options = StoA('-N', '--namelist'), flag = OPT_namelist, value = VAL_namelist, help = "NAMELIST filename") ! (in)
call DCArgsDebug( arg = arg ) ! (inout)
call DCArgsHelp( arg = arg ) ! (inout)
call DCArgsStrict( arg = arg ) ! (inout)
call DCArgsClose( arg = arg ) ! (inout)
end subroutine cmdline_optparse
| Subroutine : |
ヒストリデータを出力します.
Output history data.
subroutine history_output
!
! ヒストリデータを出力します.
!
! Output history data.
!
use gt4_history, only: HistoryPut
continue
gthstnml => gthstnml_history
!-------------------------
! xyz_U の出力
! Output "xyz_U"
name = 'U'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_UA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_V の出力
! Output "xyz_V"
name = 'V'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Vor の出力
! Output "xyz_Vor"
name = 'Vor'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VorA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Div の出力
! Output "xyz_Div"
name = 'Div'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_DivA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Temp の出力
! Output "xyz_Temp"
name = 'Temp'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_TempA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_QVap の出力
! Output "xyz_QVap"
name = 'QVap'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_QVapA, time = time, quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Ps の出力
! Output "xyz_Ps"
name = 'Ps'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xy_PsA, time = time, quiet = .false. ) ! (in)
end if
nullify( gthstnml )
end subroutine history_output
| Subroutine : |
ヒストリデータ出力の終了設定を行います.
History data output is terminated.
subroutine history_output_close
!
! ヒストリデータ出力の終了設定を行います.
!
! History data output is terminated.
!
use gt4_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoNames, HstNmlInfoAssocGtHist, HstNmlInfoPutLine
use gt4_history, only: HistoryInitialized, HistoryClose
use dc_string, only: Split
character(STRING):: varnames
! 変数名リスト.
! List of variables
character(TOKEN), pointer:: varnames_array(:) =>null()
! 変数名リスト配列.
! List of variables (array)
integer:: i, vnmax
continue
gthstnml => gthstnml_history
varnames = HstNmlInfoNames( gthstnml )
call Split( str = varnames, sep = ',', carray = 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, name = name, history = gthist ) ! (out)
if ( HistoryInitialized( gthist ) ) then
call HistoryClose( history = gthist ) ! (inout)
nullify( gthist )
end if
end do
nullify( gthstnml )
end subroutine history_output_close
| Subroutine : |
ヒストリデータ (初期値) を出力します.
Output history data (initial).
subroutine history_output_inidata
!
! ヒストリデータ (初期値) を出力します.
!
! Output history data (initial).
!
use gt4_history, only: HistoryPut
continue
gthstnml => gthstnml_history
!-------------------------
! xyz_U の出力
! Output "xyz_U"
name = 'U'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_UN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_V の出力
! Output "xyz_V"
name = 'V'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Vor の出力
! Output "xyz_Vor"
name = 'Vor'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_VorN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Div の出力
! Output "xyz_Div"
name = 'Div'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_DivN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Temp の出力
! Output "xyz_Temp"
name = 'Temp'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_TempN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_QVap の出力
! Output "xyz_QVap"
name = 'QVap'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xyz_QVapN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
!-------------------------
! xyz_Ps の出力
! Output "xyz_Ps"
name = 'Ps'
! 出力のチェック.
! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される.
! Check for output.
! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured.
call output_check ! これは内部サブルーチン. This is an internal subroutine
if ( associated( gthist ) ) then
call HistoryPut( history = gthist, varname = name, array = xy_PsN, time = real( start_time_value ), quiet = .false. ) ! (in)
end if
nullify( gthstnml )
end subroutine history_output_inidata
| Subroutine : |
ヒストリデータ出力の初期設定を行います.
History data output is initialized.
subroutine history_output_init
!
! ヒストリデータ出力の初期設定を行います.
!
! History data output is initialized.
!
use dc_present, only: present_and_true, present_and_not_empty
use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit
use gt4_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, HstNmlInfoPutLine, HstNmlInfoEndDefine, HstNmlInfoInquire
use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryPut, HistoryAddAttr, HistoryInitialized
!-----------------------------------
! 作業変数
! Work variables
logical:: end
continue
!-----------------------------------------------------------------
! デフォルト値の設定
! Configure default values
!-----------------------------------------------------------------
allocate( gthstnml_history )
gthstnml => gthstnml_history
call HstNmlInfoCreate( gthstnml = gthstnml ) ! (out)
call HstNmlInfoAdd( gthstnml = gthstnml, name = '', interval_value = history_interval_value, interval_unit = history_interval_unit, precision = history_precision, average = .false., fileprefix = '' ) ! (in)
!-------------------------
! デフォルトで出力する変数のリスト
! List of variables that are output by default
call HstNmlInfoAdd( gthstnml = gthstnml, name = history_varlist ) ! (in)
!-----------------------------------------------------------------
! NAMELIST からの値の読み込み
! Load values from NAMELIST
!-----------------------------------------------------------------
if ( present_and_not_empty(VAL_namelist) ) then
call MessageNotify( 'M', subname, 'Loading NAMELIST file "%c" ...', c1 = trim(VAL_namelist) )
call GTHistNmlRead ( nmlfile = VAL_namelist, gthstnml = gthstnml ) ! (inout)
end if
call HstNmlInfoEndDefine( gthstnml = gthstnml ) ! (inout)
!-----------------------------------------------------------------
! 主プログラム上のヒストリデータ出力関連情報の更新
! Update history data output information on the main program
!-----------------------------------------------------------------
call HstNmlInfoInquire( gthstnml = gthstnml, interval_value = history_interval_value, interval_unit = history_interval_unit, precision = history_precision, fileprefix = history_fileprefix ) ! (out)
!-----------------------------------------------------------------
! データ出力の初期設定
! Initialize data output
!-----------------------------------------------------------------
!-------------------------
! xyz_U の出力設定
! Configure the settings for "xyz_U" output
name = 'U'
longname = 'eastward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'eastward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_V の出力設定
! Configure the settings for "xyz_V" output
name = 'V'
longname = 'northward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'northward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Vor の出力設定
! Configure the settings for "xyz_Vor" output
name = 'Vor'
longname = 'vorticity'
units = 's-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'atmosphere_relative_vorticity' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Div の出力設定
! Configure the settings for "xyz_Div" output
name = 'Div'
longname = 'divergence'
units = 's-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'divergence_of_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Temp の出力設定
! Configure the settings for "xyz_Temp" output
name = 'Temp'
longname = 'temperature'
units = 'K'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'air_temperature' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_QVap の出力設定
! Configure the settings for "xyz_QVap" output
name = 'QVap'
longname = 'specific humidity'
units = 'kg kg-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'specific_humidity' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Ps の出力設定
! Configure the settings for "xyz_Ps" output
name = 'Ps'
longname = 'surface pressure'
units = 'Pa'
allocate( dims(3) )
dims = StoA( 'lon', 'lat', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'surface_air_pressure' ) ! (in)
end if
deallocate( dims )
!-----------------------------------------------------------------
! このモジュールから出力される変数名のリストを表示
! Print list of names of variables output from this module
!-----------------------------------------------------------------
call Printf( STDOUT, ' *** MESSAGE *** +---- "%c" output varnames list -----', c1 = subname )
call DCHashRewind( hashv = registered_varnames ) ! (inout)
do
call DCHashNext( hashv = registered_varnames, key = name, value = longname, end = end ) ! (out)
if ( end ) exit
call Printf( STDOUT, ' *** MESSAGE *** | "%c" (%c)', c1 = trim(name), c2 = trim(longname) )
enddo
call DCHashDelete( hashv = registered_varnames ) ! (inout)
call Printf( STDOUT, ' *** MESSAGE *** `----------------------------------------' )
nullify( gthstnml )
end subroutine history_output_init
| Subroutine : |
変数 name を出力するかどうかをチェックします. 出力に関する情報は gthstnml から取り出されます.
変数 name に関して出力するよう設定されている場合には, gthist に出力先ファイルの gt4_history#GT_HISTORY 型変数を結合させます. そうでない場合は, gthist を空状態にします.
また, 現在時刻を time に設定します.
Check whether to output variable name. Information about output is taken out of "gthstnml".
When output is done for the variable name, gthist is associated with "gt4_history#GT_HISTORY" variable of the output file. Otherwise, gthist is nullified.
Moreover, current time is set to time.
subroutine output_check
!
! 変数 *name* を出力するかどうかをチェックします.
! 出力に関する情報は gthstnml から取り出されます.
!
! 変数 *name* に関して出力するよう設定されている場合には,
! *gthist* に出力先ファイルの gt4_history#GT_HISTORY
! 型変数を結合させます. そうでない場合は, *gthist* を空状態にします.
!
! また, 現在時刻を *time* に設定します.
!
! Check whether to output variable *name*.
! Information about output is taken out of "gthstnml".
!
! When output is done for the variable *name*, *gthist* is
! associated with "gt4_history#GT_HISTORY" variable of
! the output file. Otherwise, *gthist* is nullified.
!
! Moreover, current time is set to *time*.
!
use gt4_history_nmlinfo, only: HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoAssocGtHist
use gt4_history, only: HistoryInitialized
character(TOKEN):: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
continue
nullify( gthist )
time = 0.0
if ( HstNmlInfoOutputValid( gthstnml, name ) ) then
call HstNmlInfoInquire( gthstnml = gthstnml, name = name, interval_unit = interval_unit ) ! (out)
time = real( EvalbyUnit( current_time + delta_time, interval_unit ) )
call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = name, history = gthist ) ! (out)
if ( .not. HistoryInitialized( gthist ) ) nullify( gthist )
end if
end subroutine output_check
| Subroutine : |
変数 name に関して出力ファイルの初期設定を行います. 出力ファイル名や出力間隔などの情報は gthstnml から取り出されます.
変数 name に関して出力が行われる場合には, gthist に出力先ファイルの gt4_history#GT_HISTORY 型変数を結合させます. そうでない場合は, gthist を空状態にします.
また, 出力データの精度を precision に, 出力データ平均化の可否を average に設定します.
標準出力に表示される変数リスト registered_varnames に name, longname, dims, units が登録されます.
An output file is initialized for a variable name. Information such as the output filename and output intervals is taken out of "gthstnml".
When output is done for the variable name, gthist is associated with the "gt4_history#GT_HISTORY" variable of the output file. Otherwise, gthist is nullified.
Moreover, the accuracy of output data is set to precision, and right or wrong of averaging the output data is set to average.
name, longname, dims, units are registered to a list of variables registered_varnames that is printed to standard output.
subroutine output_init
!
! 変数 *name* に関して出力ファイルの初期設定を行います.
! 出力ファイル名や出力間隔などの情報は gthstnml
! から取り出されます.
!
! 変数 *name* に関して出力が行われる場合には,
! *gthist* に出力先ファイルの gt4_history#GT_HISTORY
! 型変数を結合させます. そうでない場合は, *gthist* を空状態にします.
!
! また, 出力データの精度を precision に,
! 出力データ平均化の可否を average に設定します.
!
! 標準出力に表示される変数リスト *registered_varnames* に
! *name*, *longname*, *dims*, *units* が登録されます.
!
! An output file is initialized for a variable *name*.
! Information such as the output filename and output intervals
! is taken out of "gthstnml".
!
! When output is done for the variable *name*, *gthist* is
! associated with the "gt4_history#GT_HISTORY" variable of
! the output file. Otherwise, *gthist* is nullified.
!
! Moreover, the accuracy of output data is set to *precision*, and
! right or wrong of averaging the output data is set to *average*.
!
! *name*, *longname*, *dims*, *units* are registered to
! a list of variables *registered_varnames* that is printed to
! standard output.
!
use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit
use dc_string, only: JoinChar
use gt4_history_nmlinfo, only: HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoAssocGtHist, HstNmlInfoPutLine
use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryPut, HistoryAddAttr, HistoryInitialized
!-----------------------------------
! 作業変数
! Work variables
character(STRING):: file
! ヒストリデータのファイル名.
! History data filenames
character(STRING):: dims_str
! 座標軸のリスト.
! List of axes
real:: interval_value
! ヒストリデータの出力間隔の数値.
! Numerical value for interval of history data output
character(TOKEN):: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
real(DP), parameter:: PI = 3.1415926535897930_DP
! $ \pi $ . 円周率. Circular constant
continue
!-----------------------------------------------------------------
! 標準出力に表示される変数の登録
! Register a variable name for print to standard output
!-----------------------------------------------------------------
if ( allocated(dims) ) then
dims_str = JoinChar( dims, ',' )
else
dims_str = ''
end if
call DCHashPut( hashv = registered_varnames, key = name, value = trim( longname ) // ' [' // trim( units ) // '] {' // trim( dims_str ) // '}' ) ! (in)
!-----------------------------------------------------------------
! 変数の初期化
! Initialize variable
!-----------------------------------------------------------------
nullify( gthist )
precision = 'float'
average = .false.
!-----------------------------------------------------------------
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!-----------------------------------------------------------------
if ( .not. HstNmlInfoOutputValid( gthstnml, name ) ) then
return
end if
!-----------------------------------------------------------------
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!-----------------------------------------------------------------
call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = name, history = gthist ) ! (out)
call HstNmlInfoInquire( gthstnml = gthstnml, name = name, precision = precision, average = average ) ! (out)
!-----------------------------------------------------------------
! GT_HISTORY 変数の初期設定の確認
! Check initialization of "GT_HISTORY" variable
!-----------------------------------------------------------------
if ( HistoryInitialized( gthist ) ) then
!---------------------------------------------------------------
! HistoryAddVariable による変数作成
! A variable is created by "HistoryAddVariable"
!---------------------------------------------------------------
call HistoryAddVariable( history = gthist, varname = name, dims = dims, longname = longname, units = units, xtype = precision, average = average ) ! (in)
return
end if
!-----------------------------------------------------------------
! HistoryCreate のための設定値の取得
! Get the settings for "HistoryCreate"
!-----------------------------------------------------------------
call HstNmlInfoInquire( gthstnml = gthstnml, name = name, file = file, interval_unit = interval_unit, interval_value = interval_value ) ! (out)
!-----------------------------------------------------------------
! HistoryCreate によるファイル作成
! Files are created by "HistoryCreate"
!-----------------------------------------------------------------
call HistoryCreate( history = gthist, file = file, title = title, source = source, institution = institution, dims = StoA( 'lon', 'lat', 'sig', 'sigm', 'time' ), dimsizes = (/ imax, jmax, kmax, kmax + 1, 0 /), longnames = StoA( 'longitude', 'latitude', 'sigma at layer midpoints', 'sigma at layer end-points (half level)', 'time' ), units = StoA( 'degree_east', 'degree_north', '1', '1', interval_unit ), origin = real( EvalbyUnit( current_time, interval_unit) ), interval = interval_value ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lon', attrname = 'standard_name', value = 'longitude' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lat', attrname = 'standard_name', value = 'latitude' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sig', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sigm', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'time', attrname = 'standard_name', value = 'time' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sig', attrname = 'positive', value = 'down' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'sigm', attrname = 'positive', value = 'down' ) ! (in)
call HistoryPut( history = gthist, varname = 'lon', array = x_Lon / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist, varname = 'lat', array = y_Lat / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist, varname = 'sig', array = z_Sigma ) ! (in)
call HistoryPut( history = gthist, varname = 'sigm', array = r_Sigma ) ! (in)
call HistoryAddVariable( history = gthist, varname = 'lon_weight', dims = StoA('lon'), longname = 'weight for integration in longitude', units = 'radian', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lon', attrname = 'gt_calc_weight', value = 'lon_weight' ) ! (in)
call HistoryPut( history = gthist, varname = 'lon_weight', array = x_Lon_Weight ) ! (in)
call HistoryAddVariable( history = gthist, varname = 'lat_weight', dims = StoA('lat'), longname = 'weight for integration in latitude', units = 'radian', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist, varname = 'lat', attrname = 'gt_calc_weight', value = 'lat_weight' ) ! (in)
call HistoryPut( history = gthist, varname = 'lat_weight', array = y_Lat_Weight ) ! (in)
!-----------------------------------------------------------------
! HistoryAddVariable による変数作成
! A variable is created by "HistoryAddVariable"
!-----------------------------------------------------------------
if ( HistoryInitialized( gthist ) ) then
call HistoryAddVariable( history = gthist, varname = name, dims = dims, longname = longname, units = units, xtype = precision, average = average ) ! (in)
else
nullify( gthist )
end if
end subroutine output_init
| Subroutine : |
リスタートデータを出力します.
Output restart data.
subroutine restart_output
!
! リスタートデータを出力します.
!
! Output restart data.
!
use gt4_history_nmlinfo, only: HstNmlInfoAssocGtHist
use gt4_history, only: HistoryPut, HistorySetTime
type(DC_DIFFTIME):: restart_interval_time
! リスタートデータの出力間隔.
! Interval of restart data output
continue
nullify( gthist )
gthstnml => gthstnml_restart
name = 'Temp'
!-----------------------------------------------------------------
! 出力ステップのチェック
! Check output step
!-----------------------------------------------------------------
call DCDiffTimeCreate( diff = restart_interval_time, value = real( restart_interval_value, DP ), unit = restart_interval_unit) ! (in)
if ( .not. mod( current_time + delta_time, restart_interval_time ) == 0 ) then
return
end if
call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = name, history = gthist ) ! (out)
!-----------------------------------------------------------------
! ステップ $ t $ の出力
! Output at step $ t $
!-----------------------------------------------------------------
call HistorySetTime( history = gthist, time = real( EvalbyUnit(current_time, restart_interval_unit) ) ) ! (in)
call HistoryPut( history = gthist, varname = 'U', array = xyz_UN ) ! (in)
call HistoryPut( history = gthist, varname = 'V', array = xyz_VN ) ! (in)
call HistoryPut( history = gthist, varname = 'Temp', array = xyz_TempN ) ! (in)
call HistoryPut( history = gthist, varname = 'QVap', array = xyz_QVapN ) ! (in)
call HistoryPut( history = gthist, varname = 'Ps', array = xy_PsN ) ! (in)
!-----------------------------------------------------------------
! ステップ $ t + \Delta t $ の出力
! Output at step $ t + \Delta t $
!-----------------------------------------------------------------
call HistorySetTime( history = gthist, time = real( EvalbyUnit(current_time + delta_time, restart_interval_unit) ) ) ! (in)
call HistoryPut( history = gthist, varname = 'U', array = xyz_UA ) ! (in)
call HistoryPut( history = gthist, varname = 'V', array = xyz_VA ) ! (in)
call HistoryPut( history = gthist, varname = 'Temp', array = xyz_TempA ) ! (in)
call HistoryPut( history = gthist, varname = 'QVap', array = xyz_QVapA ) ! (in)
call HistoryPut( history = gthist, varname = 'Ps', array = xy_PsA ) ! (in)
nullify( gthstnml )
nullify( gthist )
!-----------------------------------------------------------------
! ファイル出力に関してメッセージを表示
! Print message of file output
!-----------------------------------------------------------------
call MessageNotify( 'M', subname, 'Restart data => "%c" (time=%f, %f %a)', d=(/ EvalbyUnit(current_time, restart_interval_unit), EvalbyUnit(current_time + delta_time, restart_interval_unit) /), ca=StoA( trim(restart_interval_unit) ), c1=trim(restart_filename) )
end subroutine restart_output
| Subroutine : |
リスタートデータ出力の終了設定を行います.
Restart data output is terminated.
subroutine restart_output_close
!
! リスタートデータ出力の終了設定を行います.
!
! Restart data output is terminated.
!
use gt4_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoNames, HstNmlInfoAssocGtHist, HstNmlInfoPutLine
use gt4_history, only: HistoryInitialized, HistoryClose
use dc_string, only: Split
character(STRING):: varnames
! 変数名リスト.
! List of variables
character(TOKEN), pointer:: varnames_array(:) =>null()
! 変数名リスト配列.
! List of variables (array)
integer:: i, vnmax
continue
gthstnml => gthstnml_restart
varnames = HstNmlInfoNames( gthstnml )
call Split( str = varnames, sep = ',', carray = 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, name = name, history = gthist ) ! (out)
if ( HistoryInitialized( gthist ) ) then
call HistoryClose( history = gthist ) ! (inout)
nullify( gthist )
end if
end do
nullify( gthstnml )
end subroutine restart_output_close
| Subroutine : |
リスタートデータ出力の初期設定を行います.
Restart data output is initialized.
This procedure input/output NAMELIST#dcpam_hs94_restart_nml .
subroutine restart_output_init
!
! リスタートデータ出力の初期設定を行います.
!
! Restart data output is initialized.
!
use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit
use gt4_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, HstNmlInfoPutLine, HstNmlInfoEndDefine
use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryPut, HistoryAddAttr, HistoryInitialized
namelist /dcpam_hs94_restart_nml/ restart_interval_value, restart_interval_unit, restart_filename
! リスタートファイルへのデータ出力設定
!
! Configure the settings for restart data output
continue
!-----------------------------------------------------------------
! デフォルト値の設定
! Configure default values
!-----------------------------------------------------------------
allocate( gthstnml_restart )
gthstnml => gthstnml_restart
call HstNmlInfoCreate( gthstnml = gthstnml ) ! (out)
!-----------------------------------------------------------------
! NAMELIST の読み込み
! Load NAMELIST
!-----------------------------------------------------------------
if ( .not. trim(VAL_namelist) == '' ) then
call FileOpen( unit = unit_nml, file = VAL_namelist, mode = 'r' ) ! (in)
read( unit = unit_nml, nml = dcpam_hs94_restart_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_hs94_restart_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_hs94_restart_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_hs94_restart_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-----------------------------------------------------------------
! 出力する変数の登録
! Register variables that are output
!-----------------------------------------------------------------
call HstNmlInfoAdd( gthstnml = gthstnml, name = '', file = restart_filename, interval_value = restart_interval_value, interval_unit = restart_interval_unit, precision = 'double', average = .false., fileprefix = '' ) ! (in)
call HstNmlInfoAdd( gthstnml = gthstnml, name = 'U, V, Temp, QVap, Ps', file = restart_filename ) ! (in)
call HstNmlInfoEndDefine( gthstnml = gthstnml ) ! (inout)
!-----------------------------------------------------------------
! データ出力の初期設定
! Initialize data output
!-----------------------------------------------------------------
!-------------------------
! xyz_U の出力設定
! Configure the settings for "xyz_U" output
name = 'U'
longname = 'eastward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'eastward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_V の出力設定
! Configure the settings for "xyz_V" output
name = 'V'
longname = 'northward wind'
units = 'm s-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'northward_wind' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Temp の出力設定
! Configure the settings for "xyz_Temp" output
name = 'Temp'
longname = 'temperature'
units = 'K'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'air_temperature' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_QVap の出力設定
! Configure the settings for "xyz_QVap" output
name = 'QVap'
longname = 'specific humidity'
units = 'kg kg-1'
allocate( dims(4) )
dims = StoA( 'lon', 'lat', 'sig', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'specific_humidity' ) ! (in)
end if
deallocate( dims )
!-------------------------
! xyz_Ps の出力設定
! Configure the settings for "xyz_Ps" output
name = 'Ps'
longname = 'surface pressure'
units = 'Pa'
allocate( dims(3) )
dims = StoA( 'lon', 'lat', 'time' )
! 出力ファイルの初期設定.
! * gthist (gt4_history#GT_HISTORY) が設定される.
! Initialize output file.
! * "gthist" (gt4_history#GT_HISTORY) is configured.
call output_init ! これは内部サブルーチン. This is an internal subroutine
! 属性の付加などを行う場合には以下のようにする.
! Describe codes as follows in order to add attributes etc.
if ( associated( gthist ) ) then
call HistoryAddAttr( history = gthist, varname = name, attrname = 'standard_name', value = 'surface_air_pressure' ) ! (in)
end if
deallocate( dims )
nullify( gthstnml )
end subroutine restart_output_init