C+ C Check_Date C This subroutine will take a date string which is C rigidly formatted (dd-MMM-YYYY) and check it for C correctness. C C CALL Check_Date(Cdate,Ilength,Ierror) C C Where Cdate = CHARACTER*11 date string in format C DD-MMM-YYYY where C DD - 1 to 31 C MMM - JAN ...DEC C YYYY - Current_year to C Current_year+1 C Ilength = Length of date string (10 or 11 allowed) C Ierror = 0 if date string valid C -1 if invalid date string C- SUBROUTINE Check_Date(Cdate,Ilength,Ierror) CHARACTER*2 Cday ! CHARACTER*3 Cmonth ! CHARACTER*4 Cyear ! CHARACTER*11 Cdate ! CHARACTER*11 Ctmp ! CHARACTER*36 Cmonth_Lst ! LOGICAL*1 Leap INTEGER*2 Iday,Imonth,Iyear ! DATA Cmonth_Lst /'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ Leap=.FALSE. ! IF(Ilength.LT.10 .OR. ! - Ilength.GT.11) GOTO 9000! Date too short error CALL Upper_Case(Cdate(1:Ilength)) ! Convert to upper case IF(Ilength.EQ.10) Cdate(1:11)='0'//Cdate(1:10)! Make std format IF(Cdate(3:3).NE. '-' .OR. ! If not in dd-MMM-yyyy - Cdate(7:7).NE. '-') GOTO 9000! then error Cday =Cdate(1:2) ! Get day Cmonth=Cdate(4:6) ! Get month Cyear =Cdate(8:11) ! Get Year Ipos=INDEX(Cmonth_Lst,Cmonth) ! A valid month IF(Ipos.eq.0) GOTO 9000! Error if invalid month C C .. Convert string data to integers for numeric comparison C READ(Cday,10,ERR=9000)Iday ! Convert to integer 10 FORMAT(I2) ! READ(Cyear,20,ERR=9000) Iyear ! Convert to integ year 20 FORMAT(I4) ! Itmp=Iyear/4 ! IF((4*Itmp).EQ.Iyear) Leap=.TRUE. ! Must be leap Year IF(Iday.LT.1 .OR. ! Check for valid day - Iday.GT.31) GOTO 9000! Not a valid date C C .. Sanity check for leap year C IF(.NOT.Leap) THEN ! IF not leap year IF(Cmonth.EQ.'FEB' .AND. ! FEB is special, last day is - Iday.GT.28) GOTO 9000! 28 (except for leap year) ELSE ! Else IF(Cmonth.EQ.'FEB' .AND. ! FEB is special, last day is - Iday.GT.29) GOTO 9000! 29 in leap year END IF ! C C .. Check for months with only 30 days C Ipos=INDEX('APRJUNSEPNOV',Cmonth) ! Check if month has 30 days IF(Ipos.GT.0 .AND. ! If 31 entered, then bad - Iday.GT.30) GOTO 9000! date format C C .. Try to insure that the year is reasonable C CALL IDATE(Idy,Imon,Iyr) ! Get today's date Iyr=Iyr+1900 ! normalize IF(Iyear .LT. Iyr .OR. ! never can input a year - Iyear .GT. Iyr+1) GOTO 9000! less than or > 1 year away Ierror=0 ! Success RETURN ! 9000 Ierror=-1 ! Invalid date RETURN ! END