REAL FUNCTION RCVTDA (DATE, IPOS, IRET) C***************************************************************************** C C Description : This routine convert a date given in notation dd-mmm-yyyy to C a real number indicating the number of days past start of C century. Note that the first year of the century is assumed C to have a 29th of February. The year can be given in both C yy and yyyy. The month can be given both in upper case and C lower case and in mixed mode as well. C C Arguments : DATE = STRING with the date C IPOS = optional C input: C INTEGER position in STRING to start search for date C output: C INTEGER position of first character not belonging C to the date specification plus 1, or position of C end-string-character (=zero-byte). C if not given input 1 is assumed, no output C IRET = return code C -1 - illegal date in string C 1 - normal return C 2 - leading non-spaces C 4 - trailing non-spaces C C Author : R. Beetz C AKZO PHARMA, Oss Holland C dept. SDA C C Version : V1.1 Date : 03-jan-83 C C Module name : RCVTDA.FTN C C Package : RSX-LIBRARY C C Compilation/Linking : FOR/F4P/TR:NONE RCVTDA C C Updates : name version C H.A.M. Fikke V1.1 C description : IPOS optional C C***************************************************************************** BYTE DATE(1),HMONTH(4) INTEGER*2 NDAY(12) DATA NDAY/31,29,31,30,31,30,31,31,30,31,30,31/ C IRET=1 IP=1 IF (LARG(2)) IP=IPOS C IDAY=ICVTS(DATE,IP,IRTRN) !get day IF (IRTRN .LE. 0) GOTO 980 !error IF ((IRTRN.AND.2) .GT. 0) IRET=IRET.OR.2 !leading non-spaces IF (DATE(IP-1) .NE. '-') GOTO 980 !wrong seperator C HMONTH(1)=DATE(IP) !get month HMONTH(2)=DATE(IP+1) HMONTH(3)=DATE(IP+2) HMONTH(4)=0 IP=IP+4 IF (DATE(IP-1) .NE. '-') GOTO 980 !wrong seperator CALL SCVTLU(HMONTH) MONTH=(INDEX('JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC',HMONTH)+2)/3 IF (MONTH .LE. 0) GOTO 980 !illegal month IF (IDAY.LT.1 .OR. IDAY.GT.NDAY(MONTH)) GOTO 980 !ill. number of days C IYEAR=ICVTS(DATE,IP,IRTRN) !get year IF ((IRTRN.LE.0) .OR. ((IRTRN.AND.2) .NE. 0)) GOTO 980 !error IF ((IRTRN.AND.4) .GT. 0) IRET=IRET.OR.4 !trailing non-spaces IF (IYEAR .GT. 1000) IYEAR=MOD(IYEAR,100) IF (IYEAR.LT.0 .OR. IYEAR.GT.99) GOTO 980 !illegal year IF (IDAY.EQ.29 .AND. MONTH.EQ.2) 10,20,20 C THEN 10 IF (MOD(IYEAR,4) .NE. 0) GOTO 980 !29-FEB allowed? C ENDIF 20 GOTO 990 C 980 IRET=-1 !error in date RCVTDA=0 GOTO 999 C 990 RCVTDA=0 IF (IYEAR .GT. 0) RCVTDA=IYEAR*365. + (IYEAR-1)/4 + 1. DO 991 I=1,MONTH-1 IF (MONTH .EQ. 1) GOTO 991 RCVTDA=RCVTDA+NDAY(I) 991 CONTINUE IF (MONTH.GT.2 .AND. MOD(IYEAR,4).NE.0) RCVTDA=RCVTDA-1 RCVTDA=RCVTDA+IDAY C 999 IF (LARG(2)) IPOS=IP RETURN END