The subroutine calculates the day of week given current datetime, where DAYW = 1 corresponds to Monday and DAYW = 7 to Sunday. The algorithm is based on the tables in "Hvem Hva Hvor 1971" (p. 121) and is valid for all years from 1800 to infinity
Adapted from EPISODE code
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | date_array(6) |
Datetime [y,m,d,h,m,s] |
Day of week [1-7]
function day_of_week (date_array) result(res) !! The subroutine calculates the day of week given current datetime, !! where DAYW = 1 corresponds to Monday and DAYW = 7 to Sunday. The !! algorithm is based on the tables in "Hvem Hva Hvor 1971" (p. 121) !! and is valid for all years from 1800 to infinity !! !! Adapted from EPISODE code integer, intent(in) :: date_array(6) !! Datetime [y,m,d,h,m,s] integer :: res !! Day of week [1-7] ! Local variables integer :: jm(12) = [1, 5, 5, 2, 7, 4, 2, 6, 3, 1, 5, 3] ! Column number for each month integer :: ir ! Row in HHH table for day of month integer :: jc ! Column in HHH table for month integer :: nt ! Number in HHH table for row ir and column jc integer :: jk ! Column in HHH table for year integer :: j4, j100, j400 ! Adjustment values for leap year logical :: leap ! If leap year then true else false integer :: daym, mnth, year ! Extract values from array daym = date_array(3) mnth = date_array(2) year = date_array(1) ! Calculate leap year or not leap = .false. if (mod(year, 4) .eq. 0 .and. .not. (mod(year, 100) .eq. 0 .and. mod(year, 400) .ne. 0)) leap = .true. ! Calculate row number for day of month ir = mod(daym - 1, 7) + 1 ! Calculate column number for month jc = jm(mnth) if (leap .and. (mnth .eq. 1 .or. mnth .eq. 2)) jc = jc + 1 ! Calculate "number" in HHH table with row IR and column JC nt = mod(ir + 7 - jc, 7) + 1 ! Calculate column number for year (adjusting for leap years) j4 = (year - 1800)/4 j100 = (year - 1800)/100 j400 = (year - 1600)/400 jk = mod(year - 1800 + j4 - j100 + j400 + 3 - 1, 7) + 1 ! Calculate day of week res = mod(jk - 1 + nt - 1, 7) + 1 end function day_of_week