SUBROUTINE dany(ib,il,im,iyx) 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 Modified 850117 by CG because it thought New Years 1985 was on Monday c when it really was on Tuesday (not counting intervening c leap years between 1982 and current as having 366 days). c Modified 850724 by Glenn Everhart to work for years between 1900 c and 1982 (formerly thought all intervening years started c on Friday) c Modified 850726 by CG to simplify days-since-base calculation. c NOTE: Has been reworked to calculate all dates AS IF c the Gregorian Calendar had been in effect since AD 1, c and that the Gregorian correction for 100 and 400 c will be valid indefinitely (the 1928 Episcopal c Book of Common Prayer indicates this is valid at least c until AD (or CE) 8400, but I don't think I, or anybody c reading this code within the forseeable future will be c around to verify whether it does or doesn't!), see note c just before IDAYS computation. It will also try to compute c if a negative year is input (i.e., BC) but probably won't be c valid since there was no year zero. If any calendar phreak c wants to figure it out for the Julian calendar, have fun, c just keep in mind that the Gregorian superseded the Julian c at different times and in different ways in different localities c (October 4, 1582 was followed by October 15 in Catholic c countries, and another "long sleep" occurred in September 1752 c in English-speaking realms, but apparently in Sweden c the change was effected by omitting Leap Years c until the calendar got back in sync c (there is a story of a man who didn't celebrate his first c birthday until he was sixty years old, leaving Frederic c of Pirates of Penzance with little to complain about)! c Russia, Romania, Greece and Turkey did not convert until c the twentieth century. c c P.S.: 4th parameter (input year) is no longer modified. c c Modified 850729 by CG - Get rid of loop that add number of days of c each month --- why sum a sequence of constants? c c----------------------------------------------------------------------- c c c Declarations: c c Base value for IDAYS, day-of-week for January 1, AD 1 ! parameter idow = 2 include 'defcentry.inc/list' ! Common parameter with DTCDATCVT integer im ! Julian Month integer iyx, iy ! Julian Year integer lpyear ! Define additive variable integer months(12) ! array of months and the number of days 1 /31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ ! in each one integer bomdow(12) ! array of months containing d/o/w 1 / 0, 3, 3, 6, 1, 4, 6, 2, 5, 0, 3, 5 / ! of first day of month include 'stmtfunc.for/nolist' ! Need ISLPYR function iy = iyx ! Copy parameter c Check for default century, add default if not present if (iy .lt. 100) iy = iy + icntry C C Take care of leap years: C lpyear = 0 ! Assume "common" year IF (islpyr(IY)) 1 THEN MONTHS(2)=29 ! length February in Leap year if (im .gt. 2) lpyear = 1 ! Add one to BOM DOW after Feb ELSE MONTHS(2)=28 ! .. "common" year END IF c --- If ( iy .gt. 1900 ) iy = iy - 1900 c --- If ( ( iy .eq. 01 ) .and. ( im .eq. 1 ) ) then c --- jan 1,1901 was a tuesday... c --- ib = 3 c --- il = 31 c --- return c --- End If c Rather than add up all of the days since January first, AD 1 c (which would have been a Tuesday), c we note that day of week of 1 January advances by 1 day per year, c plus another day the year after a leap year, etc, therefore just add c values of years, leap years, century years, etc, modulo 7, to figure out c day of week of the January we are interested in. itemp = iy - 1 ! not including current year idays = idow ! Day of week of 1/1/0001 1 + itemp ! plus number of years 2 + (itemp/4) ! plus number of leap years 3 - (itemp/100) ! less even hundreds 4 + (itemp/400) ! but add back even four hundreds 5 + bomdow(im) ! plus day of week for BOM 6 + lpyear ! plus 1 after March in leap year c *** Loop below removed, replaced by direct computation above - CG 850726 c --- If ( itemp .gt. 0 ) then c --- Do 2 i=1,itemp c --- idays = idays + 365 c --- if (mod (i, 4) .eq. 0) ! Intervening leap year? c --- 1 idays = idays + 1 ! Yes, count extra day c --- 2 Continue c --- End If c --- itemp = itemp + 2 ! No further reference - CG - 850117 c c c *** Removed loop, 850729 c --- Do 1 i=1,(im-1) ! Add all previous months' days to sum c --- idays = idays + months(i) c --- 1 Continue c *** Incorporated in initial value of iday c --- Now add two because 1/1/01 was a Tuesday. c --- idays = idays + 2 ib = mod ( idays , 7 ) If ( ib .eq. 0 ) ib = 7 il = months(im) return end