| Path: | main/dcpam_hs94.F90 |
| Last Update: | Wed Nov 26 10:49:07 +0900 2008 |
| Authors: | Yasuhiro MORIKAWA |
| Version: | $Id: dcpam_hs94.F90,v 1.5 2008-11-26 01:49:07 morikawa Exp $ |
| Tag Name: | $Name: dcpam5-20081129 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2008. All rights reserved. |
| License: | See COPYRIGHT |
| Main Program : |
Note that Japanese and English are described in parallel.
Held and Suarez (1994) ベンチマークテストを行ないます.
Held and Suarez (1994) benchmark test is performed.
program dcpam_hs94
!
! <b>Note that Japanese and English are described in parallel.</b>
!
! Held and Suarez (1994) ベンチマークテストを行ないます.
!
! Held and Suarez (1994) benchmark test is performed.
!
!== References
!
! * Held, I. M., Suarez, M. J., 1994:
! A proposal for the intercomparison of the dynamical cores of
! atmospheric general circuation models.
! <i>Bull. Am. Meteor. Soc.</i>, <b>75</b>, 1825--1830.
! モジュール引用 ; USE statements
!
! 力学過程 (スペクトル法, Arakawa and Suarez (1983))
! Dynamical process (Spectral method, Arakawa and Suarez (1983))
!
use dynamics_hspl_vas83, only: Dynamics
! Held and Suarez (1994) による強制と散逸
! Forcing and dissipation suggested by Held and Suarez (1994)
!
use held_suarez_1994, only: Hs94Forcing
! タイムフィルター (Asselin, 1972)
! Time filter (Asselin, 1972)
!
use timefilter_asselin1972, only: TimeFilter
! 時刻管理
! Time control
!
use timeset, only: TimesetProgress, TimeN, TimeA, EndTime, DelTime ! $ \Delta t $ [s]
! リスタートデータ入出力
! Restart data input/output
!
use restart_file_io, only: RestartFileOutPut
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut, HistoryAutoAllVarFix
! 日付および時刻の取り扱い
! Date and time handler
!
use dc_date, only: operator(==), operator(<), operator(>), operator(<=), operator(>=), operator(+), operator(-), operator(*), operator(/)
! 種別型パラメタ
! Kind type parameter
!
use dc_types, only: DP, STRING, TOKEN ! キーワード. Keywords.
! 宣言文 ; Declaration statements
!
implicit none
#ifdef LIB_MPI
! MPI ライブラリ
! MPI library
!
include 'mpif.h'
#endif
! 予報変数 (ステップ $ t-\Delta t $ , $ t $ , $ t+\Delta t $ )
! Prediction variables (Step $ t-\Delta t $ , $ t $ , $ t+\Delta t $ )
!
real(DP), allocatable:: xyz_UB (:,:,:)
! $ u (t-\Delta t) $ . 東西風速. Eastward wind
real(DP), allocatable:: xyz_VB (:,:,:)
! $ v (t-\Delta t) $ . 南北風速. Northward wind
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) $ . 東西風速. Eastward wind
real(DP), allocatable:: xyz_VN (:,:,:)
! $ v (t) $ . 南北風速. Northward wind
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) $ . 東西風速. Eastward wind
real(DP), allocatable:: xyz_VA (:,:,:)
! $ v (t+\Delta t) $ . 南北風速. Northward wind
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
! 診断変数
! Diagnostic variables
!
real(DP), allocatable:: xyz_DUDt (:,:,:)
! $ \DP{u}{t} $ . 東西風速変化.
! Eastward wind tendency
real(DP), allocatable:: xyz_DVDt (:,:,:)
! $ \DP{v}{t} $ . 南北風速変化.
! Northward wind tendency
real(DP), allocatable:: xyz_DTempDt (:,:,:)
! $ \DP{T}{t} $ . 温度変化.
! Temperature tendency
real(DP), allocatable:: xyz_DQVapDt (:,:,:)
! $ \DP{q}{t} $ . 比湿変化.
! Temperature tendency
! 作業変数
! Work variables
!
logical:: firstloop = .true.
! 初回のループであることを示すフラグ.
! Flag implying first loop
! 実行文 ; Executable statement
!
! 主プログラムの初期化 (内部サブルーチン)
! Initialization for the main program (Internal subroutine)
!
call MainInit
! 時間積分
! Time integration
!
do while ( TimeN <= EndTime )
! Held and Suarez (1994) による強制と散逸
! Forcing and dissipation suggested by Held and Suarez (1994)
!
call Hs94Forcing( xyz_UB, xyz_VB, xyz_TempB, xy_PsB, xyz_DUDt, xyz_DVDt, xyz_DTempDt ) ! (out)
xyz_DQVapDt = 0.0_DP
! 力学過程
! Dynamical core
!
call Dynamics( xyz_UB, xyz_VB, xyz_TempB, xyz_QVapB, xy_PsB, xyz_UN, xyz_VN, xyz_TempN, xyz_QVapN, xy_PsN, xyz_DUDt, xyz_DVDt, xyz_DTempDt, xyz_DQVapDt, xyz_UA, xyz_VA, xyz_TempA, xyz_QVapA, xy_PsA ) ! (out)
! 時間フィルター
! Time filter
!
if ( .not. firstloop ) then
call TimeFilter( xyz_UB, xyz_VB, xyz_TempB, xyz_QVapB, xy_PsB, xyz_UN, xyz_VN, xyz_TempN, xyz_QVapN, xy_PsN, xyz_UA, xyz_VA, xyz_TempA, xyz_QVapA, xy_PsA ) ! (in)
end if
! ヒストリデータ出力
! History data output
!
call HistoryAutoPut( TimeA, 'U', xyz_UA )
call HistoryAutoPut( TimeA, 'V', xyz_VA )
call HistoryAutoPut( TimeA, 'Temp', xyz_TempA )
call HistoryAutoPut( TimeA, 'QVap', xyz_QVapA )
call HistoryAutoPut( TimeA, 'Ps', xy_PsA )
! 予報変数の時刻付け替え
! 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
! 時刻の進行
! Progress time
!
call TimesetProgress
! NAMELIST から読み込んだ変数名に無効なものが存在したかどうかをチェック
! HistoryAutoAddVariable で登録した変数名を印字
!
! Check that invalid variable names are loaded from NAMELIST or not
! Print registered variable names by "HistoryAutoAddVariable"
!
if ( firstloop ) call HistoryAutoAllVarFix
! リスタートデータ出力
! Restart data output
!
call RestartFileOutput( xyz_UB, xyz_VB, xyz_TempB, xyz_QVapB, xy_PsB, xyz_UN, xyz_VN, xyz_TempN, xyz_QVapN, xy_PsN ) ! (in)
firstloop = .false.
! 時間積分終了
! Time integration is finished
!
end do
! 主プログラムの終了処理 (内部サブルーチン)
! Termination for the main program (Internal subroutine)
!
call MainTerminate
contains
!-------------------------------------------------------------------
subroutine MainInit
!
! 主プログラムの初期化手続き.
!
! Initialization procedure for the main program.
!
#ifdef LIB_MPI
! メッセージ出力
! Message output
!
use dc_message, only: MessageSuppressMPI
#endif
! コマンドライン引数処理
! Command line option parser
!
use option_parser, only: OptParseInit
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: NmlutilInit
! 時刻管理
! Time control
!
use timeset, only: TimesetInit, TimesetDelTimeHalf, TimeN ! ステップ $ t $ の時刻. Time of step $ t $.
! 出力ファイルの基本情報管理
! Management basic information for output files
!
use fileset, only: FilesetInit
! 格子点設定
! Grid points settings
!
use gridset, only: GridsetInit, imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 物理定数設定
! Physical constants settings
!
use constants, only: ConstantsInit
! 座標データ設定
! Axes data settings
!
use axesset, only: AxessetInit
! リスタートデータ入出力
! Restart data input/output
!
use restart_file_io, only: RestartFileOpen, RestartFileGet
! ヒストリデータ出力
! History data output
!
use history_file_io, only: HistoryFileOpen
use gtool_historyauto, only: HistoryAutoAddVariable, HistoryAutoPut
! 文字列操作
! Character handling
!
use dc_string, only: StoA
! 宣言文 ; Declaration statements
!
implicit none
logical:: flag_initial
! リスタートデータを読み込む場合には,
! .false. が, 初期値データを読み込む場合には
! .true. が設定されます
!
! If restart data is loaded, .false. is set.
! On the other hand, if initial data is loaded,
! .true. is set.
#ifdef LIB_MPI
integer :: myrank_mpi, nprocs_mpi, err_mpi
! MPI の初期化の際に使用される変数.
! Variables used for initialization of MPI.
#endif
! 実行文 ; Executable statement
!
#ifdef LIB_MPI
! MPI 初期化
! Initialization of MPI
!
CALL MPI_Init(err_mpi)
CALL MPI_Comm_Rank(mpi_comm_world, myrank_mpi, err_mpi)
CALL MPI_Comm_Size(mpi_comm_world, nprocs_mpi, err_mpi)
#endif
#ifdef LIB_MPI
! メッセージ出力
! Message output
!
call MessageSuppressMPI( rank = 0 )
#endif
! コマンドライン引数処理
! Command line option parser
!
call OptParseInit
! NAMELIST ファイル名入力
! Input NAMELIST file name
!
call NmlutilInit
! 時刻管理
! Time control
!
call TimesetInit
! 出力ファイルの基本情報管理
! Management basic information for output files
!
call FilesetInit
! 格子点設定
! Grid points settings
!
call GridsetInit
! 物理定数設定
! Physical constants settings
!
call ConstantsInit
! 座標データ設定
! Axes data settings
!
call AxessetInit
! 予報変数の割付
! Allocation of prediction variables
!
allocate( xyz_UB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_VB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_TempB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_QVapB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xy_PsB (0:imax-1, 1:jmax) )
allocate( xyz_UN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_VN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_TempN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_QVapN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xy_PsN (0:imax-1, 1:jmax) )
allocate( xyz_UA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_VA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_TempA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_QVapA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xy_PsA (0:imax-1, 1:jmax) )
! リスタートデータ入力
! Restart data input
!
call RestartFileGet( xyz_UB, xyz_VB, xyz_TempB, xyz_QVapB, xy_PsB, xyz_UN, xyz_VN, xyz_TempN, xyz_QVapN, xy_PsN, flag_initial ) ! (out) optional
! リスタートデータファイルの初期化
! Initialization of restart data file
!
call RestartFileOpen
! ヒストリデータファイルの初期化
! Initialization of history data files
!
call HistoryFileOpen
! ヒストリデータ出力のためのへの変数登録
! Register of variables for history data output
!
call HistoryAutoAddVariable( 'U' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'eastward wind', 'm s-1' )
call HistoryAutoAddVariable( 'V' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'northward wind', 'm s-1' )
call HistoryAutoAddVariable( 'Temp' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'temperature', 'K' )
call HistoryAutoAddVariable( 'QVap' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'specific humidity', 'kg kg-1' )
call HistoryAutoAddVariable( 'Ps' , (/ 'lon ', 'lat ', 'time' /), 'surface pressure', 'Pa' )
! ヒストリデータ出力 (スタート時刻)
! History data output (Start time)
!
call HistoryAutoPut( TimeN, 'U', xyz_UN )
call HistoryAutoPut( TimeN, 'V', xyz_VN )
call HistoryAutoPut( TimeN, 'Temp', xyz_TempN )
call HistoryAutoPut( TimeN, 'QVap', xyz_QVapN )
call HistoryAutoPut( TimeN, 'Ps', xy_PsN )
! 診断変数の割付
! Allocation of diagnostic variables
!
allocate( xyz_DUDt (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_DVDt (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_DTempDt (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_DQVapDt (0:imax-1, 1:jmax, 1:kmax) )
! 初回だけはオイラー法を用いるため, Δt を半分に
! Delta t is reduced to half in order to use Euler method at initial step
!
if ( flag_initial ) then
call TimesetDelTimeHalf
end if
end subroutine MainInit
!-------------------------------------------------------------------
subroutine MainTerminate
!
! 主プログラムの終了処理手続き.
!
! Termination procedure for the main program.
!
! 時刻管理
! Time control
!
use timeset, only: TimesetClose
! リスタートデータ入出力
! Restart data input/output
!
use restart_file_io, only: RestartFileClose
! ヒストリデータ出力
! History data output
!
use history_file_io, only: HistoryFileClose
! 宣言文 ; Declaration statements
!
implicit none
#ifdef LIB_MPI
integer :: err_mpi
! MPI の終了処理の際に使用される変数.
! Variable used for termination of MPI.
#endif
! 実行文 ; Executable statement
!
! リスタートデータファイルクローズ
! Close restart data file
!
call RestartFileClose
! ヒストリデータファイルクローズ
! Close history data files
!
call HistoryFileClose
! 時刻管理終了処理
! Termination of time control
!
call TimesetClose
#ifdef LIB_MPI
! MPI 終了処理
! Termination of MPI
!
call MPI_Finalize(err_mpi)
#endif
end subroutine MainTerminate
end program dcpam_hs94
| Subroutine : |
主プログラムの初期化手続き.
Initialization procedure for the main program.
subroutine MainInit
!
! 主プログラムの初期化手続き.
!
! Initialization procedure for the main program.
!
#ifdef LIB_MPI
! メッセージ出力
! Message output
!
use dc_message, only: MessageSuppressMPI
#endif
! コマンドライン引数処理
! Command line option parser
!
use option_parser, only: OptParseInit
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: NmlutilInit
! 時刻管理
! Time control
!
use timeset, only: TimesetInit, TimesetDelTimeHalf, TimeN ! ステップ $ t $ の時刻. Time of step $ t $.
! 出力ファイルの基本情報管理
! Management basic information for output files
!
use fileset, only: FilesetInit
! 格子点設定
! Grid points settings
!
use gridset, only: GridsetInit, imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 物理定数設定
! Physical constants settings
!
use constants, only: ConstantsInit
! 座標データ設定
! Axes data settings
!
use axesset, only: AxessetInit
! リスタートデータ入出力
! Restart data input/output
!
use restart_file_io, only: RestartFileOpen, RestartFileGet
! ヒストリデータ出力
! History data output
!
use history_file_io, only: HistoryFileOpen
use gtool_historyauto, only: HistoryAutoAddVariable, HistoryAutoPut
! 文字列操作
! Character handling
!
use dc_string, only: StoA
! 宣言文 ; Declaration statements
!
implicit none
logical:: flag_initial
! リスタートデータを読み込む場合には,
! .false. が, 初期値データを読み込む場合には
! .true. が設定されます
!
! If restart data is loaded, .false. is set.
! On the other hand, if initial data is loaded,
! .true. is set.
#ifdef LIB_MPI
integer :: myrank_mpi, nprocs_mpi, err_mpi
! MPI の初期化の際に使用される変数.
! Variables used for initialization of MPI.
#endif
! 実行文 ; Executable statement
!
#ifdef LIB_MPI
! MPI 初期化
! Initialization of MPI
!
CALL MPI_Init(err_mpi)
CALL MPI_Comm_Rank(mpi_comm_world, myrank_mpi, err_mpi)
CALL MPI_Comm_Size(mpi_comm_world, nprocs_mpi, err_mpi)
#endif
#ifdef LIB_MPI
! メッセージ出力
! Message output
!
call MessageSuppressMPI( rank = 0 )
#endif
! コマンドライン引数処理
! Command line option parser
!
call OptParseInit
! NAMELIST ファイル名入力
! Input NAMELIST file name
!
call NmlutilInit
! 時刻管理
! Time control
!
call TimesetInit
! 出力ファイルの基本情報管理
! Management basic information for output files
!
call FilesetInit
! 格子点設定
! Grid points settings
!
call GridsetInit
! 物理定数設定
! Physical constants settings
!
call ConstantsInit
! 座標データ設定
! Axes data settings
!
call AxessetInit
! 予報変数の割付
! Allocation of prediction variables
!
allocate( xyz_UB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_VB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_TempB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_QVapB (0:imax-1, 1:jmax, 1:kmax) )
allocate( xy_PsB (0:imax-1, 1:jmax) )
allocate( xyz_UN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_VN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_TempN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_QVapN (0:imax-1, 1:jmax, 1:kmax) )
allocate( xy_PsN (0:imax-1, 1:jmax) )
allocate( xyz_UA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_VA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_TempA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_QVapA (0:imax-1, 1:jmax, 1:kmax) )
allocate( xy_PsA (0:imax-1, 1:jmax) )
! リスタートデータ入力
! Restart data input
!
call RestartFileGet( xyz_UB, xyz_VB, xyz_TempB, xyz_QVapB, xy_PsB, xyz_UN, xyz_VN, xyz_TempN, xyz_QVapN, xy_PsN, flag_initial ) ! (out) optional
! リスタートデータファイルの初期化
! Initialization of restart data file
!
call RestartFileOpen
! ヒストリデータファイルの初期化
! Initialization of history data files
!
call HistoryFileOpen
! ヒストリデータ出力のためのへの変数登録
! Register of variables for history data output
!
call HistoryAutoAddVariable( 'U' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'eastward wind', 'm s-1' )
call HistoryAutoAddVariable( 'V' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'northward wind', 'm s-1' )
call HistoryAutoAddVariable( 'Temp' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'temperature', 'K' )
call HistoryAutoAddVariable( 'QVap' , (/ 'lon ', 'lat ', 'sig ', 'time' /), 'specific humidity', 'kg kg-1' )
call HistoryAutoAddVariable( 'Ps' , (/ 'lon ', 'lat ', 'time' /), 'surface pressure', 'Pa' )
! ヒストリデータ出力 (スタート時刻)
! History data output (Start time)
!
call HistoryAutoPut( TimeN, 'U', xyz_UN )
call HistoryAutoPut( TimeN, 'V', xyz_VN )
call HistoryAutoPut( TimeN, 'Temp', xyz_TempN )
call HistoryAutoPut( TimeN, 'QVap', xyz_QVapN )
call HistoryAutoPut( TimeN, 'Ps', xy_PsN )
! 診断変数の割付
! Allocation of diagnostic variables
!
allocate( xyz_DUDt (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_DVDt (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_DTempDt (0:imax-1, 1:jmax, 1:kmax) )
allocate( xyz_DQVapDt (0:imax-1, 1:jmax, 1:kmax) )
! 初回だけはオイラー法を用いるため, Δt を半分に
! Delta t is reduced to half in order to use Euler method at initial step
!
if ( flag_initial ) then
call TimesetDelTimeHalf
end if
end subroutine MainInit
| Subroutine : |
主プログラムの終了処理手続き.
Termination procedure for the main program.
subroutine MainTerminate
!
! 主プログラムの終了処理手続き.
!
! Termination procedure for the main program.
!
! 時刻管理
! Time control
!
use timeset, only: TimesetClose
! リスタートデータ入出力
! Restart data input/output
!
use restart_file_io, only: RestartFileClose
! ヒストリデータ出力
! History data output
!
use history_file_io, only: HistoryFileClose
! 宣言文 ; Declaration statements
!
implicit none
#ifdef LIB_MPI
integer :: err_mpi
! MPI の終了処理の際に使用される変数.
! Variable used for termination of MPI.
#endif
! 実行文 ; Executable statement
!
! リスタートデータファイルクローズ
! Close restart data file
!
call RestartFileClose
! ヒストリデータファイルクローズ
! Close history data files
!
call HistoryFileClose
! 時刻管理終了処理
! Termination of time control
!
call TimesetClose
#ifdef LIB_MPI
! MPI 終了処理
! Termination of MPI
!
call MPI_Finalize(err_mpi)
#endif
end subroutine MainTerminate