 |
forums.silverfrost.com Welcome to the Silverfrost forums
|
| View previous topic :: View next topic |
| Author |
Message |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
Posted: Sat Oct 25, 2025 3:33 pm Post subject: code to calculate weekday for a given date |
|
|
Here is a short function that calculates the day of the week in the Gregorian (prolated, if appropriate) calendar. The returned value: (1=Sunday,7=Saturday); The inputs: the year (positive integer), month (1 to 12) and the day of the month (1 to 31, user to check for valid value before invoking function)
| Code: |
integer function dow(y,m,d)
integer, intent(in)::y,m,d
integer :: yy,cc,v,dm,e2
integer :: mc(12)=[3,0,0,4,2,6,4,1,5,3,0,5] !first dmsd of month,cmnY J.Conway
integer :: ml(12)=[4,1,0,4,2,6,4,1,5,3,0,5] !first dmsd of month, leapY J.Conway
logical :: leap
cc=int(y/100)
yy=mod(y,100)
if(yy.eq.0)then
leap=mod(y,400).eq.0
else
leap=mod(y,4).eq.0
endif
e2=mod(cc,4)+mod(yy,4)-1; dm=mod(5*e2+10*yy,7) !Nakai formula for doomsday of year
if(leap)then
v=d - ml(m) + dm
else
v=d - mc(m) + dm
endif
dow=mod(max(v,v+7),7)+1
return
end function dow
|
The algorithm is the well-known John Conway algorithm, which is described in, among many places, Wikipedia. (Conway died in 2020 from complications caused by Covid-19) .
Last edited by mecej4 on Thu Oct 30, 2025 3:04 pm; edited 4 times in total |
|
| Back to top |
|
 |
simon
Joined: 05 Jul 2006 Posts: 307
|
Posted: Mon Oct 27, 2025 4:09 pm Post subject: |
|
|
| You may need to add a check for the year. A positive integer is not going to give correct results for years before the transition from the Julian to the Gregorian calendar, and when that transition occurred depends on which country you are in, so it can get a real mess! however, I suspect that for most applications the year of interest will be sufficiently recent. |
|
| Back to top |
|
 |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
Posted: Mon Oct 27, 2025 5:57 pm Post subject: |
|
|
Thanks for your cautionary notes, they are quite appropriate. George Washington has two birthdays for such reasons, and I even read that a Dutch military unit won a battle before the date marked on their written orders, which reached them many days after the battle was over.
Another potential source of error/confusion is the matter of whether the first day of a week is Sunday (as in the US, UK, etc.), Monday (EU countries, ISO), Saturday (many Islamic countries) or some other day. |
|
| Back to top |
|
 |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
Posted: Tue Oct 28, 2025 2:39 pm Post subject: |
|
|
Here is a list of years in which May 31 occurs on Sunday. This list may be used to create a test program for verifying the DOW(y,m,d) function.
1970, 1981, 1987, 1992, 1998, 2009, 2015, 2020, 2026, 2037
| Code: |
subroutine may()
integer :: y
do y=1970,2037
if(dow(y,5,31).eq.1) print *,y
end do
return
end subroutine may
|
|
|
| Back to top |
|
 |
Kenneth_Smith
Joined: 18 May 2012 Posts: 855 Location: Lanarkshire, Scotland.
|
Posted: Wed Oct 29, 2025 10:46 am Post subject: |
|
|
Here is a function to do the required check before calling DOW.
| Code: |
logical function is_valid_date(y, m, d)
! Returns .true. if (y, m, d) is a valid proleptic Gregorian calendar date.
implicit none
integer, intent(in) :: y, m, d
integer :: D_each_M(12)
is_valid_date = .true.
D_each_M = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
if (m .lt. 1 .or. m .gt. 12) then
is_valid_date = .false.
return
end if
! Leap-year rule:
! - A year is a leap year if it is divisible by 4,
! except that years divisible by 100 are not leap years,
! except again that years divisible by 400 are leap years.
if ( (mod(y,4) .eq. 0 .and. mod(y,100) .ne. 0) .or. mod(y,400) .eq. 0 ) then
if (m .eq. 2) D_each_M(2) = 29
end if
if (d .lt. 1 .or. d .gt. D_each_M(m)) is_valid_date = .false.
end function is_valid_date |
|
|
| Back to top |
|
 |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
Posted: Wed Oct 29, 2025 1:47 pm Post subject: |
|
|
| Thanks Kenneth, for providing your code for checking the input arguments to DOW() . |
|
| Back to top |
|
 |
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2428 Location: Yateley, Hants, UK
|
Posted: Wed Oct 29, 2025 6:09 pm Post subject: |
|
|
| Aren't there routines for doing this in the FTN77 library? |
|
| Back to top |
|
 |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
Posted: Wed Oct 29, 2025 7:23 pm Post subject: Re: |
|
|
| LitusSaxonicum wrote: |
| Aren't there routines for doing this in the FTN77 library? |
There are routines for obtaining the current date in various formats and for format conversion, but not for obtaining the weekday for a future or past day.
There are Windows calls for obtaining and manipulating time and date structures, but no day_of_week(given year, month, day of month). |
|
| Back to top |
|
 |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
Posted: Thu Oct 30, 2025 2:50 pm Post subject: |
|
|
Here is a little puzzle that can be solved using a DOW() function.
Find years in the range 1901 to 2099 for which:
(i) the weekdays of January 1 and December 31 are the same, and
(ii) December 13 is a Sunday.
Verify, for the years found, that the 13th days of February, March and November are Fridays.
Hint: The year 2026 is one such year . |
|
| Back to top |
|
 |
Kenneth_Smith
Joined: 18 May 2012 Posts: 855 Location: Lanarkshire, Scotland.
|
Posted: Thu Oct 30, 2025 10:27 pm Post subject: |
|
|
In the DOW() function, in the line:
| Code: |
| dow = mod(max(v, v+7),7) + 1 |
it appears that the code is trying to keep v positive but the expression mod(max(v, v+7),7) is not equivalent to mod(v,7) for all possible negative v values.
As the actual range for v generated by the proceeding code in dow() is from -5 to 37 the existing expression mod(max(v, v+7),7) + 1 happens to work, but it’s not completely general.
The alternative
| Code: |
| dow = mod(mod(v,7) + 7,7) + 1 |
would ensure dow is always 1-7 even if v is a larger negative value as shown below.
| Code: |
program test_mod_difference
implicit none
integer :: v, dow1, dow2
print '(a)', ' v | dow1 = mod(max(v,v+7),7)+1 | dow2 = mod(mod(v,7)+7,7)+1'
print '(a)', '---------------------------------------------------------------'
do v = -10, 10
dow1 = mod(max(v, v+7),7) + 1
dow2 = mod(mod(v,7) + 7,7) + 1
print '(i6,6x,i4,26x,i4)', v, dow1, dow2
end do
end program test_mod_difference
|
The double-mod form -- mod(mod(v,7)+7,7) -- is a reliable way to wrap any integer v into the range 0 to 6. The inner mod(v,7) reduces v by multiples of 7, but in Fortran the result keeps the same sign as v. If v is negative, the inner result is also negative. By adding 7, we shift it into the positive range, but it could be larger than 6. Applying the outer mod(...,7) then reduces it again to fall between 0 and 6. This two-step approach guarantees that the final value is always in the correct range, no matter whether v started positive or negative, and avoids errors that occur when trying to adjust negative values in a single step.
So I thought I was seeing a potential problem, that's not real in this particular case. Suffice to say, I have been caught out by this before now! |
|
| Back to top |
|
 |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
Posted: Thu Oct 30, 2025 11:24 pm Post subject: |
|
|
We could also use the MODULO() intrinsic function instead of MOD():
dow = modulo(v,7)+1
This may not suit users of Fortran 77.
I, too, have found myself making errors with code involving signed integer values passed as arguments to MOD(). Not enough practice, I suppose! |
|
| Back to top |
|
 |
simon
Joined: 05 Jul 2006 Posts: 307
|
Posted: Fri Oct 31, 2025 4:57 am Post subject: Re: |
|
|
| mecej4 wrote: |
| ... and I even read that a Dutch military unit won a battle before the date marked on their written orders, which reached them many days after the battle was over. |
I am unaware of the Dutch example, but the most famous example is the Battle of the Ulm when Napoleon defeated the Austrians because the Russian army understood to meet on a date that was 12 later than the Austrians expected. The Austrians had already changed to the Gregorian calendar, but the Russians only changed in 1918 (in fact, the Orthodox Church still uses the Gregorian calendar, which is why Christmas is celebrated in Russia on 7 January in the Julian calendar). But it is questionable whether this story is true.
Anyway, you can get a list of the dates of change here:
https://en.wikipedia.org/wiki/List_of_adoption_dates_of_the_Gregorian_calendar_by_country
To include checks on all of these in DOW would be rather painful, but it may be worth selecting one of them depending on where your program is running. |
|
| Back to top |
|
 |
mecej4
Joined: 31 Oct 2006 Posts: 1917
|
|
| Back to top |
|
 |
arctica
Joined: 10 Sep 2006 Posts: 148 Location: United Kingdom
|
Posted: Wed Nov 05, 2025 4:22 pm Post subject: |
|
|
This is an interesting problem that gets more complicated pre-1582. The code works for 1582 or later, but falls over for earlier dates. From what I found, Sunday was the first day of the week from 321CE after Emperor Constantine.
| Code: |
program main
implicit none
integer :: y, m, d, dow
logical :: valid
character(len=9) :: day_name(7)
! Day names, Sunday = 1
day_name = ['Sunday ', 'Monday ', 'Tuesday ', 'Wednesday', &
'Thursday ', 'Friday ', 'Saturday ']
print *, "Enter year, month, and day:"
read(*,*) y, m, d
valid = is_valid_date(y, m, d)
if (valid) then
dow = day_of_week_mixed(y, m, d)
write(*,'("The input date ", I4.4, "-", I2.2, "-", I2.2, " is a valid date (", A, ").")') &
y, m, d, trim(day_name(dow))
else
write(*,'("The input date ", I4.4, "-", I2.2, "-", I2.2, " is NOT a valid date.")') y, m, d
end if
contains
!-----------------------------------------------
logical function is_valid_date(y, m, d)
implicit none
integer, intent(in) :: y, m, d
integer :: D_each_M(12)
D_each_M = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
is_valid_date = .true.
if ((m < 1 .or. m > 12) .or. (d < 1 .or. d > D_each_M(m))) then
is_valid_date = .false.
end if
! Leap-year rule (Gregorian)
if ((mod(y,4) == 0 .and. mod(y,100) /= 0) .or. mod(y,400) == 0) then
if (m == 2) D_each_M(2) = 29
else if (y < 1582 .or. (y == 1582 .and. (m < 10 .or. (m == 10 .and. d < 5)))) then
! Julian leap-year rule before Gregorian reform
if (mod(y,4) == 0 .and. m == 2) D_each_M(2) = 29
end if
! Missing days during the reform
if (y == 1582 .and. m == 10 .and. d > 4 .and. d < 15) then
is_valid_date = .false.
end if
end function is_valid_date
!-----------------------------------------------
integer function day_of_week_mixed(y, m, d)
! Compute day of week correctly across Julian and Gregorian calendars
implicit none
integer, intent(in) :: y, m, d
integer :: jd
jd = julian_day_number(y, m, d)
day_of_week_mixed = mod(jd + 1, 7) + 1
! Sunday = 1, Monday = 2, ..., Saturday = 7
end function day_of_week_mixed
!-----------------------------------------------
integer function julian_day_number(y, m, d)
! Returns Julian Day Number for any date (handles both calendars)
implicit none
integer, intent(in) :: y, m, d
integer :: a, b, yy, mm
yy = y
mm = m
if (m <= 2) then
yy = yy - 1
mm = mm + 12
end if
if ( (y > 1582) .or. (y == 1582 .and. (m > 10 .or. (m == 10 .and. d >= 15))) ) then
! Gregorian calendar
a = yy / 100
b = 2 - a + a / 4
else
! Julian calendar
b = 0
end if
julian_day_number = int(365.25d0 * (yy + 4716)) + int(30.6001d0 * (mm + 1)) + d + b - 1524
end function julian_day_number
end program main
|
|
|
| Back to top |
|
 |
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 8281 Location: Salford, UK
|
Posted: Wed Nov 05, 2025 5:42 pm Post subject: |
|
|
| The Gregorian calandar started in 1582. |
|
| Back to top |
|
 |
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|