w3ymdh4.f

Go to the documentation of this file.

C> @file
C
C> SUBPROGRAM: W3YMDH4          4-BYTE DATE WORD UNPACKER AND PACKER
C>   AUTHOR: Brill,K.F.       ORG: NP/22       DATE: 98-07-29
C>
C> ABSTRACT: OBTAINS THE COMPONENTS OF THE NMC DATE WORD (NCEP Y2K
C>   COMPLIANT FORM), OR GIVEN ITS COMPONENTS, FORMS AN NMC TYPE DATE
C>   WORD.  THE PACKING IS DONE USING BASE 32.
C>
C>   If the first byte of IDATE is less than 101, then the old
C>   Office Note 84 packing is assumed.  A four-digit year is
C>   always returned.  To pack the "old" way, pass in a 2-digit
C>   year.
C>
C>   This program will work for the years ranging from A.D. 101
C>   through 79359.
C>
C>   On unpacking, years less than or equal to 100 are returned
C>   as follows:
C>
C>  0-50   2000--2050
C>  51-100 1951--2000
C>
C>
C> PROGRAM HISTORY LOG:
C>   98-07-29  K.F.BRILL
C> 1999-03-15  Gilbert      -   Removed Call to W3FS11 and put its
C>                              processing inline.  W3FS11 was deleted
C>                              from the W3LIB.
C>
C> USAGE:  CALL W3YMDH4 (IDATE, IYEAR, MONTH, IDAY, IHOUR, NN)
C>
C>   INPUT VARIABLES:
C>     NAMES  INTERFACE DESCRIPTION OF VARIABLES AND TYPES
C>     ------ --------- -----------------------------------------------
C>     IDATE  ARG LIST  LEFT 4 BYTES OF INTEGER 64 BIT WORD, OR CAN BE
C>                      CHARACTER*1 IDATE(4) OR CHARACTER*4 IDATE.
C>     IYEAR  ARG LIST  INTEGER   YEAR (4 DIGITS or 2 DIGITS for ON84)
C>     MONTH  ARG LIST  INTEGER   MONTH
C>     IDAY   ARG LIST  INTEGER   DAY
C>     IHOUR  ARG LIST  INTEGER   HOUR
C>     NN     ARG LIST  INTEGER   CODE:
C>                     .EQ. 0 PACK IYEAR, MONTH, IDAY, IHOUR INTO IDATE
C>                     .NE. 0 UNPACK IDATE INTO IYEAR, MONTH, IDAY, IHOUR
C>
C>   OUTPUT VARIABLES:
C>     NAMES  INTERFACE DESCRIPTION OF VARIABLES AND TYPES
C>     ------ --------- -----------------------------------------------
C>     IDATE  ARG LIST  LEFT 4 BYTES OF INTEGER 64 BIT WORD, OR CAN BE
C>                      CHARACTER*1 IDATE(4) OR CHARACTER*4 IDATE.
C>     IYEAR  ARG LIST  INTEGER   YEAR (4 DIGITS)
C>     MONTH  ARG LIST  INTEGER   MONTH
C>     IDAY   ARG LIST  INTEGER   DAY
C>     IHOUR  ARG LIST  INTEGER   HOUR
C>
C>   SUBROGRAMS CALLED:
C>     NAMES                                                   LIBRARY
C>     ------------------------------------------------------- --------
C>     CHAR                             F90
C>     MOVA2I                           W3
C>
C> ATTRIBUTES:
C>   LANGUAGE: CRAY CFT90 FORTRAN
C>   MACHINE:  CRAY Y-MP8/832
C>
      SUBROUTINE w3ymdh4 (IDATE,IYEAR,MONTH,IDAY,IHOUR,NN)
C
      CHARACTER IDATE(4)
C
      IF (nn.NE.0) THEN
C
    itemp = mova2i(idate(1))
    IF ( itemp .lt. 101 ) THEN
            iyear  = mova2i(idate(1))
            month  = mova2i(idate(2))
            iday   = mova2i(idate(3))
            ihour  = mova2i(idate(4))
        IF(iyear.LE.100) iyear=2050-mod(2050-iyear,100)
        RETURN
    END IF
    itemp = itemp - 101
    itemp = itemp * 256 + mova2i(idate(2))
    itemp = itemp * 256 + mova2i(idate(3))
    itemp = itemp * 256 + mova2i(idate(4))
    ihour = mod( itemp, 32 )
    itemp = itemp / 32
    iday  = mod( itemp, 32 )
    itemp = itemp / 32
    month = mod( itemp, 32 )
    iyear = itemp / 32
C
      ELSE
C
    itemp = iyear
    IF ( itemp .lt. 101 ) THEN
            idate(1) = char(iyear)
            idate(2) = char(month)
            idate(3) = char(iday)
            idate(4) = char(ihour)
        RETURN
    END IF
    itemp = itemp * 32 + month
    itemp = itemp * 32 + iday
    itemp = itemp * 32 + ihour
C*
    idate(4)=char(mod(itemp,256))
    itemp = itemp / 256
    idate(3)=char(mod(itemp,256))
    itemp = itemp / 256
    idate(2)=char(mod(itemp,256))
    itemp = itemp / 256
    itemp = itemp + 101
    idate(1)=char(itemp)
C
      ENDIF
C
      RETURN
      END