Re: Algorithm for "1st Tuesday", "last Saturday", etc.


<mcalhoun@xxxxxxx> wrote in message news:detmju$8pb@xxxxxxxxxxxxxxxxxxx
> Can someone point me to an algorithm that, given a speific month and year,
> can convert "dates" such as "1st Tuesday", "last Saturday", etc. to actual
> numeric dates.
>

! This is just another calendar date problem thats simply solved using
! the AMAZING Fliegel and Van Flandern date algorithms
! -----------------
program find_dates
integer :: dw, ndw, month, year, date(3), jday

dw = 2 ! find a monday
ndw = 5 ! find the 5th monday
month = 08 ! in august
year = 2005 ! in 2005

jday = Date2Jday([year,month,01] ) ! Jday of 1st day in month

do jday = jday,jday+6
if ( mod(jday-5,7) == dw) exit ! found jday of 1st dw
end do
date = Jday2Date(jday+(ndw-1)*7)

write (*,91) 'date found = ',date ! 2005/08/29

91 format (a,i4,2('/',i2.2))
stop
contains
! -------------------------
function Date2Jday(date) result (jday)
integer :: date(3), yyyy,mm,dd, jday

yyyy = date(1) ; mm = date(2) ; dd = date(3)
jday = dd-32075+1461*(yyyy+4800+(mm-14)/12)/4 &
+ 367*(mm-2-(mm-14)/12*12)/12 - 3*((yyyy+4900+(mm-14)/12)/100)/4
end function Date2Jday

! -------------------------
function Jday2date (jday) result (date)
implicit none
integer :: jday, date(3)
integer :: yyyy, mm, dd, dw, m, n, i, j

m = jday+68569 ; n = 4*m/146097
m = m-(146097*n+3)/4 ; i = 4000*(m+1)/1461001
m = m-1461*i/4+31 ; j = 80*m/2447
dd = m-2447*j/80 ; m = j/11
mm = j+2-12*m
yyyy = 100*n+i+m-4900
date(1) = yyyy ; date(2) = mm ; date(3) = dd
end function Jday2date
end program


.