SUBROUTINE dtcalcdow (ib,il,im,iyx) c----------------------------------------------------------------------- c c DTCALCDOW subroutine c c part of Mitch Wyle's DTC program c c Inputs: c im - month (number 1-12) c iy - year (number 0-9999) 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 added number of days of c each month --- why sum a sequence of constants? c Modified 850802 by CG - renamed from DANY to DTCALCDOW, removed c default century and previously commented-out code c Modified 850809 by CG - Insure IB output in range 1..7: negative values c (from negative year input) caused DTCDSPMTH to zap its c character arrays and display some verrry strange-looking months! c c----------------------------------------------------------------------- c Declarations: c Base value for IDAYS, day-of-week for January 1, AD 1 ! parameter idow = 2 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 c Begin code iy = iyx ! Copy parameter c Take care of leap years: lpyear = 0 ! Assume "common" year if (islpyr(iy)) 1 then months(2) = 29 ! length of 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 Rather than add up all of the days since January First, AD 1 c (which would have been a Monday had the Gregorian calendar been in effect then), c we note that the 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 month 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 for March or later in leap year ib = mod ( idays , 7 ) ! Find day of week 0:6 if (ib .le. 0) ib = ib + 7 ! In case IY was negative (Sun is day 1) il = months(im) ! Length of the current month end