*" PACKAGE AADMIN !" 共通 メインルーチン *" ver 1.00 92/10/13 takepiro *********************************************************************** PROGRAM GAMRAS !" メインルーチン * *" Boussinesq 全球モデル *" one-level time integration * * [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, 0:KDIM ) !" 西風 ｕ REAL GAV ( IDIM, JDIM, 0:KDIM ) !" 南風 ｖ REAL GAW ( IDIM, JDIM, 0:KDIM ) !" 鉛直風 ｗ REAL GAT ( IDIM, JDIM, 0:KDIM ) !" 温度 Ｔ REAL GATOR ( IDIM, JDIM, 0:KDIM ) !" トロイダル Ψ REAL GAPOR ( IDIM, JDIM, 0:KDIM ) !" ポロイダル Φ *" : 格子点データ(t) 格子点データ(t+Δt) * REAL GTUA ( IDIM, JDIM, 0:KDIM ) !" 東西運動量変化項ＵＡ REAL GTVA ( IDIM, JDIM, 0:KDIM ) !" 南北運動量変化項ＶＡ REAL GTH ( IDIM, JDIM, 0:KDIM ) !" 温度時間変化項 Ｈ *" : 格子点変化項(P) 格子点変化項(P+D) * INTEGER ISTEP !" 通しステップ数 INTEGER ITA !" 通し時間(t), 標準時間単位 c$$$ INTEGER IDATEA( 6 ) !" 時刻年月日時分秒(ダミー) REAL DELT !" 時間刻みΔt(DAY) LOGICAL OADVNC !" 時刻が進行するか否か LOGICAL ORSTR !" 再出発出力するか否か *" : 時刻等 * * [ONCE] INTEGER ITSTRT !" 計算開始時刻(標準時間単位) INTEGER ITEND !" 計算終了時刻(標準時間単位) INTEGER IORSTR !" 出力間隔：再出発(標準時間単位) *" : 実験管理パラメータ * INTEGER IDELT !" 標準時間刻み(SEC) *" : 時間ステップパラメータ * *" COMMON /COMCON/ ( include ZCCOM ) * REAL ERI !" 内径 * REAL ERO !" 外径 * REAL ETA !" 内径/外径 *" COMMON /COMCON/ end *" : 物理パラメータ * REAL ALAT ( JDIM ) !" 緯度 REAL DLAT ( JDIM ) !" 緯度荷重 REAL ALON ( IDIM ) !" 経度 REAL DLON ( IDIM ) !" 経度荷重 REAL ARAD ( 0:KDIM ) !" ｒレベル(整数) REAL DRAD ( 0:KDIM ) !" Δｒ(整数) *" : 座標値 * * [WORK] INTEGER IUNIT !" 標準出力装置番号 * COMMON /COMWRK/ WORK REAL WORK ( NWORK ) !" ワーク領域 * c$$$ DATA IDATEA / 1992, 12, 18, 0, 0, 0/ * #ifdef DEBUG external common_handler integer i, ieee_handler i = ieee_handler("set","common",common_handler ) if( i.ne. 0 ) print *, "Could not establish fp signal handler" #endif * *" << SETPUP : 初期設定 >> * CALL GLPGET( 'MSGUNIT', IUNIT ) WRITE ( IUNIT, * ) ' 3DIM BOUSSINESQ MODEL GAMRAS' & //NAME & //' ver.1.0, 92/10/13' * CALL CLCSTR ( 'SETUP' ) CALL YPREP !" システム前処理 * CALL SETPAR !" 実験パラメータ O ( ITSTRT , ITEND , IORSTR , O IDELT ) * CALL SETCOR !" 座標値 O ( ALON , DLON , O ALAT , DLAT , O ARAD , DRAD ) * CALL RDSTRT !" 初期値の読み込みと再生成 O ( GAU , GAV , GAW , GAT , O GATOR , GAPOR , O ITA , ISTEP , C ITSTRT, ALAT , DLAT , ARAD , DRAD ) * CALL ADMXMN I ( GAU , GAV , GAW , GAT , I GATOR , GAPOR , ITA , 'start GA' ) * CALL SETTIM !" 時刻を記憶 I ( ITA , ISTEP ) CALL AHSTRG !" 標準時間平均出力の登録 * CALL CLCEND ( 'SETUP' ) * * << LOOP : <************* メイン・ループ >> * 5000 CONTINUE * #ifdef DEBUG CALL ADMXMN I ( GAU , GAV , GAW , GAT , I GATOR , GAPOR , ITA , 'begin LOOP' ) #endif ISTEP = ISTEP + 1 * * << START : ステップはじめの処理 >> * CALL CLCSTR ( 'TIMCON' ) * CALL TIMSTP !" 時間制御 O ( DELT , OADVNC , ORSTR , I ITA , ISTEP , C IDELT , ITEND , IORSTR ) * CALL CLCEND ( 'TIMCON' ) * *" << INTEGR : 時間積分 >> * CALL CLCSTR ( 'DYNMCS' ) * CALL DYNMCS !" 力学項と時間積分 M ( GAU , GAV , GAW , GAT , M GATOR , GAPOR , I ITA , DELT , OADVNC, C ALON , DLON , ALAT , DLAT , C ARAD , DRAD ) * CALL CLCEND ( 'DYNMCS' ) * #ifdef DEBUG CALL ADMXMN I ( GAU , GAV , GAW , GAT , I GATOR , GAPOR , ITA , 'after DYNMCS' ) #endif * *" << ADJST : 積分後の調節 >> * *" 調節過程なし * * *" << OUTPUT : データ出力 >> CALL ADVSTP !" 時刻変数を進める O ( ITA , I OADVNC ) * IF ( OADVNC ) THEN CALL CLCSTR ( 'HISTIN' ) CALL HISTIN ( GAU , 'U' ) !" 出力データの記憶 CALL HISTIN ( GAV , 'V' ) CALL HISTIN ( GAW , 'W' ) CALL HISTIN ( GAT , 'T' ) CALL HISTIN ( GATOR , 'TOR' ) CALL HISTIN ( GAPOR , 'POR' ) CALL CLCEND ( 'HISTIN' ) * CALL CLCSTR ( 'HISTOU' ) CALL HISTRP CALL HISTOU !" データを出力 CALL CLCEND ( 'HISTOU' ) ENDIF * *" << NEXT : 次のステップへ >> * CALL CLCSTR ( 'MISC' ) * IF ( ORSTR ) THEN CALL WRRSTR !" リスタートファイル書き込み I ( GAU , GAV , GAW , GAT , I GATOR , GAPOR , I ITA , ISTEP ) ENDIF * CALL CLCEND ( 'MISC' ) * *" << LEND : メイン・ループ終わり *************> >> * IF ( .NOT. ( ITA .GE. ITEND ) ) GOTO 5000 * CALL ADMXMN I ( GAU , GAV , GAW , GAT , I GATOR , GAPOR , ITA , 'end PROGRAM' ) CALL CLCOUT !" CPU時間出力 CALL YFINE !" システム後処理 * STOP END *********************************************************************** SUBROUTINE AHSTRG !" 標準時間平均出力の登録 * * [INTERN PARAM] INTEGER ISTYPL DATA ISTYPL / 1 / REAL VMISS * CALL GZDBGT ( 'MISS', VMISS ) !" 欠損値 * CALL HISTRG !" 出力の登録 I ( 'U ', 'u-velocity ' ,'m/s ', 'ALEV', I VMISS , VMISS , 0.1 , 0.5 , ISTYPL , I 'CON' , ' ' , 0 , 0 , ' ' ,'(F12.3)' ) * CALL HISTRG I ( 'V ', 'v-velocity ' ,'m/s ', 'ALEV', I VMISS , VMISS , 0.1 , 0.5 , ISTYPL , I 'CON' , ' ' , 0 , 0 , ' ' ,'(F12.3)' ) * CALL HISTRG I ( 'W ', 'w-velocity ' ,'m/s ', 'ALEV', I VMISS , VMISS , 0.1 , 0.5 , ISTYPL , I 'CON' , ' ' , 0 , 0 , ' ' ,'(F12.3)' ) * CALL HISTRG I ( 'T ', 'temperature ' ,'K ', 'ALEV', I VMISS , VMISS , 0.1 , 0.5 , ISTYPL , I 'CON' , ' ' , 0 , 0 , ' ' ,'(F12.3)' ) * CALL HISTRG I ( 'TOR ', 'toroidal potential ' ,'1/s ', 'ALEV', I VMISS , VMISS , 0.1 , 0.5 , ISTYPL , I ' ' , ' ' , 0 , 0 , ' ' ,'(1PE12.3)' ) * CALL HISTRG I ( 'POR ', 'poroidal potential ' ,'1/s ', 'ALEV', I VMISS , VMISS , 0.1 , 0.5 , ISTYPL , I ' ' , ' ' , 0 , 0 , ' ' ,'(1PE12.3)' ) * RETURN END ************************************************************************* SUBROUTINE ADMXMN !" debug monitor I ( GDU , GDV , GDW , GDT , I GDTOR , GDPOR , 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 GDW ( IDIM, JDIM, KMAX ) !" 鉛直風 ｗ REAL GDT ( IDIM, JDIM, KMAX ) !" 温度 Ｔ REAL GDTOR ( IDIM, JDIM, KMAX ) !" トロイダル Ψ REAL GDPOR ( 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( GDW, IDIM, JDIM, KMAX, IDIM, JDIM, 'W' ) CALL MAXMIN( GDT, IDIM, JDIM, KMAX, IDIM, JDIM, 'T' ) CALL MAXMIN( GDTOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'TOR' ) CALL MAXMIN( GDPOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'POR' ) * RETURN END