ndate.f

Go to the documentation of this file.

C> @file
C> COMPUTE VERIFYING DATE
C> @author IREDELL @date 1998-08-18
C>
C> PROGRAM TO COMPUTE VERIFYING DATE
C> GIVEN THE FORECAST HOUR AND THE INITIAL DATE.
C>
C> PROGRAM HISTORY LOG:
C> -  95-02-28  IREDELL
C> -  97-09-22  IREDELL  4-DIGIT YEAR ALLOWED; 2-DIGIT YEAR STANDARDIZED
C> -  98-03-25  IREDELL  4-DIGIT YEAR FOR ALL DATES.  A 2-DIGIT YEAR WILL
C>                      BE INTERPRETED AS A YEAR IN THE FIRST CENTURY
C>                      WHICH SHOULD BE ALL RIGHT BEFORE THE YEAR 2000.
C>                      STANDARD ERROR WARNINGS WILL BE GIVEN FOR SUCH
C>                      DATES UNTIL 1 SEPT 1998 AFTER WHICH NDATE ABORTS.
C>                      NDATE WILL ALSO ABORT AFTER 1 SEPT 1998 IF THE
C>                      NOW IRRELEVANT -Y OPTION IS INVOKED.
C>                      THE NEW Y2K-COMPLIANT W3LIB PACKAGE IS USED.
C> - 1998-08-17  IREDELL  DROP-DEAD DATE RESET TO 1 SEPT 1999
C> - 1999-01-26  VUONG    CHANGED TO USE 4-DIGIT YEAR AS STANDARDIZED FOR
C>                      ALL DATES AND CONVERTED TO IBM RS/6000 SP AND 
C>                      MODIFIED PROGRAM TO CALL ROUTINE GETARG INSTEAD OF
C>                      USING SUBROUTINE GETARG AS A FUNCTION.
C> - 1999-09-02  IREDELL  UNDID RESTRICTION ON FORECAST HOUR
C>
C> USAGE:      ndate [fhour [idate]]
C>   INPUT ARGUMENT LIST
C>   -  FHOUR    - FORECAST HOUR (MAY BE NEGATIVE)
C>                FHOUR DEFAULTS TO ZERO.
C>   -  IDATE    - INITIAL DATE IN YYYYMMDDHH FORMAT.
C>                IDATE DEFAULTS TO THE CURRENT UTC DATE AND HOUR.
C>                FIRST CENTURY DATES WILL CAUSE ABORT AFTER 1 SEPT 1999.
C>   OUTPUT ARGUMENT LIST:
C>   -  NDATE    - VERIFYING DATE IN YYYYMMDDHH FORMAT.
C>   EXIT STATES:
C>   -  0      - SUCCESS
C>   -  1      - FAILURE; INVALID ARGUMENT
C>   -  2      - FAILURE; INCORRECT NUMBER OF ARGUMENTS
C>
C> SUBPROGRAMS CALLED:
C> -  IARGC           GET NUMBER OF ARGUMENTS
C> -  GETARG          GET ARGUMENT
C> -  W3DIFDAT        RETURN A TIME INTERVAL BETWEEN TWO DATES
C> -  W3MOVDAT        RETURN A DATE FROM A TIME INTERVAL AND DATE
C> -  W3PRADAT        FORMAT A DATE AND TIME INTO CHARACTERS
C> -  W3UTCDAT        RETURN THE UTC DATE AND TIME
C> -  ERRMSG          WRITE A MESSAGE TO STDERR
C> -  EXIT            EXIT PROGRAM
C>
      PROGRAM ndate
      CHARACTER*256 CARG,CFMT
      INTEGER*4 IARG,LARG,NCARG,NARG,IARGC
      INTEGER IDAT(8),JDAT(8)
      REAL RINC(5)
      LOGICAL W3VALDAT
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  GET AND CHECK OPTIONAL ARGUMENTS
      narg=iargc()
      iarg=1
      lstopt=0
      dowhile(iarg.LE.narg.AND.lstopt.EQ.0)
        CALL getarg(iarg,carg)
        larg=len_trim(carg)
        iarg=iarg+1
        IF(carg(1:1).NE.'-'.OR.
     &    (carg(2:2).GE.'0'.AND.carg(2:2).LE.'9')) THEN
          lstopt=1
          iarg=iarg-1
        ELSEIF(larg.EQ.1) THEN
          CALL errmsg('ndate: Invalid option -')
          CALL eusage
          CALL errexit(1)
        ELSE
          l=2
          dowhile(l.LE.larg)
            IF(carg(l:l).EQ.'-') THEN
              lstopt=1
            ELSE
              CALL errmsg('ndate: Invalid option '//carg(l:l))
              CALL eusage
              CALL errexit(1)
            ENDIF
            l=l+1
          ENDDO
        ENDIF
      ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  CHECK NUMBER OF ARGUMENTS
      marg=narg-iarg+1
      IF(marg.GT.2) THEN
        CALL errmsg('ndate: Incorrect number of arguments')
        CALL eusage
        CALL errexit(2)
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  GET AND CHECK FIRST ARGUMENT (HOUR INCREMENT)
      IF(marg.GE.1) THEN
        CALL getarg(iarg,carg)
        ncarg=len_trim(carg)
        WRITE(cfmt,'("(I",I2,")")') ncarg
        READ(carg,cfmt,iostat=iret) ihour
        IF(iret.NE.0) THEN
          CALL errmsg('ndate: Noninteger forecast hour '//carg(1:ncarg))
          CALL eusage
          CALL errexit(1)
        ENDIF
      ELSE
        ihour=0
      ENDIF
      rinc=0
      rinc(2)=ihour
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  GET AND CHECK SECOND ARGUMENT (INITIAL DATE)
      IF(marg.GE.2) THEN
        CALL getarg(iarg+1,carg)
        ncarg=len_trim(carg)
        WRITE(cfmt,'("(I",I2,",3I2)")') ncarg-6
        idat=0
        READ(carg,cfmt,iostat=iret) idat(1),idat(2),idat(3),idat(5)
        IF(iret.NE.0.OR..NOT.w3valdat(idat)) THEN
          CALL errmsg('ndate: Invalid date '//carg(1:ncarg))
          CALL eusage
          CALL errexit(1)
        ENDIF
      ELSE
        CALL w3utcdat(idat)
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  COMPUTE AND PRINT NEW DATE
      CALL w3movdat(rinc,idat,jdat)
      nd=log10(jdat(1)+0.5)+1
      WRITE(cfmt,'("(I",I2,",3I2.2)")') nd
      print cfmt,jdat(1),jdat(2),jdat(3),jdat(5)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      CONTAINS
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  WRITE USAGE
      SUBROUTINE eusage
      CALL errmsg('Usage: ndate [fhour [idate]]')
      ENDSUBROUTINE
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      ENDPROGRAM