      SUBROUTINE W3FS15(IDATE,JTAU,NDATE)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:   W3FS15       UPDATING OFFICE NOTE 85 DATE/TIME WORD
C   PRGMMR: REJONES          ORG: NMC421     DATE: 89-08-23
C
C ABSTRACT: UPDATES OR BACKDATES A FULLWORD DATE/TIME WORD (O.N. 84)
C   BY A SPECIFIED NUMBER OF HOURS.
C
C PROGRAM HISTORY LOG:
C   ??-??-??  R.ALLARD
C   87-02-19  R.E.JONES  CLEAN UP CODE
C   87-02-19  R.E.JONES  CHANGE TO MICROSOFT FORTRAN 4.10
C   89-05-12  R.E.JONES  CORRECT ORDER OF BYTES IN DATE WORD FOR PC
C   89-08-04  R.E.JONES  CLEAN UP CODE, GET RID OF ASSIGN, CORRECTION
C                        FOR MEMORY SET TO INDEFINITE.
C   89-10-25  R.E.JONES  CHANGE TO CRAY CFT77 FORTRAN
C   95-11-15  R.E.JONES  ADD SAVE STATEMENT
C   02-10-15  VUONG       REPLACED FUNCTION ICHAR WITH MOVA2I
C
C USAGE:    CALL W3FS15 (IDATE, JTAU, NDATE)
C   INPUT ARGUMENT LIST:
C     IDATE    - PACKED BINARY DATE/TIME AS FOLLOWS:
C                BYTE 1  IS YEAR OF CENTURY  00-99
C                BYTE 2  IS MONTH            01-12
C                BYTE 3  IS DAY OF MONTH     01-31
C                BYTE 4  IS HOUR             00-23
C                SUBROUTINE TAKES ADVANTAGE OF FORTRAN ADDRESS
C                PASSING, IDATE AND NDATE MAY BE
C                A CHARACTER*1 ARRAY OF FOUR, THE LEFT 32
C                BITS OF 64 BIT INTEGER WORD. AN OFFICE NOTE 85
C                LABEL CAN BE STORED IN
C                4 INTEGER WORDS.
C                IF INTEGER THE 2ND WORD IS USED. OUTPUT
C                IS STORED IN LEFT 32 BITS. FOR A OFFICE NOTE 84
C                LABEL THE 7TH WORD IS IN THE 4TH CRAY 64 BIT
C                INTEGER, THE LEFT 32 BITS.
C     JTAU     - INTEGER  NUMBER OF HOURS TO UPDATE (IF POSITIVE)
C                OR BACKDATE (IF NEGATIVE)
C
C   OUTPUT ARGUMENT LIST:
C     NDATE    - NEW DATE/TIME WORD RETURNED IN THE
C                SAME FORMAT AS 'IDATE'. 'NDATE' AND 'IDATE' MAY
C                BE THE SAME VARIABLE.
C
C   SUBPROGRAMS CALLED:
C     LIBRARY:
C       W3LIB    - NONE
C
C   RESTRICTIONS: THIS ROUTINE IS VALID ONLY FOR THE 20TH CENTURY.
C
C   NOTES: THE FORMAT OF THE DATE/TIME WORD IS THE SAME AS THE
C     SEVENTH WORD OF THE PACKED DATA FIELD LABEL (SEE O.N. 84) AND
C     THE THIRD WORD OF A BINARY DATA SET LABEL (SEE O.N. 85).
C
C   EXIT STATES:
C     AN ERROR FOUND BY OUT OF RANGE TESTS ON THE GIVEN DATE/TIME
C     INFORMATION WILL BE INDICATED BY RETURNING A BINARY ZERO WORD
C     IN 'NDATE'.
C
C ATTRIBUTES:
C   LANGUAGE: CRAY CFT77 FORTRAN
C   MACHINE:  CRAY Y-MP8/832
C
C$$$
C
      INTEGER     ITABYR(13)
      INTEGER     LPTB(13)
      INTEGER     NOLPTB(13)
C
      CHARACTER*1 IDATE(4)
      CHARACTER*1 NDATE(4)
C
      SAVE
C
      DATA  LPTB  /0000,0744,1440,2184,2904,3648,4368,5112,
     &             5856,6576,7320,8040,8784/
      DATA  NOLPTB/0000,0744,1416,2160,2880,3624,4344,5088,
     &             5832,6552,7296,8016,8760/
      DATA  ICENTY/1900/
C
C     ...WHERE ICENTY IS FOR THE 20TH CENTURY ASSUMED FOR THE GIVEN
C     ...                 YEAR WITHIN THE CENTURY
C
      IYR    = MOVA2I(IDATE(1))
      IMONTH = MOVA2I(IDATE(2))
      IDAY   = MOVA2I(IDATE(3))
      IHOUR  = MOVA2I(IDATE(4))
C
      IF (IYR    .GT. 99) GO TO 1600
      IF (IMONTH .LE.  0) GO TO 1600
      IF (IMONTH .GT. 12) GO TO 1600
      IF (IDAY   .LE.  0) GO TO 1600
      IF (IDAY   .GT. 31) GO TO 1600
      IF (IHOUR  .LT.  0) GO TO 1600
      IF (IHOUR  .GT. 24) GO TO 1600
      IF (JTAU   .NE.  0) GO TO 100
C
        NDATE(1) = IDATE(1)
        NDATE(2) = IDATE(2)
        NDATE(3) = IDATE(3)
        NDATE(4) = IDATE(4)
        RETURN
C
  100 CONTINUE
        JAHR  = IYR + ICENTY
        KABUL = 1
        GO TO 900
C
C     ...WHERE 900 IS SUBROUTINE TO INITIALIZE ITABYR
C     ...AND RETURN THRU KABUL
C
  200 CONTINUE
        IHRYR  = IHOUR + 24 * (IDAY - 1) + ITABYR(IMONTH)
        IHRYR2 = IHRYR + JTAU
C
C     ...TO TEST FOR BACKDATED INTO PREVIOUS YEAR...
C
  300 CONTINUE
        IF (IHRYR2 .LT. 0) GO TO 700
C
      DO  400  M = 2,13
        IF (IHRYR2 .LT. ITABYR(M)) GO TO 600
  400 CONTINUE
C
C     ...IF IT FALLS THRU LOOP TO HERE, IT IS INTO NEXT YEAR...
C
        JAHR   = JAHR   + 1
        IHRYR2 = IHRYR2 - ITABYR(13)
        KABUL  = 2
        GO TO 900
C
  600 CONTINUE
        MONAT  = M      - 1
        IHRMO  = IHRYR2 - ITABYR(MONAT)
        NODAYS = IHRMO  / 24
        ITAG   = NODAYS + 1
        IUHR   = IHRMO  - NODAYS * 24
        GO TO 1500
C
C     ...ALL FINISHED.  RETURN TO CALLING PROGRAM.......................
C     ...COMES TO 700 IF NEG TOTAL HRS. BACK UP INTO PREVIOUS YEAR
C
  700 CONTINUE
        JAHR  = JAHR - 1
        KABUL = 3
        GO TO 900
C
C     ...WHICH IS CALL TO INITIALIZE ITABYR AND RETURN THRU KABUL
C
  800 CONTINUE
        IHRYR2 = ITABYR(13) + IHRYR2
        GO TO 300
C
C     ...SUBROUTINE INITYR...
C     ...CALLED BY GO TO 900 AFTER ASSIGNING RETURN NO. TO KABUL...
C     ...ITABYR HAS MONTHLY ACCUMULATING TOTAL HRS REL TO BEGIN OF YR.
C     ...DEPENDS ON WHETHER JAHR IS LEAP YEAR OR NOT.
C
  900 CONTINUE
        IQUOT  = JAHR / 4
        IRMNDR = JAHR - 4 * IQUOT
        IF (IRMNDR .NE. 0) GO TO 1000
C
C     ...WAS MODULO 4, SO MOST LIKELY A LEAP YEAR,
C
        IQUOT  = JAHR / 100
        IRMNDR = JAHR - 100 * IQUOT
        IF (IRMNDR .NE. 0) GO TO 1200
C
C     ...COMES THIS WAY IF A CENTURY YEAR...
C
        IQUOT  = JAHR / 400
        IRMNDR = JAHR - 400 * IQUOT
        IF (IRMNDR .EQ. 0) GO TO 1200
C
C     ...COMES TO 1000 IF NOT A LEAP YEAR...
C
 1000 CONTINUE
      DO  1100  I = 1,13
        ITABYR(I) = NOLPTB(I)
 1100 CONTINUE
      GO TO 1400
C
C     ...COMES TO 1200 IF LEAP YEAR
C
 1200 CONTINUE
      DO  1300  I = 1,13
        ITABYR(I) = LPTB(I)
 1300 CONTINUE
C
 1400 CONTINUE
        GO TO (200,300,800) KABUL
C
 1500 CONTINUE
        JAHR     = MOD(JAHR,100)
        NDATE(1) = CHAR(JAHR)
        NDATE(2) = CHAR(MONAT)
        NDATE(3) = CHAR(ITAG)
        NDATE(4) = CHAR(IUHR)
        RETURN
C
 1600 CONTINUE
        NDATE(1) = CHAR(0)
        NDATE(2) = CHAR(0)
        NDATE(3) = CHAR(0)
        NDATE(4) = CHAR(0)
C
C     ...WHICH FLAGS AN ERROR CONDITION ...
C
      RETURN
      END
