| Path: | main/dcpam_ape.f90 |
| Last Update: | Thu Sep 27 00:48:12 JST 2007 |
| Authors: | Yasuhiro MORIKAWA |
| Version: | $Id: dcpam_ape.f90,v 1.2 2007/09/26 15:48:12 morikawa Exp $ |
| Tag Name: | $Name: dcpam4-20071012 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2007. All rights reserved. |
| License: | See COPYRIGHT |
| Main Program : |
Note that Japanese and English are described in parallel.
dcpam のメインプログラムのサンプルです. 水惑星, すなわち全球が水に覆われているような惑星大気の計算を 行います.
This is sample main program of dcpam. Calculation of atmosphere on a planet covered with water globally is performed.
This procedure input/output NAMELIST#dcpam_ape_grid_nml, NAMELIST#dcpam_ape_initdata_nml, NAMELIST#dcpam_ape_geodata_nml, NAMELIST#dcpam_ape_time_nml, NAMELIST#dcpam_ape_history_nml, NAMELIST#dcpam_ape_history_file_nml, NAMELIST#dcpam_ape_restart_nml .
program dcpam_ape
!
! <b>Note that Japanese and English are described in parallel.</b>
!
! dcpam のメインプログラムのサンプルです.
! 水惑星, すなわち全球が水に覆われているような惑星大気の計算を
! 行います.
!
! This is sample main program of dcpam.
! Calculation of
! atmosphere on a planet covered with water globally is performed.
!
!---------------------------------------------------------
! 初期値生成
! Generate initial data
!---------------------------------------------------------
use initial_data, only: INIDAT, Create, GetAxes, GetData, Close, PutLine
!---------------------------------------------------------
! 力学過程
! Dynamical core
!---------------------------------------------------------
use dyn_spectral_as83, only: DYNSPAS83, Create, Close, EqualAxes, GetAxes, Dynamics, VorDiv2UV, UV2VorDiv
!---------------------------------------------------------
! 物理過程
! Physical processes
!---------------------------------------------------------
!-------------------------------------
! 水惑星実験
! Aqua planet experiment
use phy_ape, only: PHYAPE, Create, Close, PhysicsAPE
!---------------------------------------------------------
! GCM 用ユーティリティ
! Utilities for GCM
!---------------------------------------------------------
!-------------------------------------
! 物理定数
! Physical constants
use constants, only: CONST, Create, Get, PutLine
!-------------------------------------
! タイムフィルター
! Time filter
use timefilter, only: TFILTER, Create, Filter, Progress
!---------------------------------------------------------
! データ I/O
! Data I/O
!---------------------------------------------------------
use gt4_history, only: GT_HISTORY, HistoryGet, HistoryCopy, HistoryCreate, HistoryAddVariable, HistoryPut, HistoryClose, HistoryAddAttr, HistorySetTime
!---------------------------------------------------------
! 汎用ユーティリティ
! Common utilities
!---------------------------------------------------------
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_args, only: ARGS, Open, HelpMsg, Option, Debug, Help, Strict, Close
use dc_trace, only: DbgMessage, BeginSub, EndSub
use dc_message,only: MessageNotify
use dc_string, only: toChar, Printf, StoA
use dc_date, only: Create, EvalSec, EvalByUnit, mod, operator(*), operator(==), operator(<), operator(/), operator(+), operator(-)
use dc_date_types, only: DC_DIFFTIME
use dc_clock, only: CLOCK, Create, Close, Start, Stop, Result, Predict, operator(+)
use dc_iounit, only: FileOpen
implicit none
!-------------------------------------------------------------------
! 実験の表題, モデルの名称, 所属機関名
! Title of a experiment, name of model, sub-organ
!-------------------------------------------------------------------
character(*), parameter:: title = 'dcpam_ape $Name: dcpam4-20071012 $ :: ' // 'DCPAM sample program: aqua planet experiment'
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 = 16 ! 鉛直層数.
! Number of vertical level
namelist /dcpam_ape_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):: EpsVT ! $ 1/\epsilon_v - 1 $ .
integer:: VisOrder ! 超粘性の次数. Order of hyper-viscosity
real(DP):: EFoldTime ! 最大波数に対する e-folding time. E-folding time for maximum wavenumber
real(DP):: EL ! $ L $ . 水の凝結の潜熱. Latent heat of condensation of water vapor
real(DP):: RVap ! $ R_v $ . 水蒸気気体定数. Gas constant of water vapor
real(DP):: EpsV ! $ \epsilon_v $ . 水蒸気分子量比. Molecular weight of water vapor
real(DP):: ES0 ! $ e^{*} $ (273K) . 0 ℃での飽和蒸気圧. Saturated vapor pressure at 0 degrees C
real(DP):: StB ! $ \sigma_{SB} $ . ステファンボルツマン定数. Stefan-Boltzmann constant
real(DP):: FKarm ! $ k $ . カルマン定数. Karman constant
!---------------------------------------------------------
! 初期値データ (リスタートデータ)
! Initial data (Restart data)
!---------------------------------------------------------
logical:: initial_data_prepared = .false.
! 初期値データ (リスタートデータ)
! ファイルの有無.
! Presence or absence of
! initial data (restart data) file.
character(STRING):: init_nc = 'dcpam_ape_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_ape_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
namelist /dcpam_ape_geodata_nml/ geography_data_prepared, geo_nc
! 地形データの設定.
!
! 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 = 'minute'
! 開始時刻の単位. 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 = 'minute'
! タイムステップの単位. 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_ape_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
!---------------------------------------------------------
type(DC_DIFFTIME):: history_interval_time
! ヒストリデータの出力間隔.
! Interval of history data output
real(DP):: history_interval_value = 0.125_DP
! ヒストリデータの出力間隔の数値.
! 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
namelist /dcpam_ape_history_nml/ history_interval_value, history_interval_unit, history_precision
! ヒストリファイルへのデータ出力設定
!
! Configure the settings for history data output
character(STRING):: xyz_U_filename = 'U.nc'
! xyz_U の出力ファイル名.
! Filename of "xyz_U"
character(STRING):: xyz_V_filename = 'V.nc'
! xyz_V の出力ファイル名.
! Filename of "xyz_V"
character(STRING):: xyz_Vor_filename = 'Vor.nc'
! xyz_Vor の出力ファイル名.
! Filename of "xyz_Vor"
character(STRING):: xyz_Div_filename = 'Div.nc'
! xyz_Div の出力ファイル名.
! Filename of "xyz_Div"
character(STRING):: xyz_Temp_filename = 'Temp.nc'
! xyz_Temp の出力ファイル名.
! Filename of "xyz_Temp"
character(STRING):: xy_Ps_filename = 'Ps.nc'
! xy_Ps の出力ファイル名.
! Filename of "xy_Ps"
character(STRING):: xyz_QVap_filename = 'QVap.nc'
! xyz_QVap の出力ファイル名.
! Filename of "xyz_QVap"
namelist /dcpam_ape_history_file_nml/ xyz_U_filename, xyz_V_filename, xyz_Vor_filename, xyz_Div_filename, xyz_Temp_filename, xy_Ps_filename, xyz_QVap_filename
! ヒストリファイルの名称設定
!
! Configure names of history files
!---------------------------------------------------------
! リスタートファイルへのデータ出力設定
! Configure the settings for restart data output
!---------------------------------------------------------
type(DC_DIFFTIME):: restart_interval_time
! リスタートデータの出力間隔.
! Interval of restart data output
real(DP):: restart_interval_value = 1440.0_DP
! リスタートデータの出力間隔の数値.
! Numerical value of interval of restart data output
character(TOKEN):: restart_interval_unit = 'minute'
! リスタートデータの出力間隔の単位.
! Unit for interval of restart data output
character(STRING):: restart_filename = 'dcpam_ape_restart.nc'
! リスタートデータのファイル名
! filename of restart data
namelist /dcpam_ape_restart_nml/ restart_interval_value, restart_interval_unit, restart_filename
! リスタートファイルへのデータ出力設定
!
! Configure the settings for restart data output
!---------------------------------------------------------
! 配列の定義
! 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_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
!-------------------------------------
! 地形データ (地表 $ \Phi $ ) 変数
! Geography data (surface $ \Phi $ ) variables
real(DP), allocatable:: xy_Phis (:,:)
! $ \Phi_s $ . 地表ジオポテンシャル.
! Surface geo-potential
!---------------------------------------------------------
! 作業変数
! Work variables
!---------------------------------------------------------
type(ARGS):: arg ! コマンドライン引数.
! Command line arguments
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(PHYAPE):: phy_apexp ! 物理過程 (水惑星実験)
! Physical process (Aqua planet experiment)
type(TFILTER):: tfilt ! タイムフィルター.
! Time filter
type(CLOCK):: clk_setup, clk_histget, clk_histput, clk_dyn, clk_phy, clk_tfilt
! CPU 時間モニター.
! CPU time monitor
type(GT_HISTORY):: gthist_xyz_U, gthist_xyz_V, gthist_xyz_Vor, gthist_xyz_Div, gthist_xyz_Temp, gthist_xyz_QVap, gthist_xy_Ps, gthist_restart
! ヒストリデータ, リスタートデータ出力.
! Output of history data and restart data
logical:: wa_module_initialized = .false.
! wa_module (SPMODEL ライブラリ) 初期化フラグ.
! "wa_module" (SPMODEL library)
! initialization flag.
character(*), parameter:: version = '$Name: dcpam4-20071012 $' // '$Id: dcpam_ape.f90,v 1.2 2007/09/26 15:48:12 morikawa Exp $'
character(*), parameter:: subname = 'dcpam_ape'
continue
!---------------------------------------------------------
! コマンドライン引数の処理
! Command line arguments handling
!---------------------------------------------------------
call Open( arg )
call HelpMsg( arg, 'Title', title )
call HelpMsg( arg, 'Usage', './dcpam_ape [Options]' )
call HelpMsg( arg, 'Description', 'This program runs aqua planet experiment calculation. ' // '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_ape_***.nml .' )
call HelpMsg( arg, 'Details about time', '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 HelpMsg( arg, 'Details about an initial data file', 'By default, no initial data file is needed. ' // 'Initial data is generated internally.' )
call HelpMsg( arg, 'Details about output files', 'By default, a restart file is "' // trim(restart_filename) // '", ' // 'history files are ' // '"' // trim(xyz_U_filename) // '", ' // '"' // trim(xyz_V_filename) // '", ' // '"' // trim(xyz_Vor_filename) // '", ' // '"' // trim(xyz_Div_filename) // '", ' // '"' // trim(xyz_Temp_filename) // '", ' // '"' // trim(xy_Ps_filename) // '", ' // '"' // trim(xyz_QVap_filename) // '".' )
call HelpMsg( arg, 'Source', source )
call HelpMsg( arg, 'Institution', institution )
call Option( arg, StoA('-N', '--namelist'), OPT_namelist, VAL_namelist, help="NAMELIST filename" )
call Debug( arg )
call Help( arg )
call Strict( arg, severe = .true. )
call Close( arg )
call BeginSub( subname, version=version )
!-------------------------------------------------------------------
! CPU 時間モニターの初期設定
! Configure the settings for CPU time monitor
!-------------------------------------------------------------------
call Create( clk_setup, 'Setup') ! (in)
call Create( clk_histget, 'HistoryGet') ! (in)
call Create( clk_histput, 'HistoryPut') ! (in)
call Create( clk_dyn, 'Dynamics') ! (in)
call Create( clk_phy, 'Phyisics') ! (in)
call Create( clk_tfilt, 'TimeFilter') ! (in)
!-------------------------------------------------------------------
! 格子点数・最大全波数の設定
! Configure the grid points and maximum truncated wavenumber
!-------------------------------------------------------------------
call Start(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_ape_grid_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_ape_grid_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_ape_grid_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_ape_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_ape_time_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_ape_time_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_ape_time_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_ape_time_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-------------------------
! DC_DIFFTIME 型変数の設定
! Configure DC_DIFFTIME type variables
call Create( current_time, start_time_value, start_time_unit) ! (in)
call Create( start_time, start_time_value, start_time_unit) ! (in)
call Create( delta_time, delta_time_value, delta_time_unit) ! (in)
call Create( total_time, total_time_value, total_time_unit) ! (in)
call Create( predict_show_interval_time, predict_show_interval_value, 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_ape_geodata_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_ape_geodata_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_ape_geodata_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_ape_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( geo_nc, 'Phis', xy_Phis ) ! (out)
else
xy_Phis = 0.0_DP
end if
!-------------------------------------------------------------------
! 物理定数の設定
! Configure the physical constants
!-------------------------------------------------------------------
call Create( constant = const_earth, VisOrder = 8, EFoldTime = 8640.0_DP, nmlfile = VAL_namelist ) ! (in)
call PutLine( constant = const_earth ) ! (in)
call Get( constant = const_earth, PI = PI, RPlanet = RPlanet, Grav = Grav, Omega = Omega, Cp = Cp, RAir = RAir, EpsVT = EpsVT, VisOrder = VisOrder, EFoldTime = EFoldTime, EL = EL, RVap = RVap, EpsV = EpsV, ES0 = ES0, StB = StB, FKarm = FKarm ) ! (out)
!-------------------------------------------------------------------
! タイムフィルターの設定
! Configure the settings for time filter
!-------------------------------------------------------------------
call Create( tfilt, filter_param = 0.05_DP, int_time = delta_time, cur_time = current_time, nmlfile = VAL_namelist ) ! (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_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) )
call Stop(clk_setup) ! (inout)
!-------------------------------------------------------------------
! 軸データおよび初期値データの取得もしくは生成
! Get or generate axes data and initial data
!-------------------------------------------------------------------
call Start(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_ape_initdata_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_ape_initdata_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_ape_initdata_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_ape_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 = 'Vor', array = xyz_VorB, range = init_nc_rangeB ) ! (in)
call HistoryGet( file = init_nc, varname = 'Vor', array = xyz_VorN, range = init_nc_rangeN ) ! (in)
call HistoryGet( file = init_nc, varname = 'Div', array = xyz_DivB, range = init_nc_rangeB ) ! (in)
call HistoryGet( file = init_nc, varname = 'Div', array = xyz_DivN, 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 Create( ini_dat = ini_dat, nmax = nmax, imax = imax, jmax = jmax, kmax = kmax, Cp = Cp, RAir = RAir, nmlfile = VAL_namelist ) ! (in)
wa_module_initialized = .true.
call GetAxes( 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 GetData( ini_dat = ini_dat, xyz_Vor = xyz_VorB, xyz_Div = xyz_DivB, xyz_Temp = xyz_TempB, xyz_QVap = xyz_QVapB, xy_Ps = xy_PsB ) ! (out)
call GetData( ini_dat = ini_dat, xyz_Vor = xyz_VorN, xyz_Div = xyz_DivN, xyz_Temp = xyz_TempN, xyz_QVap = xyz_QVapN, xy_Ps = xy_PsN ) ! (out)
call Close( ini_dat ) ! (inout)
end if
call Stop(clk_histget) ! (inout)
!-------------------------------------------------------------------
! 力学過程の設定
! Configure the settings for dynamical core
!-------------------------------------------------------------------
call Start(clk_setup) ! (inout)
!-------------------------
! dyn_spectral_as83 の設定
! Configure 'dyn_spectral_as83'
call Create( dyn_sp_as = dyn, nmax = nmax, imax = imax, jmax = jmax, kmax = kmax, PI = PI, RPlanet = RPlanet, Omega = Omega, Cp = Cp, RAir = RAir, EpsVT = EpsVT, VisOrder = VisOrder, EFoldTime = EFoldTime, DelTime = EvalSec(delta_time), xy_Phis = xy_Phis, openmp_threads = openmp_threads, wa_module_initialized = wa_module_initialized, nmlfile = VAL_namelist ) ! (in)
call EqualAxes( 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
!---------------------------------------------------------
!-------------------------------------
! 水惑星実験
! Aqua planet experiment
call Create( phy_ape = phy_apexp, imax = imax, jmax = jmax, kmax = kmax, x_Lon = x_Lon, y_Lat = y_Lat, z_Sigma = z_Sigma, r_Sigma = r_Sigma, PI = PI, RAir = RAir, Grav = Grav, Cp = Cp, EL = EL, RVap = RVap, EpsV = EpsV, ES0 = ES0, StB = StB, FKarm = FKarm, DelTime = EvalSec(delta_time), x_Lon_Weight = x_Lon_Weight, y_Lat_Weight = y_Lat_Weight, current_time_value = start_time_value, current_time_unit = start_time_unit, nmlfile = VAL_namelist ) ! (in)
call Stop(clk_setup) ! (inout)
!----------------------------------------------------------------
! ヒストリファイルへのデータ出力設定
! Configure the settings for history data output
!----------------------------------------------------------------
call Start(clk_histput) ! (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_ape_history_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_ape_history_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_ape_history_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_ape_history_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
if ( .not. trim(VAL_namelist) == '' ) then
call FileOpen( unit = unit_nml, file = VAL_namelist, mode = 'r' ) ! (in)
read( unit = unit_nml, nml = dcpam_ape_history_file_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_ape_history_file_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_ape_history_file_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_ape_history_file_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-------------------------
! DC_DIFFTIME 型変数の設定
! Configure DC_DIFFTIME type variables
call Create( history_interval_time, history_interval_value, history_interval_unit) ! (in)
!-------------------------
! 渦度と発散から東西風速と南北風速を計算 (ステップ $ t $ )
! Calculate zonal and meridional wind from vorticity and divergence
! at step $ t $
call VorDiv2UV( dyn_sp_as = dyn, xyz_Vor = xyz_VorN, xyz_Div = xyz_DivN, xyz_U = xyz_UN, xyz_V = xyz_VN ) ! (out)
!-------------------------
! xyz_U の出力設定とステップ $ t $ のデータ出力
! Configure the settings for "xyz_U" output, and output data at $ t $
call HistoryCreate( history = gthist_xyz_U, file = xyz_U_filename, 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', history_interval_unit), origin = real(EvalbyUnit(current_time, history_interval_unit)), interval = real(EvalbyUnit(history_interval_time, history_interval_unit)) ) ! (in)
call HistoryPut( history = gthist_xyz_U, varname = 'lon', array = x_Lon / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist_xyz_U, varname = 'lat', array = y_Lat / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist_xyz_U, varname = 'sig', array = z_Sigma ) ! (in)
call HistoryPut( history = gthist_xyz_U, varname = 'sigm', array = r_Sigma ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'lon', attrname = 'standard_name', value = 'longitude' ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'lat', attrname = 'standard_name', value = 'latitude' ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'sig', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'sigm', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'time', attrname = 'standard_name', value = 'time' ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'sig', attrname = 'positive', value = 'down' ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'sigm', attrname = 'positive', value = 'down' ) ! (in)
call HistoryAddVariable( history = gthist_xyz_U, varname = 'U', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'eastward wind', units = 'm s-1', xtype = history_precision ) ! (in)
call HistoryAddAttr( history = gthist_xyz_U, varname = 'U', attrname = 'standard_name', value = 'eastward_wind' ) ! (in)
call HistoryPut( history = gthist_xyz_U, varname = 'U', array = xyz_UN ) ! (in)
!-------------------------
! xyz_V の出力設定とステップ $ t $ のデータ出力
! Configure the settings for "xyz_V" output, and output data at $ t $
call HistoryCopy( hist_dest = gthist_xyz_V, file = xyz_V_filename, hist_src = gthist_xyz_U) ! (in)
call HistoryAddVariable( history = gthist_xyz_V, varname = 'V', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'northward wind', units = 'm s-1', xtype = history_precision ) ! (in)
call HistoryAddAttr( history = gthist_xyz_V, varname = 'V', attrname = 'standard_name', value = 'northward_wind' ) ! (in)
call HistoryPut( history = gthist_xyz_V, varname = 'V', array = xyz_VN ) ! (in)
!-------------------------
! xyz_Vor の出力設定とステップ $ t $ のデータ出力
! Configure the settings for "xyz_Vor" output, and output data at $ t $
call HistoryCopy( hist_dest = gthist_xyz_Vor, file = xyz_Vor_filename, hist_src = gthist_xyz_U) ! (in)
call HistoryAddVariable( history = gthist_xyz_Vor, varname = 'Vor', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'vorticity', units = 's-1', xtype = history_precision ) ! (in)
call HistoryAddAttr( history = gthist_xyz_Vor, varname = 'Vor', attrname = 'standard_name', value = 'atmosphere_relative_vorticity' ) ! (in)
call HistoryPut( history = gthist_xyz_Vor, varname = 'Vor', array = xyz_VorN ) ! (in)
!-------------------------
! xyz_Div の出力設定とステップ $ t $ のデータ出力
! Configure the settings for "xyz_Div" output, and output data at $ t $
call HistoryCopy( hist_dest = gthist_xyz_Div, file = xyz_Div_filename, hist_src = gthist_xyz_U) ! (in)
call HistoryAddVariable( history = gthist_xyz_Div, varname = 'Div', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'divergence', units = 's-1', xtype = history_precision ) ! (in)
call HistoryAddAttr( history = gthist_xyz_Div, varname = 'Div', attrname = 'standard_name', value = 'divergence_of_wind' ) ! (in)
call HistoryPut( history = gthist_xyz_Div, varname = 'Div', array = xyz_DivN ) ! (in)
!-------------------------
! xyz_Temp の出力設定とステップ $ t $ のデータ出力
! Configure the settings for "xyz_Temp" output, and output data at $ t $
call HistoryCopy( hist_dest = gthist_xyz_Temp, file = xyz_Temp_filename, hist_src = gthist_xyz_U) ! (in)
call HistoryAddVariable( history = gthist_xyz_Temp, varname = 'Temp', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'temperature', units = 'K', xtype = history_precision ) ! (in)
call HistoryAddAttr( history = gthist_xyz_Temp, varname = 'Temp', attrname = 'standard_name', value = 'air_temperature' ) ! (in)
call HistoryPut( history = gthist_xyz_Temp, varname = 'Temp', array = xyz_TempN ) ! (in)
!-------------------------
! xyz_QVap の出力設定とステップ $ t $ のデータ出力
! Configure the settings for "xyz_QVap" output, and output data at $ t $
call HistoryCopy( hist_dest = gthist_xyz_QVap, file = xyz_QVap_filename, hist_src = gthist_xyz_U) ! (in)
call HistoryAddVariable( history = gthist_xyz_QVap, varname = 'QVap', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'specific humidity', units = '1', xtype = history_precision ) ! (in)
call HistoryAddAttr( history = gthist_xyz_QVap, varname = 'QVap', attrname = 'standard_name', value = 'specific_humidity' ) ! (in)
call HistoryPut( history = gthist_xyz_QVap, varname = 'QVap', array = xyz_QVapN ) ! (in)
!-------------------------
! xy_Ps の出力設定とステップ $ t $ のデータ出力
! Configure the settings for "xy_Ps" output, and output data at $ t $
call HistoryCopy( hist_dest = gthist_xy_Ps, file = xy_Ps_filename, hist_src = gthist_xyz_U) ! (in)
call HistoryAddVariable( history = gthist_xy_Ps, varname = 'Ps', dims = StoA('lon', 'lat', 'time'), longname = 'surface pressure', units = 'Pa', xtype = history_precision ) ! (in)
call HistoryAddAttr( history = gthist_xy_Ps, varname = 'Ps', attrname = 'standard_name', value = 'surface_air_pressure' ) ! (in)
call HistoryPut( history = gthist_xy_Ps, varname = 'Ps', array = xy_PsN ) ! (in)
!-------------------------
! ファイル出力に関してメッセージを表示
! Print message of file output
call MessageNotify( 'M', subname, 'History files are created.' )
!----------------------------------------------------------------
! リスタートファイルへのデータ出力設定
! Configure the settings for restart data output
!----------------------------------------------------------------
!-------------------------
! 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_ape_restart_nml, iostat = iostat_nml ) ! (out)
if ( iostat_nml == 0 ) then
call MessageNotify( 'M', subname, 'NAMELIST group "%c" is loaded from "%c".', c1='dcpam_ape_restart_nml', c2=trim(VAL_namelist) )
write(STDOUT, nml = dcpam_ape_restart_nml)
else
call MessageNotify( 'W', subname, 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', c1='dcpam_ape_restart_nml', c2=trim(VAL_namelist), i=(/iostat_nml/) )
end if
close( unit_nml )
end if
!-------------------------
! DC_DIFFTIME 型変数の設定
! Configure DC_DIFFTIME type variables
call Create( restart_interval_time, restart_interval_value, restart_interval_unit) ! (in)
call HistoryCreate( history = gthist_restart, file = restart_filename, 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', restart_interval_unit), origin = real(EvalbyUnit(current_time, restart_interval_unit)), interval = real(EvalbyUnit(restart_interval_time, restart_interval_unit)) ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'lon', array = x_Lon / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'lat', array = y_Lat / PI * 180.0_DP ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'sig', array = z_Sigma ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'sigm', array = r_Sigma ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'lon', attrname = 'standard_name', value = 'longitude' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'lat', attrname = 'standard_name', value = 'latitude' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'sig', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'sigm', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'time', attrname = 'standard_name', value = 'time' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'sig', attrname = 'positive', value = 'down' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'sigm', attrname = 'positive', value = 'down' ) ! (in)
call HistoryAddVariable( history = gthist_restart, varname = 'lon_weight', dims = StoA('lon'), longname = 'weight for integration in longitude', units = 'radian', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'lon', attrname = 'gt_calc_weight', value = 'lon_weight' ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'lon_weight', array = x_Lon_Weight ) ! (in)
call HistoryAddVariable( history = gthist_restart, varname = 'lat_weight', dims = StoA('lat'), longname = 'weight for integration in latitude', units = 'radian', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'lat', attrname = 'gt_calc_weight', value = 'lat_weight' ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'lat_weight', array = y_Lat_Weight ) ! (in)
call HistoryAddVariable( history = gthist_restart, varname = 'Vor', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'vorticity', units = 's-1', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'Vor', attrname = 'standard_name', value = 'atmosphere_relative_vorticity' ) ! (in)
call HistoryAddVariable( history = gthist_restart, varname = 'Div', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'divergence', units = 's-1', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'Div', attrname = 'standard_name', value = 'divergence_of_wind' ) ! (in)
call HistoryAddVariable( history = gthist_restart, varname = 'Temp', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'temperature', units = 'K', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'Temp', attrname = 'standard_name', value = 'air_temperature' ) ! (in)
call HistoryAddVariable( history = gthist_restart, varname = 'QVap', dims = StoA('lon', 'lat', 'sig', 'time'), longname = 'specific humidity', units = '1', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'QVap', attrname = 'standard_name', value = 'specific_humidity' ) ! (in)
call HistoryAddVariable( history = gthist_restart, varname = 'Ps', dims = StoA('lon', 'lat', 'time'), longname = 'surface pressure', units = 'Pa', xtype = 'double' ) ! (in)
call HistoryAddAttr( history = gthist_restart, varname = 'Ps', attrname = 'standard_name', value = 'surface_air_pressure' ) ! (in)
!-------------------------
! ファイル出力に関してメッセージを表示
! Print message of file output
call MessageNotify( 'M', subname, 'Restart file "%c" is created.', c1=trim(restart_filename) )
call Stop(clk_histput) ! (inout)
MainLoop : do while (current_time < total_time)
!----------------------------------------------------------------
! 力学過程演算
! Dynamical core
!----------------------------------------------------------------
call Start(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_VorA = xyz_VorA, xyz_DivA = xyz_DivA, xyz_TempA = xyz_TempA, xyz_QVapA = xyz_QVapA, xy_PsA = xy_PsA ) ! (out)
call Stop(clk_dyn) ! (inout)
!----------------------------------------------------------------
! 物理過程
! Physical processes
!----------------------------------------------------------------
!-------------------------------------
! 水惑星実験
! Aqua planet experiment
call Start(clk_phy) ! (inout)
call VorDiv2UV( dyn_sp_as = dyn, xyz_Vor = xyz_VorA, xyz_Div = xyz_DivA, xyz_U = xyz_UA, xyz_V = xyz_VA ) ! (out)
call PhysicsAPE( phy_ape = phy_apexp, xyz_U = xyz_UA, xyz_V = xyz_VA, xyz_Temp = xyz_TempA, xy_Ps = xy_PsA, xyz_QVap = xyz_QVapA ) ! (inout)
call UV2VorDiv( dyn_sp_as = dyn, xyz_U = xyz_UA, xyz_V = xyz_VA, xyz_Vor = xyz_VorA, xyz_Div = xyz_DivA ) ! (out)
call Stop(clk_phy) ! (inout)
!----------------------------------------------------------------
! タイムフィルター
! Time filter
!----------------------------------------------------------------
call Start(clk_tfilt) ! (inout)
call Filter( tfilt, xyz_VorB, xyz_VorN, xyz_VorA) ! (in)
call Filter( tfilt, xyz_DivB, xyz_DivN, xyz_DivA) ! (in)
call Filter( tfilt, xyz_TempB, xyz_TempN, xyz_TempA) ! (in)
call Filter( tfilt, xyz_QVapB, xyz_QVapN, xyz_QVapA) ! (in)
call Filter( tfilt, xy_PsB, xy_PsN, xy_PsA) ! (in)
call Progress( tfilt, time=delta_time) ! (in)
call Stop(clk_tfilt) ! (inout)
!----------------------------------------------------------------
! ヒストリファイルへのデータ出力
! History data output
!----------------------------------------------------------------
call Start(clk_histput) ! (inout)
if ( mod(current_time + delta_time, history_interval_time) == 0 ) then
call HistoryPut( history = gthist_xyz_Vor, varname = 'Vor', array = xyz_VorA ) ! (in)
call HistoryPut( history = gthist_xyz_Div, varname = 'Div', array = xyz_DivA ) ! (in)
call HistoryPut( history = gthist_xyz_Temp, varname = 'Temp', array = xyz_TempA ) ! (in)
call HistoryPut( history = gthist_xyz_QVap, varname = 'QVap', array = xyz_QVapA ) ! (in)
call HistoryPut( history = gthist_xy_Ps, varname = 'Ps', array = xy_PsA ) ! (in)
call VorDiv2UV( dyn_sp_as = dyn, xyz_Vor = xyz_VorA, xyz_Div = xyz_DivA, xyz_U = xyz_UA, xyz_V = xyz_VA ) ! (out)
call HistoryPut( history = gthist_xyz_U, varname = 'U', array = xyz_UA ) ! (in)
call HistoryPut( history = gthist_xyz_V, varname = 'V', array = xyz_VA ) ! (in)
!---------------------------------
! ファイル出力に関してメッセージを表示
! Print message of file output
call MessageNotify( 'M', subname, 'History data (time=%f %c) is output.', d=(/EvalbyUnit(current_time + delta_time, history_interval_unit)/), c1=trim(history_interval_unit) )
end if
!----------------------------------------------------------------
! リスタートファイルへのデータ出力
! Restart data output
!----------------------------------------------------------------
if ( mod(current_time + delta_time, restart_interval_time) == 0 ) then
!---------------------------------
! ステップ $ t $ のデータの出力
! Output data on step $ t $
call HistorySetTime( history = gthist_restart, time = real( EvalbyUnit(current_time, restart_interval_unit) ) ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Vor', array = xyz_VorN ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Div', array = xyz_DivN ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Temp', array = xyz_TempN ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'QVap', array = xyz_QVapN ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Ps', array = xy_PsN ) ! (in)
!---------------------------------
! ステップ $ t + \Delta t $ のデータの出力
! Output data on step $ t \Delta t $
call HistorySetTime( history = gthist_restart, time = real( EvalbyUnit(current_time + delta_time, restart_interval_unit) ) ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Vor', array = xyz_VorA ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Div', array = xyz_DivA ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Temp', array = xyz_TempA ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'QVap', array = xyz_QVapA ) ! (in)
call HistoryPut( history = gthist_restart, varname = 'Ps', array = xy_PsA ) ! (in)
!---------------------------------
! ファイル出力に関してメッセージを表示
! Print message of file output
call MessageNotify( 'M', subname, 'Restart data (time=%f %a - %f %a, and %f %a) is output to "%c"', d=(/ EvalbyUnit(current_time + delta_time, restart_interval_unit), delta_time_value, EvalbyUnit(current_time + delta_time, restart_interval_unit) /), ca=StoA( trim(restart_interval_unit), trim(delta_time_unit), trim(restart_interval_unit) ), c1=trim(restart_filename) )
end if
call Stop(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 Predict( clk = clk_setup + clk_histget + clk_histput + clk_dyn + clk_phy + clk_tfilt, progress = real( ( current_time + delta_time - start_time ) / total_time ) ) ! (in)
end if
!----------------------------------------------------------------
! 予測変数の時刻付け替え
! Exchange time of prediction variables
!----------------------------------------------------------------
xyz_VorB = xyz_VorN
xyz_VorN = xyz_VorA
xyz_VorA = 0.0_DP
xyz_DivB = xyz_DivN
xyz_DivN = xyz_DivA
xyz_DivA = 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 HistoryClose( history = gthist_xyz_U ) ! (inout)
call HistoryClose( history = gthist_xyz_V ) ! (inout)
call HistoryClose( history = gthist_xyz_Vor ) ! (inout)
call HistoryClose( history = gthist_xyz_Div ) ! (inout)
call HistoryClose( history = gthist_xyz_Temp ) ! (inout)
call HistoryClose( history = gthist_xyz_QVap ) ! (inout)
call HistoryClose( history = gthist_xy_Ps ) ! (inout)
!----------------------------------------------------------------
! リスタートファイルへのデータ出力の終了処理
! Terminate restart data output
!----------------------------------------------------------------
call HistoryClose( history = gthist_restart ) ! (inout)
!----------------------------------------------------------------
! CPU 時間の総計を表示
! Print total CPU time
!----------------------------------------------------------------
call Result( clks = (/clk_setup, clk_histget, clk_histput, clk_dyn, clk_phy, clk_tfilt/), total_auto = .true.) ! (in)
call EndSub( subname )
end program dcpam_ape