C JULIAN DATE ROUTINES
C CALLS:
C	N=JULIAN(YY/MM/DD)
C	RETURNS JULIAN DATE BASED ON 1/1/80 FOR THAT DATE
C
C	CALL JULASC(N,STRADR)
C	TAKES JULIAN DATE AND DECODES TO ASCII YY/MM/DD
C
C	N=JULMDY(IYR,IMO,IDA)
C	RETURNS JULIAN DATE GIVEN SEPARATE Y,M,D
C
	FUNCTION JULIAN(DATST)
	INTEGER*4 DATST(2),DAT(2)
	LOGICAL*1 DATSTR(8)
	LOGICAL*1 YRST(2),MOST(2),DAST(2)
	EQUIVALENCE(DATSTR(1),DAT(1))
	EQUIVALENCE(YRST(1),DATSTR(1)),(MOST(1),DATSTR(4))
	EQUIVALENCE(DAST(1),DATSTR(7))
	DAT(1)=DATST(1)
	DAT(2)=DATST(2)
	IJUL=1
	DECODE(2,1,YRST,ERR=2)IYR
1	FORMAT(I2)
	DECODE(2,1,MOST,ERR=2)IMO
	DECODE(2,1,DAST,ERR=2)IDA
	IJUL=JULMDY(IYR,IMO,IDA)
2	CONTINUE
	JULIAN=IJUL
	RETURN
	END
	FUNCTION JULMDY(IYR,IMO,IDA)
	InTEgeR*4 MLEN(12)
	DATA MLEN/31,28,31,30,31,30,31,31,30,31,30,31/
C JULIAN DATE FROM Y,M,D
C BASE=1/1/81
	IJUL=1
	IF(IYR.LT.80)GOTO 999
	IYR=IYR-81
	IF(IMO.LE.0.OR.IMO.GT.12)GOTO 999
	IF(IDA.GT.31)GOTO 999
C JUST RETURN ILLEGAL ENTRIES AS 1/1/80
	AC=365.25*FLOAT(IYR)
	IAC=AC
C SLIGHTLY CRUDE BUT WORKABLE TREATMENT OF YEARS
	IJUL=IJUL+IAC
C NOW ADD IN MONTHS.
	IF(IMO.GT.2.AND.MOD(IYR+1,4).EQ.0)IJUL=IJUL+1
C ABOVE ACCOUNTS FOR LEAP YEARS
	III=IMO-1
	IF(III.LE.0)GOTO 22
	DO 2 N=1,III
2	IJUL=IJUL+MLEN(N)
22	CONTINUE
C NEXT DO DAYS
	IJUL=IJUL+IDA-1
C JUST ADD IN DAYS. SHOULD BE GOOD ENOUGH.
999	CONTINUE
	JULMDY=IJUL
	RETURN
	END
	SUBROUTINE JULASC(N,DATST,IYR,IMO,IDA)
C CONVERT JULIAN DATE N INTO ASCII STRING STR
	INTEGER*4 DATST(2),DAT(2)
	LOGICAL*1 DATSTR(8)
	LOGICAL*1 YRST(2),MOST(2),DAST(2)
	EQUIVALENCE(DAT(1),DATSTR(1))
	EQUIVALENCE(YRST(1),DATSTR(1)),(MOST(1),DATSTR(4))
	EQUIVALENCE(DAST(1),DATSTR(7))
	InTEgeR*4 MLEN(12)
	DATA MLEN/31,28,31,30,31,30,31,31,30,31,30,31/
	DATSTR(3)='/'
	DATSTR(6)='/'
C FIRST SUBTRACT OFF WHOLE YEARS
	IYR=N/365
	N=N-(365*IYR)
C ADJUST FOR LEAP YRS SINCE 1981
	IAC=IYR/4
	N=N-IAC
	MLEN(2)=28
C Fix up length of February for leap years
	If(Mod((Iyr+81),4).eq.0) MLEN(2)=29
C NOW SUBTRACT OFF MONTHS AS LONG AS POSSIBLE
	DO 1 NN=1,12
	IMO=NN
	IF(N.LE.MLEN(NN))GOTO 2
	N=N-MLEN(NN)
1	CONTINUE
2	CONTINUE
	IDA=N
	IYR=IYR+81
	ENCODE(2,3,YRST,ERR=5)IYR
3	FORMAT(I2)
	ENCODE(2,3,MOST,ERR=5)IMO
	ENCODE(2,3,DAST,ERR=5)IDA
5	CONTINUE
	IF(YRST(1).EQ.' ')YRST(1)='0'
	IF(MOST(1).EQ.' ')MOST(1)='0'
	IF(DAST(1).EQ.' ')DAST(1)='0'
	DATST(1)=DAT(1)
	DATST(2)=DAT(2)
C USE INTEGERS SINCE REAL*8 MIGHT OMIT FULL COPY IF
C EXPONENT BYTE IS 0, AND CHARS MAY CAUSE NORMALIZATION
C PROBLEMS SOMETIMES.
	RETURN
	END
	SUBROUTINE WKDY(JULLO,JULHI,NDAYS)
C GIVEN START AND END JULIAN DATE, FIGURE OUT HOW MANY WEEK DAYS
C THERE ARE BETWEEN THEM.
	JL=JULLO
	JH=JULHI
	IF(JL.LE.JH)GOTO 10
	JL=JULHI
	JH=JULLO
10	CONTINUE
	IDL=(JH-JL)/7
C GET NUMBER OF WEEKS BETWEEN DAYS, 5 WORKDAYS PER WHOLE WEEK.
	IWDY=IDL*5
C ADD 3 SO THAT MODULO OF SUNDAY IS 0, NOT WED.
	IDOR=JH-JL-7*(IDL)
	IF(IDOR.NE.0)IDOR=5
C IDOR IS ORIGINAL # DAYS DIFFERENCE, CORRECTED FOR WHOLE
C WEEKS ALREADY ALLOWED.
	LD=JL+3
	LD=MOD(LD,7)
	LH=JH+3
	LH=MOD(LH,7)
C NOW HAVE DAY OF WEEK START,END. FIND WORK DAYS THAT WEEK (M-F ONLY)
	IKLU=0
	IK2=1
	IF(LD.LT.1)IK2=0
	IF(LD.LT.1)LD=1
	IF(LD.GT.5)LD=5
C FOR HIGH END OF RANGE IF THE END DATE IS SUNDAY SUBTRACT ONE DAY
C FROM THE DAYS SO WE OMIT THE MONDAY FROM THE RANGE...
	IF(LH.LT.1)IKLU=IK2
	IF(LH.LT.1)LH=1
	IF(LH.GT.5)LH=5
C LH = DAY ENDED ON, LD=START DAY, FORCED INTO WORK WEEK.
	IF (LH.GT.LD)IWDY=IWDY+LH-LD-IKLU
	IF (LH.LE.LD)IWDY=IWDY+IDOR-(LD-LH)-IKLU
C GIVES DAYS BETWEEN 2 DATES JUST LIKE JULIAN DATE SUBTRACTION FOR
C CALENDAR DATES.
	NDAYS=IWDY
	RETURN
	END
	SUBROUTINE WRKINT(JULLO,NWDY,JULHI)
C GETS JULLO = START DATE AND NWDY = NO. WORKDAYS (M-F) TO ADD AND
C FINDS JULHI = END JULIAN DATE, CONSTRAINED TO BE IN MONDAY TO
C FRIDAY RANGE.
C MUST ADD 3 BECAUSE THAT'S THE BIAS OF OUR JULIAN DATE BASE.
	IDJL=MOD(JULLO+3,7)
C IDJL = DAY CODE OF START DATE
	NWWK=NWDY/5
	JL=JULLO
	IF(IDJL.LT.1)JL=JL+1
	IF(IDJL.GT.5)JL=JL+2
C BUMP START INTERVAL...
	NWDD=NWDY-5*NWWK
	JL=JL+NWWK*7+NWDD
	IDJL=MOD(JL+3,7)
	IF(IDJL.LT.1)JL=JL+1
	IF(IDJL.GT.5)JL=JL+2
C FORCE OUTPUT DATE TO BE WITHIN WORKWEEK
	JULHI=JL
	RETURN
	END
