var/convertor/wave2grid_kma/CVDATE.inc

   1       SUBROUTINE CVDATE (IDNEW, ID, KTLAG)
   2 C     IMPLICIT DOUBLE PRECISION (A-H,O-Z,\)
   3 C     -------------------------------------------------------------
   4 C     ---  DATE CALCULATION ---
   5 C        ID   (5) :  INPUT  DATE  (YEAR, MONTH, DAY, HOUR, DAY OF WEEK)
   6 C        IDNEW(5) :  OUTPUT DATE
   7 C        KTLAG    :  TIME LAG BETWEEN (ID) AND (IDNEW)
   8 C                    IDNEW = ID  +  KTLAG (HOUR)
   9 C     -------------------------------------------------------------
  10       DIMENSION ID(5), IDNEW(5)
  11       INTEGER  MON(12) / 31,28,31,30,31,30,31,31,30,31,30,31 /
  12 C     -------------------------------------------------------------
  13       NTY = 365*24 ; NTY0=NTY ; NTYL=NTY
  14 C     -------------------------------------------------------------
  15       IF (MOD(ID(1)  , 4) .EQ. 0) NTY0 = NTY + 24
  16       IF (MOD(ID(1)-1, 4) .EQ. 0) NTYL = NTY + 24
  17 C     -------------------------------------------------------------
  18       IF (NTY0 .EQ. NTY) THEN ; MON(2) = 28
  19                          ELSE ; MON(2) = 29
  20       END IF
  21 C     -------------------------------------------------------------
  22       MONTH = ID(2)
  23       NTIME = 0
  24 C     -------------------------------------------------------------
  25       IF (MONTH .GE. 2) THEN
  26           DO 110 M=1,MONTH-1
  27                  NTIME = NTIME + MON(M)*24
  28  110      CONTINUE
  29       END IF
  30 C     -------------------------------------------------------------
  31       NTIME = NTIME + 24*(ID(3)-1) + ID(4)
  32       NTIME = NTIME + KTLAG
  33 C     -------------------------------------------------------------
  34       IF (NTIME .LT. 0) THEN
  35           IDNEW(1) = ID(1) - 1
  36           NTIME = NTIME + NTYL
  37       ELSE IF (NTIME .GE. NTY0) THEN
  38           IDNEW(1) = ID(1) + 1
  39           NTIME = NTIME - NTY0
  40       ELSE
  41           IDNEW(1) = ID(1)
  42       END IF
  43 C     -------------------------------------------------------------
  44       IF (MOD(IDNEW(1),4) .EQ. 0) THEN ; MON(2) = 29
  45                                   ELSE ; MON(2) = 28
  46       END IF
  47 C     -------------------------------------------------------------
  48       DO 150 M=1,12
  49              NTIME = NTIME - 24*MON(M)
  50              IF(NTIME .LT. 0) GO TO 160
  51  150  CONTINUE
  52 C     -------------------------------------------------------------
  53  160  CONTINUE
  54       IDNEW(2) = M
  55       NTIME    = NTIME + 24*MON(M)
  56       IDNEW(3) = NTIME / 24 + 1
  57       IDNEW(4) = MOD(NTIME, 24)
  58       IHOUR    = ID(4) + KTLAG  +  (7 * 24*10000)
  59       IDNEW(5) = MOD (ID(5)+IHOUR/24 , 7)
  60       IF (IDNEW(5) .EQ. 0) IDNEW(5) = 7
  61       RETURN
  62       END SUBROUTINE CVDATE
  63 C
  64 ! WRFVAR compiles at double precision by default, so DOUBLE PRECISION is
  65 ! overkill
  66 C      SUBROUTINE DATECK (ISTAT, IDATE, IBDATE, NDATE)
  67 C     IMPLICIT DOUBLE PRECISION (A-H,O-Z,\)
  68 C
  69 C JUDGE WHETHER IDATE IS YOUNGER OR OLDER THAN IDATEB
  70 C
  71 C (OUTPUT)
  72 C   ISTAT     : 'PAST', 'FUTR' AND 'SAME'
  73 C (INPUT)
  74 C   IDATE (5) : DATE.
  75 C   IBDATE(5) : BASE DATE.
  76 C   NDATE     : =1 ,COMPARE YEAR
  77 C               =2 ,        YEAR, MONTH
  78 C               =3 ,        YEAR, MONTH, DAY
  79 C               =4 ,        YEAR, MONTH, DAY, HOUR
  80 C
  81 C      DIMENSION IDATE(5), IBDATE(5)
  82 C
  83 C      DO 1000 J=1,NDATE
  84 C        IF(IDATE(J) .LT. IBDATE(J)) GO TO 1100
  85 C        IF(IDATE(J) .GT. IBDATE(J)) GO TO 1200
  86 C 1000 CONTINUE
  87
  88 C        ISTAT='SAME'
  89 C        RETURN
  90
  91 C 1100 CONTINUE
  92 C        ISTAT='PAST'
  93 C        RETURN
  94
  95 C 1200 CONTINUE
  96 C        ISTAT='FUTR'
  97 C        RETURN
  98 C
  99 C        END SUBROUTINE DATECK