* PACKAGE ASTEP !" 共通 ステップ制御 
*
*"  [HIS] 90/05/19(numaguti) 
*"        92/04/17(numaguti) 季節変化なしオプション
*
*
**********************************************************************
      SUBROUTINE TIMSTP      !"  時刻制御 
     O         ( DELT  , OADVNC, ORSTR ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP  ,
     C           IDELT , INISTP, ITEND , IORSTR          )
*
      REAL       DELT                        !" 時間刻みΔｔ
      LOGICAL    OADVNC                      !" 時刻が進行するか否か
      LOGICAL    ORSTR                       !" リスタート出すか否か
      INTEGER    ITA                         !" 通し時間(t)
      INTEGER    ITB                         !" 通し時間(t-Δt)
      INTEGER    IDATEA( * )                 !" 時刻年月日時分秒
      INTEGER    IDATEB( * )                 !" 時刻年月日時分秒
      INTEGER    ISTEP                       !" 通しステップ数
      INTEGER    IDELT                       !" 標準時間刻み
      INTEGER    INISTP                      !" 初期ステップ数
      INTEGER    ITEND                       !" 計算終了時刻
      INTEGER    IORSTR                      !" 出力間隔：再出発
*
*    [INTERNAL SAVE]     
      INTEGER    ITAZ
      INTEGER    ITBZ
      INTEGER    ITNZ
      INTEGER    IDAZ  ( 6 )
      INTEGER    IDBZ  ( 6 )
      INTEGER    IDNZ  ( 6 )
      INTEGER    IDATEN( 6 )
      INTEGER    ISTEPZ
      REAL       DELTZ
      LOGICAL    OADVZ
      SAVE
*    [INTERNAL WORK]
      INTEGER    IDELTX, ITN, II
*
*"         < 1. Δｔ の進行 >
*
      IF ( ISTEP .GT. INISTP ) THEN
*
*"       ----- normal --------
*
         OADVNC = .TRUE.
         DELT   = IDELT
*
      ELSE
*"       ----- initial -------
*
         OADVNC = .FALSE.
         DELT  = IDELT  / ( 2. **(INISTP-ISTEP) )
*
      ENDIF
*
*"         < 2. 次の時刻(N) >
*
      CALL ACTIME
     I         ( NINT(DELT)  , 'SEC'  , '#'    ,
     O           IDELTX                         )
*
      IF ( OADVNC ) THEN
*
         ITN = ITA + IDELTX
         CALL AIDATE
     O      ( IDATEN,
     I        IDATEA, IDELTX )
*
      ELSE
*
         ITN = ITB + IDELTX
         CALL AIDATE
     O      ( IDATEN,
     I        IDATEB, IDELTX )
*
      ENDIF
*
*"         < 3. リスタート出力フラグ >
*
      IF ( ITA .GE. ITEND ) THEN
         ORSTR = .TRUE.
      ELSE IF ( IORSTR .LE. 0 ) THEN
         ORSTR = .FALSE.
      ELSE IF ( ITA/IORSTR .GT. ITB/IORSTR ) THEN
         ORSTR = .TRUE.
      ELSE
         ORSTR = .FALSE.
      ENDIF
*
*"         < 4. 内部設定 >
*
      DELTZ  = DELT
      OADVZ  = OADVNC
*
      ITNZ = ITN
      DO 4100 II = 1,6
         IDNZ( II ) = IDATEN( II )
 4100 CONTINUE
*
*"    ---------------------------------------------------------------
      ENTRY      SETTIM
     I         ( ITA   , ITB   , IDATEA, IDATEB, ISTEP  )
*
      ITBZ = ITB
      ITAZ = ITA
      DO 4200 II = 1,6
         IDAZ( II ) = IDATEA( II )
         IDBZ( II ) = IDATEB( II )
 4200 CONTINUE
      ISTEPZ = ISTEP
*
      RETURN
*=====================================================================
      ENTRY      ADVSTP      !"  時刻進行 
     O         ( ITA   , ITB   , IDATEA, IDATEB,
     I           OADVNC                          )
*
      IF ( OADVNC ) THEN
         ITB  = ITAZ
         ITA  = ITNZ
         ITBZ = ITB
         ITAZ = ITA
         DO 5100 II = 1,6
            IDATEB( II ) = IDAZ  ( II )
            IDATEA( II ) = IDNZ  ( II )
            IDBZ  ( II ) = IDATEB( II )
            IDAZ  ( II ) = IDATEA( II )
 5100    CONTINUE
*
      ELSE
         ITB  = ITBZ
         ITA  = ITNZ
         ITAZ = ITA
         DO 5200 II = 1,6
            IDATEB( II ) = IDBZ  ( II )
            IDATEA( II ) = IDNZ  ( II )
            IDAZ  ( II ) = IDATEA( II )
 5200    CONTINUE
*
      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
***********************************************************************
      SUBROUTINE AIDATE      !"  日付の更新 
     O        ( IDATEN,
     I          IDATE ,
     I          IDELT  )
*
*"        (* 理想的暦 1年=12ヵ月=360日            *)
*
      INTEGER    IDATEN( * )                 !" 時刻年月日時分秒
      INTEGER    IDATE ( * )                 !" 時刻年月日時分秒
      INTEGER    IDELT                       !" 時間刻み
*
*    [INTERNAL WORK]     
      REAL       RDATE ( 2 )                 !" 季節, 時刻
      INTEGER    IFPAR, JFPAR, II, KK, IKURI
      INTEGER    IDELS, IYRDIF, IHORN, IHOR
      INTEGER    ISECN, ISEC
      REAL       RDAY, RSEC
*
*    [INTERNAL PARAM]     
      INTEGER    IDMAX( 6 )                  !" 時刻の最大値
      DATA       IDMAX / 1000000, 12, 30, 24, 60, 60 /
*
      LOGICAL    OPERPT
      DATA       OPERPT / .FALSE.  /         !" 日付の変更なし
*
      NAMELIST  /NMCALN/ OPERPT, IDMAX
      SAVE               OPERPT, IDMAX
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE       OFIRST
*
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' CALENDAR  DATE=92/04/17'
         OFIRST = .FALSE.
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMCALN, END=190 )
  190    WRITE  ( JFPAR, NMCALN )
      ENDIF
*
*"         < 1. 時間刻みを足す >
*
      DO 1100 II = 1,6
         IDATEN( II ) = IDATE ( II )
 1100 CONTINUE
*
      CALL ACTIME
     I         ( IDELT  , '#'  , 'SEC'    ,
     O           IDELS                       )
      IDATEN(6) = IDATEN(6) + IDELS
*
*"         < 2. 繰上がり処理 >
*
      IF ( OPERPT ) THEN
*
*              < 2.1  季節変化なし >
*

         DO 2100 KK = 6, 5, -1
            IF ( IDATEN( KK ) .GE. IDMAX( KK ) ) THEN
               IKURI          = IDATEN( KK )   / IDMAX( KK )
               IDATEN( KK-1 ) = IDATEN( KK-1 ) + IKURI
               IDATEN( KK )   = IDATEN( KK )   - IKURI * IDMAX( KK )
            ENDIF
 2100    CONTINUE
         IDATEN( 4 ) = MOD( IDATEN( 4 ), IDMAX( 4 ) )
*
      ELSE
*     
*             < 2.2  季節変化あり >
*
         DO 2200 KK = 6, 2, -1
            IF ( IDATEN( KK ) .GE. IDMAX( KK ) ) THEN
               IKURI          = IDATEN( KK )   / IDMAX( KK )
               IDATEN( KK-1 ) = IDATEN( KK-1 ) + IKURI
               IDATEN( KK )   = IDATEN( KK )   - IKURI * IDMAX( KK )
            ENDIF
 2200    CONTINUE
         IDATEN( 1 ) = MOD( IDATEN( 1 ), IDMAX( 1 ) )
         IF ( IDATE( 1 ) .LE. 0 ) THEN
            IDATEN( 1 ) = IDATE( 1 )
         ENDIF
*
      ENDIF
*
      RETURN
*======================================================================
      ENTRY     DIDATE      !"  日付の時刻差 
     O        ( IDELT ,
     I          IDATEN,
     I          IDATE  )
*
      IYRDIF = IDATEN( 1 ) - IDATE( 1 )
*
      IF ( (IDATEN( 1 ).LE.0) .OR. (IDATE( 1 ).LE.0) ) THEN
         IYRDIF = 0
      ENDIF
      IYRDIF = MAX( MIN( IYRDIF, 50 ), -50 )
*
      IHORN  = ( IDATEN( 2 )*IDMAX( 3 ) + IDATEN( 3 ) )* IDMAX( 4 )
     &        +  IDATEN( 4 )
      ISECN  = ( IHORN      *IDMAX( 5 ) + IDATEN( 5 ) )* IDMAX( 6 )
     &        +  IDATEN( 6 )
      IHOR   = ( IDATE ( 2 )*IDMAX( 3 ) + IDATE ( 3 ) )* IDMAX( 4 )
     &        +  IDATE ( 4 )
      ISEC   = ( IHOR       *IDMAX( 5 ) + IDATE ( 5 ) )* IDMAX( 6 )
     &        +  IDATE ( 6 )
*
      IDELS = IYRDIF * IDMAX(1)*IDMAX(2)*IDMAX(3)*IDMAX(4)*IDMAX(5)
     &      + ISECN - ISEC
*
      CALL ACTIME
     I         ( IDELS  , 'SEC'  , '#'    ,
     O           IDELT                       )
*
      RETURN
*======================================================================
      ENTRY      RDATES      !"  日付の小数化 
     O         ( RDATE ,
     I           IDATE  )
*
      RDAY = IDATE( 2 )*IDMAX( 3 ) + IDATE( 3 )
      RDATE ( 1 ) = RDAY / ( IDMAX( 2 )*IDMAX( 3 ) )
*
      RSEC = ( IDATE( 4 )*IDMAX( 5 ) + IDATE( 5 ) )*IDMAX( 6 ) 
     &     +   IDATE( 6 )
      RDATE ( 2 ) = RSEC / ( IDMAX( 4 )*IDMAX( 5 )*IDMAX( 6 ) ) 
*
      RETURN
      END
