$STORAGE: 2 $NOFLOATCALLS c----------------------------------------------------------------------- c c Dany subroutine c c part of Mitch Wyle's DTC program c c Inputs: c im - month (number 1-12) c iy - year (either 1983 or 83) c c Outputs: c ib - integer corresponding to day of week c on which the month begins (1-7) c il - length of the month in days c c----------------------------------------------------------------------- c SUBROUTINE dany(ib,il,im,iy) c c Declarations: c integer im c Julian Month integer iy c Julian Year integer months(12) c array of months and the number c of days in each one c c Initialize: c data months/31,28,31,30,31,30,31,31,30,31,30,31/ If ( iy .gt. 1900 ) iy = iy - 1900 If ( ( iy .eq. 82 ) .and. ( im .eq. 1 ) ) then ib = 6 il = 31 return End If c c Now add up all of the days since January first nineteen hundred c eighty-two (which was a Friday) So: c idays = 1 c Total Number of days since 1/1/82 c Starts at 1 because first day of month Do 1 i=1,(im-1) c Add all previous months' days to sum idays = idays + months(i) 1 Continue ilp=(iy-81)/4 if(ilp.lt.0)ilp=0 itemp = iy - 82 If ( itemp .gt. 0 ) then Do 2 i=1,itemp idays = idays + 365 2 Continue idays=idays+ilp c leap years have 366 days End If itemp = itemp + 2 c c Leap year consideration: c 3 continue If ( ( mod ( itemp , 4 ) .eq. 0 ) .and. (itemp .ne. 0 ) .and. 1 ( im .gt. 2 ) ) then idays = idays + 1 itemp = itemp - 4 C goto 3 End If c c Now add five because 1/1/82 was a friday. c idays = idays + 5 ib = mod ( idays , 7 ) If ( ib .eq. 0 ) ib = 7 il = months(im) If ( ( im .eq. 2 ) .and. ( mod(iy,4) .eq. 0 ) ) il = il + 1 return end