day of week function

[rahzan]

Is there a Date related function which converts a given date to the correspondig day of week (sat-sun). I have found only LDATE which requires seconds since 1973 as input!

if not, any hints on where to find such algorithm will be appreciated.

Tim H

[pcurtis]

Here is what you're looking for (and some related
material as well):



FUNCTION julian_date (yyyy, mm, dd) RESULT (julian)
IMPLICIT NONE
! converts calendar date to Julian date
! cf Fliegel & Van Flandern, CACM 11(10):657, 1968
! example: julian_date(1970,1,1)=2440588
INTEGER,INTENT(IN) :: yyyy,mm,dd
INTEGER :: julian
julian = 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 julian_date


SUBROUTINE get_ymd (jd, yyyy, mm, dd)
IMPLICIT NONE
! expands a Julian date into a calendar date
! cf Fliegel & Van Flandern, CACM 11(10):657, 1968
INTEGER,INTENT(IN) :: jd
INTEGER,INTENT(OUT) :: yyyy,mm,dd
INTEGER :: l,n
l = jd + 68569
n = 4*l/146097
l = l - (146097*n + 3)/4
yyyy = 4000*(l + 1)/1461001
l = l - 1461*yyyy/4 + 31
mm = 80*l/2447
dd = l - 2447*mm/80
l = mm/11
mm = mm + 2 - 12*l
yyyy = 100*(n - 49) + yyyy + l
END SUBROUTINE get_ymd


INTEGER FUNCTION dow (yyyy,mm,dd)
IMPLICIT NONE
! Day_Of_Week: (0=Sunday,1=Monday...6=Saturday)
! cf J.D.Robertson, CACM 15(10):918
INTEGER,INTENT(IN) :: yyyy,mm,dd
dow = MOD((13*(mm+10-(mm+10)/13*12)-1)/5+dd+77 &
+5*(yyyy+(mm-14)/12-(yyyy+(mm-14)/12)/100*100)/4 &
+(yyyy+(mm-14)/12)/400-(yyyy+(mm-14)/12)/100*2,7)
END FUNCTION dow


INTEGER FUNCTION ndiy (yyyy,mm,dd)
IMPLICIT NONE
! day count in year
! cf J.D.Robertson, CACM 15(10):918
INTEGER,INTENT(IN) :: yyyy,mm,dd
ndiy = 3055*(mm+2)/100-(mm+10)/13*2-91 &
+(1-(MOD(yyyy,4)+3)/4+(MOD(yyyy,100)+99)/100 &
-(MOD(yyyy,400)+399)/400)*(mm+10)/13+dd
END FUNCTION ndiy