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 visiously hacked by dean elsner 27feb85: fix leapyear bug, which c starts @ jan 1 1985: old code commented out, new code is c hopefully self-explanatory. c SUBROUTINE dany(ib,il,im,iy) c c Declarations: c integer im ! Julian Month integer iy ! Julian Year integer months(12) ! array of months and the number ! 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 ! Total Number of days since 1/1/82 ! Starts at 1 because first day of month Do 1 i=1,(im-1) ! Add all previous months' days to sum idays = idays + months(i) 1 Continue itemp = iy - 82 If ( itemp .gt. 0 ) then Do 2 i=1,itemp idays = idays + 365 2 Continue End If itemp = itemp + 2 c c Leap year consideration: c c++++++++++++++++++++++++++++++++++++ old (faulty) code below ++++++++++++++ c3 continue c If ( ( mod ( itemp , 4 ) .eq. 0 ) .and. (itemp .ne. 0 ) .and. c 1 ( im .gt. 2 ) ) then c idays = idays + 1 c itemp = itemp - 4 c goto 3 c End If c------------------------------------- new code here ---------------------- c c We add 1 day for every leap year since 1982 c idays = idays + itemp/4 c c But we must not add the last day if we are Jan or Feb of a leap year c since the last leap doesn't happen until March of the leap year c IF ( mod(itemp,4).eq.0 .and. im.le.2 ) idays = idays - 1 c c+++++++++++++++++++++++++++++++++++++ end of hack ++++++++++++++++++++++ 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