* PACKAGE ASTEP !" 共通 ステップ制御 ( 1 time level ) * *" [HIS] 92/10/13(takepiro) 1 日を無次元の 1 とする *" 92/12/04(takepiro) バグフィックス * ********************************************************************** SUBROUTINE TIMSTP !" 時刻制御 O ( DELT , OADVNC, ORSTR , I ITA , ISTEP , C IDELT , ITEND , IORSTR ) * REAL DELT !" 時間刻みΔｔ(DAY) LOGICAL OADVNC !" 時刻が進行するか否か LOGICAL ORSTR !" リスタート出すか否か INTEGER ITA !" 通し時間(t), 標準時間単位 INTEGER ITB !" 通し時間(t-Δt), 標準時間 INTEGER IDATEA( * ) !" 時刻年月日時分秒 INTEGER IDATEB( * ) !" 時刻年月日時分秒 INTEGER ISTEP !" 通しステップ数 INTEGER IDELT !" 標準時間刻み(SEC) INTEGER ITEND !" 計算終了時刻 INTEGER IORSTR !" 出力間隔：再出発 * * [INTERNAL SAVE] INTEGER ITAZ INTEGER ITBZ INTEGER ITNZ INTEGER ISTEPZ INTEGER IDAZ ( 6 ) INTEGER IDBZ ( 6 ) REAL DELTZ LOGICAL OADVZ DATA IDAZ / 1990, 1, 1, 0, 0, 0 / SAVE * [INTERNAL WORK] INTEGER IDELTX, ITN, II * *" < 1. Δｔ の進行 > * *" ----- normal -------- * OADVNC = .TRUE. CALL ACTIMR I ( IDELT , 'SEC' , 'DAY', O DELT ) * * *" < 2. 次の時刻(N) > * CALL ACTIME I ( IDELT , 'SEC' , '#' , O IDELTX ) * ITN = ITA + IDELTX * *" < 3. リスタート出力フラグ > * IF ( ITA .GE. ITEND ) THEN ORSTR = .TRUE. ELSE IF ( IORSTR .LE. 0 ) THEN ORSTR = .FALSE. ELSE IF ( ITN/IORSTR .GT. ITA/IORSTR ) THEN ORSTR = .TRUE. ELSE ORSTR = .FALSE. ENDIF * *" < 4. 内部設定 > * DELTZ = DELT OADVZ = OADVNC * ITNZ = ITN * RETURN * *" --------------------------------------------------------------- ENTRY SETTIM !" 時刻の設定(時間積分開始前) I ( ITA , ISTEP ) * ITBZ = ITA ITAZ = ITA c$$$ DO 4200 II = 1,6 c$$$ IDAZ( II ) = IDATEA( II ) c$$$ IDBZ( II ) = IDATEA( II ) c$$$ 4200 CONTINUE ISTEPZ = ISTEP * RETURN *===================================================================== ENTRY ADVSTP !" 時刻進行 O ( ITA , I OADVNC ) * IF ( OADVNC ) THEN ITA = ITNZ ITBZ = ITAZ ITAZ = ITA ELSE ITA = ITAZ ITAZ = ITA ENDIF * RETURN *===================================================================== ENTRY INQTIM !" 時刻の参照 O ( ITA , ITB , IDATEA, IDATEB, O ISTEP , DELT , OADVNC ) * ITB = ITBZ ITA = ITAZ DO 6100 II = 1, 6 IDATEB( II ) = IDBZ( II ) IDATEA( II ) = IDAZ( II ) 6100 CONTINUE ISTEP = ISTEPZ DELT = DELTZ OADVNC = OADVZ * RETURN END c$$$*********************************************************************** c$$$ SUBROUTINE AIDATE !" 日付の更新 c$$$ O ( IDATEN, c$$$ I IDATE , c$$$ I IDELT ) c$$$* c$$$*" (* 理想的暦 1年=12ヵ月=360日 *) c$$$* c$$$ INTEGER IDATEN( * ) !" 時刻年月日時分秒 c$$$ INTEGER IDATE ( * ) !" 時刻年月日時分秒 c$$$ INTEGER IDELT !" 時間刻み c$$$* c$$$* [INTERNAL WORK] c$$$ REAL RDATE ( 2 ) !" 季節, 時刻 c$$$ INTEGER IFPAR, JFPAR, II, KK, IKURI c$$$ INTEGER IDELS, IYRDIF, IHORN, IHOR c$$$ INTEGER ISECN, ISEC c$$$ REAL RDAY, RSEC c$$$* c$$$* [INTERNAL PARAM] c$$$ INTEGER IDMAX( 6 ) !" 時刻の最大値 c$$$ DATA IDMAX / 1000000, 12, 30, 24, 60, 60 / c$$$* c$$$ LOGICAL OPERPT c$$$ DATA OPERPT / .FALSE. / !" 日付の変更なし c$$$* c$$$ NAMELIST /NMCALN/ OPERPT, IDMAX c$$$ SAVE OPERPT, IDMAX c$$$* c$$$ LOGICAL OFIRST c$$$ DATA OFIRST / .TRUE. / c$$$ SAVE OFIRST c$$$* c$$$ IF ( OFIRST ) THEN c$$$ WRITE ( 6,* ) ' CALENDAR DATE=92/04/17' c$$$ OFIRST = .FALSE. c$$$* c$$$ CALL REWNML ( IFPAR , JFPAR ) c$$$ READ ( IFPAR, NMCALN, END=190 ) c$$$ 190 WRITE ( JFPAR, NMCALN ) c$$$ ENDIF c$$$* c$$$*" < 1. 時間刻みを足す > c$$$* c$$$ DO 1100 II = 1,6 c$$$ IDATEN( II ) = IDATE ( II ) c$$$ 1100 CONTINUE c$$$* c$$$ CALL ACTIME c$$$ I ( IDELT , '#' , 'SEC' , c$$$ O IDELS ) c$$$ IDATEN(6) = IDATEN(6) + IDELS c$$$* c$$$*" < 2. 繰上がり処理 > c$$$* c$$$ IF ( OPERPT ) THEN c$$$* c$$$* < 2.1 季節変化なし > c$$$* c$$$ c$$$ DO 2100 KK = 6, 5, -1 c$$$ IF ( IDATEN( KK ) .GE. IDMAX( KK ) ) THEN c$$$ IKURI = IDATEN( KK ) / IDMAX( KK ) c$$$ IDATEN( KK-1 ) = IDATEN( KK-1 ) + IKURI c$$$ IDATEN( KK ) = IDATEN( KK ) - IKURI * IDMAX( KK ) c$$$ ENDIF c$$$ 2100 CONTINUE c$$$ IDATEN( 4 ) = MOD( IDATEN( 4 ), IDMAX( 4 ) ) c$$$* c$$$ ELSE c$$$* c$$$* < 2.2 季節変化あり > c$$$* c$$$ DO 2200 KK = 6, 2, -1 c$$$ IF ( IDATEN( KK ) .GE. IDMAX( KK ) ) THEN c$$$ IKURI = IDATEN( KK ) / IDMAX( KK ) c$$$ IDATEN( KK-1 ) = IDATEN( KK-1 ) + IKURI c$$$ IDATEN( KK ) = IDATEN( KK ) - IKURI * IDMAX( KK ) c$$$ ENDIF c$$$ 2200 CONTINUE c$$$ IDATEN( 1 ) = MOD( IDATEN( 1 ), IDMAX( 1 ) ) c$$$ IF ( IDATE( 1 ) .LE. 0 ) THEN c$$$ IDATEN( 1 ) = IDATE( 1 ) c$$$ ENDIF c$$$* c$$$ ENDIF c$$$* c$$$ RETURN c$$$*====================================================================== c$$$ ENTRY DIDATE !" 日付の時刻差 c$$$ O ( IDELT , c$$$ I IDATEN, c$$$ I IDATE ) c$$$* c$$$ IYRDIF = IDATEN( 1 ) - IDATE( 1 ) c$$$* c$$$ IF ( (IDATEN( 1 ).LE.0) .OR. (IDATE( 1 ).LE.0) ) THEN c$$$ IYRDIF = 0 c$$$ ENDIF c$$$ IYRDIF = MAX( MIN( IYRDIF, 50 ), -50 ) c$$$* c$$$ IHORN = ( IDATEN( 2 )*IDMAX( 3 ) + IDATEN( 3 ) )* IDMAX( 4 ) c$$$ & + IDATEN( 4 ) c$$$ ISECN = ( IHORN *IDMAX( 5 ) + IDATEN( 5 ) )* IDMAX( 6 ) c$$$ & + IDATEN( 6 ) c$$$ IHOR = ( IDATE ( 2 )*IDMAX( 3 ) + IDATE ( 3 ) )* IDMAX( 4 ) c$$$ & + IDATE ( 4 ) c$$$ ISEC = ( IHOR *IDMAX( 5 ) + IDATE ( 5 ) )* IDMAX( 6 ) c$$$ & + IDATE ( 6 ) c$$$* c$$$ IDELS = IYRDIF * IDMAX(1)*IDMAX(2)*IDMAX(3)*IDMAX(4)*IDMAX(5) c$$$ & + ISECN - ISEC c$$$* c$$$ CALL ACTIME c$$$ I ( IDELS , 'SEC' , '#' , c$$$ O IDELT ) c$$$* c$$$ RETURN c$$$*====================================================================== c$$$ ENTRY RDATES !" 日付の小数化 c$$$ O ( RDATE , c$$$ I IDATE ) c$$$* c$$$ RDAY = IDATE( 2 )*IDMAX( 3 ) + IDATE( 3 ) c$$$ RDATE ( 1 ) = RDAY / ( IDMAX( 2 )*IDMAX( 3 ) ) c$$$* c$$$ RSEC = ( IDATE( 4 )*IDMAX( 5 ) + IDATE( 5 ) )*IDMAX( 6 ) c$$$ & + IDATE( 6 ) c$$$ RDATE ( 2 ) = RSEC / ( IDMAX( 4 )*IDMAX( 5 )*IDMAX( 6 ) ) c$$$* c$$$ RETURN c$$$ END