mdate.f

Go to the documentation of this file.

C> @file
C>
C> UPDATE A DATE GIVEN INCREMENT IN MINUTES
C> @author KEYSER  @date 2001-09-20
C>
C> PROGRAM TO COMPUTE A VERIFYING DATE GIVEN AN INCREMENT IN
C> MINUTES AND THE INITIAL DATE.
C>
C> PROGRAM HISTORY LOG:
C> - 2001-09-20  KEYSER   BASED ON UTILITY PROGRAM NDATE EXCEPTS UPDATES
C>                      BY MINUTES INSTEAD OF HOURS
C>
C>   INPUT ARGUMENT LIST
C>   -  MINUTES  - INCREMENT IN MINUTES (MAY BE NEGATIVE)
C>                MINUTES DEFAULTS TO ZERO.
C>   -  IDATE    - INITIAL DATE IN YYYYMMDDHHMM FORMAT.
C>                IDATE DEFAULTS TO THE CURRENT UTC DATE, HOUR AND
C>                MINUTE.  FIRST CENTURY DATES WILL CAUSE ABORT AFTER
C>                1 SEPT 1999.
C>   OUTPUT ARGUMENT LIST:
C>   -  MDATE    - VERIFYING DATE IN YYYYMMDDHHMM 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>  - W3MOVDAT        RETURN A DATE FROM A TIME INTERVAL AND DATE
C>  - W3UTCDAT        RETURN THE UTC DATE AND TIME
C>  - ERRMSG          WRITE A MESSAGE TO STDERR
C>  - ERREXIT         EXIT PROGRAM (W3LIB)
C>
      PROGRAM mdate
      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('mdate: 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('mdate: 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('mdate: Incorrect number of arguments')
        CALL eusage
        CALL errexit(2)
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  GET AND CHECK FIRST ARGUMENT (MINUTE INCREMENT)
      IF(marg.GE.1) THEN
        CALL getarg(iarg,carg)
        ncarg=len_trim(carg)
        WRITE(cfmt,'("(I",I2,")")') ncarg
        READ(carg,cfmt,iostat=iret) iminute
        IF(iret.NE.0) THEN
          CALL errmsg('mdate: Noninteger minute '//carg(1:ncarg))
          CALL eusage
          CALL errexit(1)
        ENDIF
      ELSE
        iminute=0
      ENDIF
      rinc=0
      rinc(3)=iminute
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  GET AND CHECK SECOND ARGUMENT (INITIAL DATE YYYYMMDDHHMM)
      IF(marg.GE.2) THEN
        CALL getarg(iarg+1,carg)
        ncarg=len_trim(carg)
        WRITE(cfmt,'("(I",I2,",4I2)")') ncarg-8
        idat=0
        READ(carg,cfmt,iostat=iret) idat(1),idat(2),idat(3),idat(5),
     &   idat(6)
        IF(iret.NE.0.OR..NOT.w3valdat(idat)) THEN
          CALL errmsg('mdate: 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,",4I2.2)")') nd
      print cfmt,jdat(1),jdat(2),jdat(3),jdat(5),jdat(6)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      CONTAINS
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  WRITE USAGE
      SUBROUTINE eusage
      CALL errmsg('Usage: mdate [minutes [idate]]')
      ENDSUBROUTINE
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      ENDPROGRAM