!= cumulus_adjust モジュールのテストプログラム ! != Test program for "cumulus_adjust" ! ! Authors:: Yasuhiro MORIKAWA ! Version:: $Id: cumulus_adjust_test01.f90,v 1.3 2008-09-23 18:00:34 morikawa Exp $ ! Tag Name:: $Name: dcpam5-20081007 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2007. All rights reserved. ! License:: See COPYRIGHT[link:../../../COPYRIGHT] ! ! Note that Japanese and English are described in parallel. ! ! cumulus_adjust モジュールの動作テストを行うためのプログラムです. ! このプログラムがコンパイルできること, および実行時に ! プログラムが正常終了することを確認してください. ! ! This program checks the operation of "cumulus_adjust" module. ! Confirm compilation and execution of this program. ! program cumulus_adjust_test01 ! モジュール引用 ; USE statements ! ! 積雲パラメタリゼーション (対流調節) ! Cumulus parameterization (convection adjust) ! use cumulus_adjust, only: Cumulus ! 格子点設定 ! Grid points settings ! use gridset, only: imax, & ! 経度格子点数. ! Number of grid points in longitude & jmax, & ! 緯度格子点数. ! Number of grid points in latitude & kmax ! 鉛直層数. ! 座標データ設定 ! Axes data settings ! use axesset, only: & & z_Sigma, & ! $ \sigma $ レベル (整数). ! Full $ \sigma $ level & r_Sigma ! $ \sigma $ レベル (半整数). ! Half $ \sigma $ level ! gtool4 データ入力 ! Gtool4 data input ! use gtool_history, only: HistoryGet ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: DP, & ! 倍精度実数型. Double precision. & STRING, & ! 文字列. Strings. & TOKEN ! キーワード. Keywords. ! テスト支援 ! Support tests ! use dc_test, only: AssertEqual ! 宣言文 ; Declaration statements ! implicit none ! 物理量 ! Physical values ! real(DP), allocatable:: xy_Ps (:,:) ! $ p_s $ . 地表面気圧. Surface pressure real(DP), allocatable:: xyz_Temp (:,:,:) ! $ T $ . 温度. Temperature real(DP), allocatable:: xyz_QVap (:,:,:) ! $ q $ . 比湿. Specific humidity real(DP), allocatable:: xyz_Press (:,:,:) ! $ p_s $ . 地表面気圧 (整数レベル). ! Surface pressure (full level) real(DP), allocatable:: xyr_Press (:,:,:) ! $ p_s $ . 地表面気圧 (半整数レベル). ! Surface pressure (half level) !!$ real(DP), allocatable:: xy_RainCumulus (:,:) !!$ ! 積雲スキームによる降水量. !!$ ! Precipitation by cumulus scheme !!$ real(DP), allocatable:: xyz_DTempDtCumulus (:,:,:) !!$ ! 積雲スキームによる温度変化率. !!$ ! Temperature tendency by cumulus scheme !!$ real(DP), allocatable:: xyz_DQVapDtCumulus (:,:,:) !!$ ! 積雲スキームによる比湿変化率. !!$ ! Specific humidity tendency by cumulus scheme real(DP), allocatable:: xyz_TempAns (:,:,:) ! $ T $ . 温度. Temperature real(DP), allocatable:: xyz_QVapAns (:,:,:) ! $ q $ . 比湿. Specific humidity !!$ real(DP), allocatable:: xy_RainCumulusAns (:,:) !!$ ! 積雲スキームによる降水量. !!$ ! Precipitation by cumulus scheme !!$ real(DP), allocatable:: xyz_DTempDtCumulusAns (:,:,:) !!$ ! 積雲スキームによる温度変化率. !!$ ! Temperature tendency by cumulus scheme !!$ real(DP), allocatable:: xyz_DQVapDtCumulusAns (:,:,:) !!$ ! 積雲スキームによる比湿変化率. !!$ ! Specific humidity tendency by cumulus scheme ! 作業変数 ! Work variables ! integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction ! 実行文 ; Executable statement ! ! 主プログラムの初期化 (内部サブルーチン) ! Initialization for the main program (Internal subroutine) ! call MainInit ! データ入力 ! Input data ! call HistoryGet ( & & file = 'cumulus_adjust_test01-00.nc', varname = 'Temp', & ! (in) & array = xyz_Temp, quiet = .true. ) ! (out) call HistoryGet ( & & file = 'cumulus_adjust_test01-00.nc', varname = 'Ps', & ! (in) & array = xy_Ps, quiet = .true. ) ! (out) !!$ call HistoryGet ( & !!$ & file = 'cumulus_adjust_test01-00.nc', varname = 'QVap', & ! (in) !!$ & array = xyz_QVap, quiet = .true. ) ! (out) do k = 1, kmax xyz_Press(:,:,k) = xy_Ps * z_Sigma(k) end do do k = 0, kmax xyr_Press(:,:,k) = xy_Ps * r_Sigma(k) end do xyz_QVap = 1.0e-2 call HistoryGet ( & & file = 'cumulus_adjust_test01-01.nc', varname = 'Temp', & ! (in) & array = xyz_TempAns, quiet = .true. ) ! (out) call HistoryGet ( & & file = 'cumulus_adjust_test01-01.nc', varname = 'QVap', & ! (in) & array = xyz_QVapAns, quiet = .true. ) ! (out) !!$ call HistoryGet ( & !!$ & file = 'cumulus_adjust_test01-01.nc', varname = 'DTempDtCumulus', & ! (in) !!$ & array = xyz_DTempDtCumulusAns, quiet = .true. ) ! (out) !!$ call HistoryGet ( & !!$ & file = 'cumulus_adjust_test01-01.nc', varname = 'DQVapDtCumulus', & ! (in) !!$ & array = xyz_DQVapDtCumulusAns, quiet = .true. ) ! (out) !!$ call HistoryGet ( & !!$ & file = 'cumulus_adjust_test01-01.nc', varname = 'RainCumulus', & ! (in) !!$ & array = xy_RainCumulusAns, quiet = .true. ) ! (out) ! Cumulus テスト ! Cumulus test ! call Cumulus( & & xyz_Temp, xyz_QVap, & ! (inout) & xyz_Press, xyr_Press ) ! (in) call AssertEqual( 'Cumulus test (Temp)', & & answer = xyz_TempAns, check = xyz_Temp, & & significant_digits = 15, ignore_digits = -15 ) call AssertEqual( 'Cumulus test (QVap)', & & answer = xyz_QVapAns, check = xyz_QVap, & & significant_digits = 15, ignore_digits = -15 ) !!$ call AssertEqual( 'Cumulus test (DTempDtCumulus)', & !!$ & answer = xyz_DTempDtCumulusAns, check = xyz_DTempDtCumulus, & !!$ & significant_digits = 15, ignore_digits = -15 ) !!$ call AssertEqual( 'Cumulus test (DQVapDtCumulus)', & !!$ & answer = xyz_DQVapDtCumulusAns, check = xyz_DQVapDtCumulus, & !!$ & significant_digits = 15, ignore_digits = -15 ) !!$ call AssertEqual( 'Cumulus test (RainCumulus)', & !!$ & answer = xy_RainCumulusAns, check = xy_RainCumulus, & !!$ & significant_digits = 14, ignore_digits = -15 ) ! データ出力 (内部サブルーチン) ! Output data (Internal subroutine) ! !!$ call HistoryOutput contains !------------------------------------------------------------------- subroutine MainInit ! ! 主プログラムの初期化手続き. ! ! Initialization procedure for the main program. ! ! コマンドライン引数処理 ! 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 ! 出力ファイルの基本情報管理 ! Management basic information for output files ! use fileset, only: FilesetInit ! 格子点設定 ! Grid points settings ! use gridset, only: GridsetInit, & & imax, & ! 経度格子点数. ! Number of grid points in longitude & jmax, & ! 緯度格子点数. ! Number of grid points in latitude & kmax ! 鉛直層数. ! Number of vertical level ! 物理定数設定 ! Physical constants settings ! use constants, only: ConstantsInit ! 座標データ設定 ! Axes data settings ! use axesset, only: AxessetInit ! ヒストリデータ出力 ! History data output ! use history_file_io, only: HistoryFileOpen ! 文字列操作 ! Character handling ! use dc_string, only: StoA ! 実行文 ; Executable statement ! ! コマンドライン引数処理 ! 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 ! ヒストリデータファイルの初期化 ! Initialization of history data files ! call HistoryFileOpen ! 割付 ! Allocation ! allocate( xy_Ps (0:imax-1, 1:jmax) ) allocate( xyz_Temp (0:imax-1, 1:jmax, 1:kmax) ) allocate( xyz_QVap (0:imax-1, 1:jmax, 1:kmax) ) allocate( xyz_Press (0:imax-1, 1:jmax, 1:kmax) ) allocate( xyr_Press (0:imax-1, 1:jmax, 0:kmax) ) !!$ allocate( xy_RainCumulus (0:imax-1, 1:jmax) ) !!$ allocate( xyz_DTempDtCumulus (0:imax-1, 1:jmax, 1:kmax) ) !!$ allocate( xyz_DQVapDtCumulus (0:imax-1, 1:jmax, 1:kmax) ) allocate( xyz_TempAns (0:imax-1, 1:jmax, 1:kmax) ) allocate( xyz_QVapAns (0:imax-1, 1:jmax, 1:kmax) ) !!$ allocate( xy_RainCumulusAns (0:imax-1, 1:jmax) ) !!$ allocate( xyz_DTempDtCumulusAns (0:imax-1, 1:jmax, 1:kmax) ) !!$ allocate( xyz_DQVapDtCumulusAns (0:imax-1, 1:jmax, 1:kmax) ) end subroutine MainInit !------------------------------------------------------------------- subroutine MainTerminate ! ! 主プログラムの終了処理手続き. ! ! Termination procedure for the main program. ! ! 時刻管理 ! Time control ! use timeset, only: TimesetClockStop, TimesetClose ! ヒストリデータ出力 ! History data output ! use history_file_io, only: HistoryFileClose ! 実行文 ; Executable statement ! ! 時刻管理終了処理 ! Termination of time control ! call TimesetClose end subroutine MainTerminate !------------------------------------------------------------------- subroutine HistoryOutput ! モジュール引用 ; USE statements ! ! 物理定数設定 ! Physical constants settings ! use constants, only: PI ! $ \pi $ . ! 円周率. Circular constant ! 座標データ設定 ! Axes data settings ! use axesset, only: & & x_Lon, & ! $ \lambda $ [rad.] . 経度. Longitude & x_Lon_Weight, & ! $ \Delta \lambda $ [rad.] . ! 経度座標重み. ! Weight of longitude & y_Lat, & ! $ \varphi $ [rad.] . 緯度. Latitude & y_Lat_Weight, & ! $ \Delta \varphi $ [rad.] . ! 緯度座標重み. ! Weight of latitude & z_Sigma, & ! $ \sigma $ レベル (整数). ! Full $ \sigma $ level & r_Sigma, & ! $ \sigma $ レベル (半整数). ! Half $ \sigma $ level & z_DelSigma ! $ \Delta \sigma $ (整数). ! $ \Delta \sigma $ (Full) ! gtool4 データ出力 ! Gtool4 data output ! use gtool_history, only: GT_HISTORY, & & HistoryCreate, HistoryAddVariable, HistoryPut, HistoryClose, & & HistoryAddAttr ! 文字列操作 ! Character handling ! use dc_string, only: StoA ! 宣言文 ; Declaration statements ! implicit none ! データ入出力 ! Data I/O ! type(GT_HISTORY):: gthist ! 実験の表題, モデルの名称, 所属機関名 ! Title of a experiment, name of model, sub-organ ! character(*), parameter:: title = & & 'data of answer for a test prorgram "cumulus_adjust_test01"' character(*), parameter:: source = & & 'dcpam5 ' // & & '(See http://www.gfd-dennou.org/library/dcpam)' character(*), parameter:: institution = & & 'GFD Dennou Club (See http://www.gfd-dennou.org)' ! 実行文 ; Executable statement ! call HistoryCreate( & & history = gthist, & ! (out) & file = 'cumulus_adjust_test01-01.tmp.nc', & ! (in) & title = title, & ! (in) & source = source, institution = institution, & ! (in) & dims = StoA('lon', 'lat', 'sig', 'sigm'), & ! (in) & dimsizes = (/imax, jmax, kmax, kmax + 1/), & ! (in) & longnames = & & StoA('longitude', 'latitude', & & 'sigma at layer midpoints', & & 'sigma at layer end-points (half level)'), & ! (in) & units = StoA('degree_east', 'degree_north', & & '1', '1') ) ! (out) call HistoryPut( & & history = gthist, & ! (out) & varname = 'lon', array = x_Lon * 180.0_DP / PI ) ! (in) call HistoryPut( & & history = gthist, & ! (out) & varname = 'lat', array = y_Lat * 180.0_DP / PI ) ! (in) call HistoryPut( & & history = gthist, & ! (out) & varname = 'sig', array = z_Sigma ) ! (in) call HistoryPut( & & history = gthist, & ! (out) & varname = 'sigm', array = r_Sigma ) ! (in) call HistoryAddAttr( & & history = gthist, & ! (inout) & varname = 'lon', attrname = 'standard_name', & ! (in) & value = 'longitude' ) ! (in) call HistoryAddAttr( & & history = gthist, & ! (inout) & varname = 'lat', attrname = 'standard_name', & ! (in) & value = 'latitude' ) ! (in) call HistoryAddAttr( & & history = gthist, & ! (inout) & varname = 'sig', attrname = 'standard_name', & ! (in) & value = 'atmosphere_sigma_coordinate' ) ! (in) call HistoryAddAttr( & & history = gthist, & ! (inout) & varname = 'sigm', attrname = 'standard_name', & ! (in) & value = 'atmosphere_sigma_coordinate' ) ! (in) call HistoryAddAttr( & & history = gthist, & ! (inout) & varname = 'sig', attrname = 'positive', & ! (in) & value = 'down' ) ! (in) call HistoryAddAttr( & & history = gthist, & ! (inout) & varname = 'sigm', attrname = 'positive', & ! (in) & value = 'down' ) ! (in) call HistoryAddVariable( & & history = gthist, & ! (inout) & varname = 'Temp', & ! (in) & dims = StoA('lon', 'lat', 'sig'), & ! (in) & longname = 'temperature', & ! (in) & units = 'K', xtype = 'double' ) ! (in) call HistoryPut( & & history = gthist, & ! (inout) & varname = 'Temp', array = xyz_Temp ) ! (in) call HistoryAddVariable( & & history = gthist, & ! (inout) & varname = 'QVap', & ! (in) & dims = StoA('lon', 'lat', 'sig'), & ! (in) & longname = 'specific humidity', & ! (in) & units = 'kg kg-1', xtype = 'double' ) ! (in) call HistoryPut( & & history = gthist, & ! (inout) & varname = 'QVap', array = xyz_QVap ) ! (in) !!$ call HistoryAddVariable( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'DTempDtCumulus', & ! (in) !!$ & dims = StoA('lon', 'lat', 'sig'), & ! (in) !!$ & longname = 'cumulus condensation heating', & ! (in) !!$ & units = 'K s-1', xtype = 'double' ) ! (in) !!$ call HistoryPut( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'DTempDtCumulus', array = xyz_DTempDtCumulus ) ! (in) !!$ !!$ call HistoryAddVariable( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'DQVapDtCumulus', & ! (in) !!$ & dims = StoA('lon', 'lat', 'sig'), & ! (in) !!$ & longname = 'cumulus condensation moistening', & ! (in) !!$ & units = 'kg kg-1 s-1', xtype = 'double' ) ! (in) !!$ call HistoryPut( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'DQVapDtCumulus', array = xyz_DQVapDtCumulus ) ! (in) !!$ !!$ call HistoryAddVariable( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'RainCumulus', & ! (in) !!$ & dims = StoA('lon', 'lat'), & ! (in) !!$ & longname = 'precipitation by cumulus scheme', & ! (in) !!$ & units = 'W m-2', xtype = 'double' ) ! (in) !!$ call HistoryPut( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'RainCumulus', array = xy_RainCumulus ) ! (in) call HistoryClose( history = gthist ) ! (inout) end subroutine HistoryOutput end program cumulus_adjust_test01