*" PACKAGE AADMIN !" 共通 メインルーチン *" ver 1.00 92/06/11 numaguti *" SRC:=$GC/model/agcm5/src/admin/aadmn.F *" DOC:=$GC/model/agcm5/doc/main.tex *" 履歴 93/08/29 保坂征宏 PHYSICS 周辺変更 *" 履歴 97/09/22 堀之内武 AHSTRGの仕様変更. HISTRG を呼ぶ際にデフォルト *" ファイル名上書きをやめる(HISTRGの後ろから6番目の引数を'CON'から' 'に) *********************************************************************** PROGRAM GCM5 !" メインルーチン * *" 湿潤多層全球モデル *" Arakawa & Suarez 鉛直差分 σ座標 *" semi implicit scheme *" 標準物理過程, 簡略放射 * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数, 波数 INCLUDE (ZHDIM) !" 文字列文字数 INCLUDE (ZCCOM) !" 標準物理定数 #else #include "zcdim.F" !" 格子点数, 波数 #include "zhdim.F" !" 文字列文字数 #include "zccom.F" !" 標準物理定数 #endif * * [VAR] REAL GAU ( IDIM, JDIM, KMAX ) !" 西風 ｕ REAL GAV ( IDIM, JDIM, KMAX ) !" 南風 ｖ REAL GAT ( IDIM, JDIM, KMAX ) !" 温度 Ｔ REAL GAPS ( IDIM, JDIM ) !" 地表気圧 REAL GAQ ( IDIM, JDIM, KMAX ) !" 比湿 ｑ REAL GAVOR ( IDIM, JDIM, KMAX ) !" 渦度 ζ REAL GADIV ( IDIM, JDIM, KMAX ) !" 発散 Ｄ *" : 格子点データ(t) 格子点データ(t+Δt) * REAL GBU ( IDIM, JDIM, KMAX ) !" 西風 ｕ REAL GBV ( IDIM, JDIM, KMAX ) !" 南風 ｖ REAL GBT ( IDIM, JDIM, KMAX ) !" 温度 Ｔ REAL GBPS ( IDIM, JDIM ) !" 地表気圧 REAL GBQ ( IDIM, JDIM, KMAX ) !" 比湿 ｑ REAL GBVOR ( IDIM, JDIM, KMAX ) !" 渦度 ζ REAL GBDIV ( IDIM, JDIM, KMAX ) !" 発散 Ｄ REAL GBTG ( IDIM, JDIM ) !" 地面温度Ｔｇ *" : 格子点データ(t-Δt) 格子点データ(t) * REAL GTUA ( IDIM, JDIM, KMAX ) !" 東西運動量変化項ＵＡ REAL GTVA ( IDIM, JDIM, KMAX ) !" 南北運動量変化項ＶＡ REAL GTH ( IDIM, JDIM, KMAX ) !" 温度時間変化項 Ｈ REAL GTR ( IDIM, JDIM, KMAX ) !" 比湿時間変化項 Ｒ *" : 格子点変化項(P) 格子点変化項(P+D) * INTEGER ISTEP !" 通しステップ数 INTEGER ITA !" 通し時間(t) INTEGER ITB !" 通し時間(t-Δt) INTEGER IDATEA( 6 ) !" 時刻：年月日時分秒 INTEGER IDATEB( 6 ) !" 時刻：年月日時分秒 REAL DELT !" 時間刻みΔt REAL DELTP !" 物理過程時間刻Δt !"保坂93/08/29追加 LOGICAL OADVNC !" 時刻が進行するか否か LOGICAL ORSTR !" 再出発出力するか否か *" : 時刻等 * * [ONCE] INTEGER ITSTRT !" 計算開始時刻 INTEGER ITEND !" 計算終了時刻 INTEGER IORSTR !" 出力間隔：再出発 *" : 実験管理パラメータ * INTEGER IDELT !" 標準時間刻み INTEGER INISTP !" 初期ステップ数 REAL TFIL !" 時間フィルター係数 *" : 時間ステップパラメータ * *" COMMON /COMCON/ ( include ZCCOM ) * REAL CP !" 大気定圧比熱 * REAL EL !" 水の凝結の潜熱 * REAL ER !" 地球半径 * REAL GRAV !" 重力加速度 * REAL RAIR !" 大気気体定数 * REAL RVAP !" 水蒸気気体定数 * REAL CPVAP !" 水蒸気定圧比熱 * REAL DH2O !" 水の密度 * REAL EPSV !" 水と大気の分子量比 * REAL ES0 !" ０℃飽和蒸気圧 * REAL STB !" Stefan-Boltzman * REAL FKARM !" Karman 定数 *" COMMON /COMCON/ end *" : 物理パラメータ * REAL ALAT ( JDIM ) !" 緯度 REAL DLAT ( JDIM ) !" 緯度荷重 REAL ALON ( IDIM ) !" 経度 REAL DLON ( IDIM ) !" 経度荷重 REAL SIG ( KMAX ) !" σレベル(整数) REAL SIGM (KMAX+1) !" σレベル(半整数) REAL DSIG ( KMAX ) !" Δσ(整数) REAL DSIGM (KMAX+1) !" Δσ(半整数) *" : 座標値 * * [WORK] COMMON /COMWRK/ WORK REAL WORK ( NWORK ) !" ワーク領域 * * *" << SETPUP : 初期設定 >> * CALL CLCSTR ( 'SETUP' ) CALL YPREP !" システム前処理 * CALL SETPAR !" 実験パラメータ O ( ITSTRT, ITEND , IORSTR, O IDELT , INISTP, TFIL ) * CALL SETCOR !" 座標値 O ( ALON , DLON , O ALAT , DLAT , O SIG , DSIG , O SIGM , DSIGM ) * CALL RDSTRT !" 初期値の読み込みと再生成 O ( GAU , GAV , GAT , GAPS , GAQ , O GAVOR , GADIV , O GBU , GBV , GBT , GBPS , GBQ , O GBVOR , GBDIV , O ITA , ITB , IDATEA, IDATEB, ISTEP , C ITSTRT, ALAT , DLAT ) * CALL ADMXMN I ( GAU , GAV , GAT , GAPS , GAQ , I GADIV , GAVOR , ITA , 'start GA' ) CALL ADMXMN I ( GBU , GBV , GBT , GBPS , GBQ , I GBDIV , GBVOR , ITB , 'start GB' ) * CALL RDSTRG !" 地表初期値の読み込み O ( GBTG , I GBT , C ITB ) * CALL SETTIM !" 時刻を記憶 I ( ITA , ITB , IDATEA, IDATEB, ISTEP ) CALL AHSTRG !" 標準時間平均出力の登録 * CALL CLCEND ( 'SETUP' ) * * << LOOP : <************* メイン・ループ >> * 5000 CONTINUE * #ifdef DEBUG CALL ADMXMN I ( GAU , GAV , GAT , GAPS , GAQ , I GADIV , GAVOR , ITA , 'begin LOOP' ) #endif ISTEP = ISTEP + 1 * * << START : ステップはじめの処理 >> * CALL CLCSTR ( 'TIMCON' ) * CALL TIMSTP !" 時間制御 O ( DELT , OADVNC, ORSTR , I ITA , ITB , IDATEA, IDATEB, ISTEP , C IDELT , INISTP, ITEND , IORSTR ) * CALL SAVEGB !" t-Δtのデータをセーブ I ( GBU , GBV , GBT , GBPS , GBQ , I GBVOR , GBDIV ) CALL CLCEND ( 'TIMCON' ) * *" << INTEGR : 時間積分 >> * CALL CLCSTR ( 'PHYSCS' ) * DELTP = 2 * DELT !" 93/08/29 保坂追加 * CALL PHYSCS !" 物理過程 93/08/29 保坂変更 O ( GTUA , GTVA , GTH , GTR , M GBTG , I GBU , GBV , GBT , GBPS , GBQ , I GBVOR , GBDIV , I ITB , IDATEB, DELTP , DELT , C ALON , ALAT , C SIG , SIGM , DSIG , DSIGM ) * CALL CLCEND ( 'PHYSCS' ) * CALL CLCSTR ( 'DYNMCS' ) * CALL DYNMCS !" 力学項と時間積分 M ( GAU , GAV , GAT , GAPS , GAQ , M GBU , GBV , GBT , GBPS , GBQ , M GAVOR , GADIV , GBVOR , GBDIV , M GTUA , GTVA , GTH , GTR , I ITA , DELT , OADVNC, C ALON , DLON , ALAT , DLAT , C SIG , SIGM , DSIG , DSIGM ) * CALL CLCEND ( 'DYNMCS' ) * #ifdef DEBUG CALL ADMXMN I ( GAU , GAV , GAT , GAPS , GAQ , I GADIV , GAVOR , ITA , 'after DYNMCS' ) #endif * *" << ADJST : 積分後の調節 >> * CALL CLCSTR ( 'PADJST' ) * CALL PADJST !" 物理調節 M ( GAU , GAV , GAT , GAPS , GAQ , I GAVOR , GADIV , I DELT*2., C SIG , SIGM , DSIG , DSIGM ) * CALL CLCEND ( 'PADJST' ) CALL CLCSTR ( 'TFILT' ) * IF ( OADVNC ) THEN CALL TFILT !" タイムフィルター M ( GBU , GBV , GBT , GBPS , GBQ , M GBVOR , GBDIV , I GAU , GAV , GAT , GAPS , GAQ , I GAVOR , GADIV , C TFIL ) ENDIF * CALL CLCEND ( 'TFILT' ) * *" << OUTPUT : データ出力 >> IF ( OADVNC ) THEN CALL CLCSTR ( 'HISTIN' ) CALL HISTIN ( GBU , 'U' ) !" 出力データの記憶 CALL HISTIN ( GBV , 'V' ) CALL HISTIN ( GBT , 'T' ) CALL HISTIN ( GBPS , 'PS' ) CALL HISTIN ( GBQ , 'Q' ) CALL HISTIN ( GBVOR , 'VOR' ) CALL HISTIN ( GBDIV , 'DIV' ) CALL HISTIN ( GBTG , 'TG' ) CALL CLCEND ( 'HISTIN' ) * CALL CLCSTR ( 'HISTOU' ) CALL HISTRP CALL HISTOU !" データを出力 CALL CLCEND ( 'HISTOU' ) ENDIF * *" << NEXT : 次のステップへ >> * CALL CLCSTR ( 'MISC' ) * CALL ADVSTP !" 時刻変数を進める O ( ITA , ITB , IDATEA, IDATEB, I OADVNC ) * IF ( ORSTR ) THEN CALL WRRSTR !" リスタートファイル書き込み I ( GAU , GAV , GAT , GAPS , GAQ , I GAVOR , GADIV , I GBU , GBV , GBT , GBPS , GBQ , I GBVOR , GBDIV , I ITA , ITB , IDATEA, IDATEB, ISTEP ) * CALL WRRSTG !" 地表リスタート・ファイルの書き込み I ( GBTG , I ITB , IDATEB, ISTEP ) ENDIF * CALL CLCEND ( 'MISC' ) * *" << LEND : メイン・ループ終わり *************> >> * IF ( .NOT. ( ITB .GE. ITEND ) ) GOTO 5000 * CALL CLCOUT !" CPU時間出力 CALL YFINE !" システム後処理 * STOP END *********************************************************************** SUBROUTINE AHSTRG !" 標準時間平均出力の登録 * * [INTERN PARAM] INTEGER ISTYPL DATA ISTYPL / 1 / REAL VMISS, DIVSX, DIVLX * CALL GZDBGT ( 'MISS', VMISS ) !" 欠損値 * DIVSX = 2.5 DIVLX = 10. CALL HISTRG !" 出力の登録 I ( 'U ', 'u-velocity ' ,'m/s ', 'ALEV', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(F12.3)' ) * CALL HISTRG I ( 'V ', 'v-velocity ' ,'m/s ', 'ALEV', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(F12.3)' ) * CALL HISTRG I ( 'T ', 'temperature ' ,'K ', 'ALEV', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(F12.3)' ) * CALL HISTRG I ( 'PS ', 'surface pressure ' ,'mb ', 'ASFC', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(F12.3)' ) * DIVSX = 1.E-6 DIVLX = 5.E-6 CALL HISTRG I ( 'Q ', 'specific humidity ' ,'g/g ', 'ALEV', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(3PF12.3)' ) * CALL HISTRG I ( 'VOR ', 'vorticity ' ,'1/s ', 'ALEV', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(1PE12.3)' ) * CALL HISTRG I ( 'DIV ', 'divergence ' ,'1/s ', 'ALEV', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(1PE12.3)' ) * DIVSX = 2.5 DIVLX = 10. CALL HISTRG I ( 'TG ', 'ground temperature ' ,'K ', 'ASFC', I VMISS, VMISS, DIVSX, DIVLX, ISTYPL, I ' ' , ' ' , 0 , 0 , 'X' ,'(F12.3)' ) * RETURN END ************************************************************************* SUBROUTINE ADMXMN !" debug monitor I ( GDU , GDV , GDT , GDPS , GDQ , I GDDIV , GDVOR , IT , HLABEL ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数, 波数 #else #include "zcdim.F" !" 格子点数, 波数 #endif * * [INPUT] REAL GDU ( IDIM, JDIM, KMAX ) !" 西風 ｕ REAL GDV ( IDIM, JDIM, KMAX ) !" 南風 ｖ REAL GDT ( IDIM, JDIM, KMAX ) !" 温度 Ｔ REAL GDPS ( IDIM, JDIM ) !" 地表気圧 REAL GDQ ( IDIM, JDIM, KMAX ) !" 比湿 ｑ REAL GDVOR ( IDIM, JDIM, KMAX ) !" 渦度 ζ REAL GDDIV ( IDIM, JDIM, KMAX ) !" 発散 Ｄ INTEGER IT CHARACTER HLABEL *(*) * WRITE ( 6,* ) HLABEL, ' IT= ', IT CALL MAXMIN( GDU, IDIM, JDIM, KMAX, IDIM, JDIM, 'U' ) CALL MAXMIN( GDV, IDIM, JDIM, KMAX, IDIM, JDIM, 'V' ) CALL MAXMIN( GDT, IDIM, JDIM, KMAX, IDIM, JDIM, 'T' ) CALL MAXMIN( GDPS, IDIM, JDIM, 1, IDIM, JDIM, 'PS' ) CALL MAXMIN( GDQ, IDIM, JDIM, KMAX, IDIM, JDIM, 'Q' ) CALL MAXMIN( GDVOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'VOR' ) CALL MAXMIN( GDDIV, IDIM, JDIM, KMAX, IDIM, JDIM, 'DIV' ) * RETURN END