Code review. (D Munro problem 2.12)

Hi all,

Slowly working through the example problems in a Fortran book (an old one D Monro from 1981).
This is all just for fun, but would like comments on how I could have done things differently.

The problem is to calculate the day of the week (Mon, Tues, Wed, etc) from a date which the user is asked to enter.
(I got really stuck, with my days off by 1, since I’m so used to arrays starting at 0 and not 1. That kept me busy for a while. )
Cheers,
Bob.

program dayoftheweek
    implicit none

    ! D Monro
    ! Computing with Fortran IV (1981 reprint)
    ! Problem 2.12
    ! 31 Dec 1899 was a Sunday.
    ! Write a program to find the day of the week for any date in the
    ! 20th century.
    !
    ! www.timeanddate.com/date/durationresult.html used to check results.
    !
    ! 31 Dec 1899 was a Sunday
    ! Leap year if year mod 4 == 0
    ! Century is leap year if century mod 400 == 0; 1900 not, 2000 yes

    ! Jan(01) 31  Feb(02) 28  Mar(03) 31  Apr(04) 30  May(05) 31  Jun(06) 30
    ! Jul(07) 31  Aug(08) 31  Sep(09) 30  Oct(10) 31  Nov(11) 30  Dec(12) 31

    integer :: n
    integer :: date_in_month
    integer :: month_in_year
    integer :: year, track_year
    integer :: days_in_year
    integer, dimension(12) :: days_in_month
    character(len=3), dimension(7) :: days_in_week
    integer :: start_year, start_month, start_day
    integer :: zeroday ! value of 0 is Sunday, see days_in_week below.

    integer :: acc_days  ! accumulated days

    days_in_month=[31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
    days_in_week=[character(len=3) :: 'SUN', 'MON', 'TUE', 'WED', 'THU', 'FRI', 'SAT']
    
    acc_days = 0
    
    days_in_year = 0
    do n = 1, 12
        days_in_year = days_in_year + days_in_month(n)
    end do
    
    start_year = 1899
    start_month = 12
    start_day = 31
    zeroday = 0

    print *, 'Calculate the weekday for an entered data DD, MM, YYYY:'
    print *, '  Enter date in the month (DD)'
    read *, date_in_month
    if ((date_in_month < 1) .OR. (date_in_month > 31)) then
        print *, 'Error. DD not in range 1..31'
        stop
    end if
    
    print *, '  Enter month in the year (MM)'
    read *, month_in_year
    if ((month_in_year < 1) .OR. (month_in_year > 12)) then
        print *, 'Error. MM not in range 1..12'
        stop
    end if
    
    print *, '    Enter year (YYYY)'
    read *, year
    if (year .LE. 1899) then
        print *, 'Error. YYYY to be > 1899'
        stop
    end if
    
    !
    !  YEAR section
    !
    n = start_year + 1
    acc_days = 0
    do while (n .NE. year)
        acc_days = acc_days + days_in_year
        print *, '  Yeaar section: Added ', days_in_year, ' for year ', n
        if (mod(n, 4) .EQ. 0) then ! leap year
            if (mod(n, 400) .NE. 0) then ! leap century
                acc_days = acc_days + 1   ! add in the leap day
                print *, '  Year section: Added leap day'
            end if
        end if
        n = n + 1  ! increment year index
    end do
    track_year = n
    
    !
    ! MONTH section
    !
    n = 1
    do while (n .NE. month_in_year)
        acc_days = acc_days + days_in_month(n)
        print *, '  Month section: ', days_in_month(n), ' day for month ', n
        n = n + 1  ! increment month index
    end do
    
    !
    ! DAY section
    !
    acc_days = acc_days + (date_in_month - 1)
    print *, '  Day section: Added ', date_in_month-1, ' days to end.'
    if ( (mod(track_year, 4).EQ.0) .AND. (month_in_year .GT. 2)) then ! leap year
        if (mod(track_year, 400) .NE. 0) then ! leap century
            acc_days = acc_days + 1   ! add in the leap day
            print *, ' Day section: Added leap day'
        end if
    end if
    
    print *, '  Debug: ACC_DAYS = ', acc_days
    zeroday = zeroday + mod(acc_days, 7)
    n = acc_days - ((acc_days / 7) * 7)
    print *, 'User day lands on ', days_in_week(zeroday+1)
    print *, '  MOD days is ', mod(acc_days, 7)
    print *, '  Integer day is ', n
           
end program dayoftheweek

Not sure what is going wrong, but my suspicion is the use of MOD(): it returns a value between 0 (!) and the modulo minus one. On the other hand, your week days start with sunday. Is that the correct definition?

Starting the week with Sunday is traditional among Christians and Jews. Some calendars now start weeks on Sunday and some on Monday.

On another matter @BB_UK may wish to know that Fortran arrays can be made to start at 0. Having started using Fortran over 60 years ago I find the Python and C convention annoying.

Hm, according to Wikipedia (Gregorian calendar - Wikipedia) the week often starts at monday being day 1, ISO 8601. In North America the week typically starts on Sundays. YMMV :slight_smile:

Also, the POSIX structure for time breakdown counts from 0 to 6, with 0 being Sunday.

I just skimmed over the code, but here are some suggestions. You could compute

days_in_year = sum(days_in_month)

rather than in a loop. Fortran has lots of useful intrinsic array functions like this. Or, if you are trying to squeeze every last bit of performance out of the code, this is just a constant value that could be defined as a parameter and computed at compile time rather than at run time.

When testing for range errors, as in

    if ((date_in_month < 1) .OR. (date_in_month > 31)) then
        print *, 'Error. DD not in range 1..31'
        stop
    end if

why stop? Why not just reprompt the user for a correct number?

When totaling the value of acc_days, the code adds up year by year in a loop. Why not just multiply the number of years by the number of days per year and then adjust for leap years afterward?

The month section computes the adjustment for acc_days in a loop. This could be done simply with an array lookup, by month, with precomputed offset values.

The arrays days_in_month and days_in_week are constant. They could be parameters rather than variables.

The expression n=acc_days-((acc_days/7)*7) is just a long way of computing a mod(). I think you see that in the code, but if you look at the way the intrinsic is defined, that is what you will see. There is something to watch for, in general, but it does not apply to this code. The value of mod(N,7) will in general be in the range -6 to 6 where the negative values come from negative values for N. if you instead want return values in the range of 0 to 6, then you should use the fortran intrinsic modulo(N,7). The two intrinsics agree for N>=0.

As mentioned by others, in fortran you can index arrays with any lower bound you want, 0, 1, 42, -42, whatever. If it is easier to index an array from 0, then do so.

All in all, I think this is a good first effort with the language.

Hi Arjen,
Yes, the problem specifically stated the start date to use; Sun 31 Dec 1899
I too wanted to use Monday as day zero, but because it was already into the next century then I ran into issues of having to cater for ‘being in 1900’ rather than ‘moving into 1900’
I went back to Sunday ! LOL

Bob.

Wow ! Thanks Ron.

There is a good amount to go over here.

Yes, I took the rather non-performant route of dealing with individual years, then months, then days as I wanted a simple way to check my results as the program progressed.

‘The month section’ … could be done .. array lookup … precomputed offset values…
I don’t quite follow what you are saying. Would you mind a small code snippet to explain.

Ah, yes, MOD, I thought I was misunderstanding how the MOD call worked so did my own. I should have taken that out.
I didn’t know MOD -6 would return a negative. That would have caught me out one day.

As for indexing an array from 0, I did do this firstly (by mistake), but got no output. Perhaps I need to use a compiler setting for that. (I’m using nvfortran)

Many thanks for your comments, really, it is most appreciated.
Bob.

Fortran has always had the simplistic notion that if you have an array of n elements, you refer to them from 1 to n. Fortran 77 introduced the ability to define a non-default lower bound:
character(len=3), dimension(7) :: days_in_week
when zero-based would become:
character(len=3), dimension(0:6) :: days_in_week

In your program, the days are constants. So I’d also suggest parameterizing the array (in this example, zero-based). Allows for some additional compiler checks to ensure the array isn’t unintentionally modified. Might even place the data on a read-only page in memory:

    character(len=3), parameter :: days_in_week(0:6) = [  &
         'SUN', 'MON', 'TUE', 'WED', 'THU', 'FRI', 'SAT']
1 Like

Ok, I started with your code and rewrote parts of it based on my previous comments. Here is how it ended up:

edit: I simplified the code a little and used the fortran merge() intrinsic instead of an if test.

program dayoftheweek
   implicit none

   ! D Monro
   ! Computing with Fortran IV (1981 reprint)
   ! Problem 2.12
   ! 31 Dec 1899 was a Sunday.
   ! Write a program to find the day of the week for any date in the
   ! 20th century.
   !
   ! www.timeanddate.com/date/durationresult.html used to check results.
   !
   ! 31 Dec 1899 was a Sunday
   ! Leap year if year mod 4 == 0
   ! Century is leap year if century mod 400 == 0; 1900 not, 2000 yes

   ! Jan(01) 31  Feb(02) 28  Mar(03) 31  Apr(04) 30  May(05) 31  Jun(06) 30
   ! Jul(07) 31  Aug(08) 31  Sep(09) 30  Oct(10) 31  Nov(11) 30  Dec(12) 31

   integer :: n
   integer :: date_in_month
   integer :: month_in_year
   integer :: year
   integer :: day_of_week
   integer :: acc_days
   logical :: qleap_year

   integer, parameter :: days_in_month(12) = [31, 28, 31, 30,  31,  30,  31,  31,  30,  31,  30,  31]
   integer, parameter :: day_offset(12) =    [ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334]
   !integer, parameter :: day_offset(12) = [0,(sum(days_in_month(1:n-1)), n=2,12)]
   integer, parameter :: days_in_year = sum(days_in_month)
   character(len=3), parameter :: days_in_week(0:6) = &
        & [character(len=3) :: 'SUN', 'MON', 'TUE', 'WED', 'THU', 'FRI', 'SAT']
   integer, parameter :: dec31_1899 = 109207

   print *, 'Calculate the weekday for an entered data DD, MM, YYYY:'
   do
      print *, 'Enter DD MM YYYY:'
      read *, date_in_month, month_in_year, year
      
      if (year .LE. 1899) then
         print *, 'Error. YYYY to be > 1899'
         cycle
      end if
      if ((month_in_year < 1) .OR. (month_in_year > 12)) then
         print *, 'Error. MM not in range 1..12'
         cycle
      end if
      qleap_year = is_leap_year(year)
      n = days_in_month(month_in_year) + merge(1,0,qleap_year .and. month_in_year==2) ! feb-29.
      if ( (date_in_month < 1) .or. (date_in_month > n) ) then
         print *, 'Error. DD not in range 1..', n
         cycle
      end if
      exit  ! input date is ok.
   enddo

   n = year - 1601                          ! previous years since 1600.
   acc_days = n * days_in_year &            ! normal days in previous years.
        &     + n / 4 &                     ! previous leap years (overcount).
        &     - n / 100 &                   ! previous century years (overcount).
        &     + n / 400 &                   ! previous 400 year cycles.
        &     + day_offset(month_in_year) & ! normal days in previous months of current year.
        &     + merge(1,0,qleap_year .and. (month_in_year > 2)) & ! feb-29 of the current year.
        &     + date_in_month &             ! days in the current month.
        &     - dec31_1899                  ! adjust to 31-dec-1899.

   day_of_week = modulo( acc_days, 7 )

   print *, 'Debug: ACC_DAYS = ', acc_days
   print *, 'User day lands on ', days_in_week(day_of_week)
   print *, 'Integer day is ', day_of_week

contains

   logical function is_leap_year( year )
      integer, intent(in) :: year
      is_leap_year =  (modulo(year,400)==0) .or. ((modulo(year,4)==0) .and. (modulo(year,100).ne.0))
      return
   end function is_leap_year

end program dayoftheweek

I think this should work for any date since 1600 that is based on the current Gregorian calendar (which was adopted in the US in 1752). It does not account for the 11 day shift before that from the previous Julian calendar.

edit: I thought I might add a couple of comments about the day_offset(:) array. For a short array like this, one can just compute the values by hand as I did in the above code. But for longer arrays, this becomes tedious so you would want the compiler to do it automatically. One way that works is

integer, parameter :: day_offset(12) = [0,(sum(days_in_month(1:n-1)), n=2,12)] 

However, if the compiler actually does this in the obvious way, it would be an O(n**2) algorithm. If the array were, say a million elements long, then this would take hours to compile. Maybe the compiler would recognize the obvious (to a human) optimization and compute it the right way, but maybe not. What the programmer really wants is something like

integer, parameter :: day_offset(12) = [0,(day_offset(n-1)+days_in_month(n-1), n=2,12)]

This is the way the array would be computed in a loop at run time. It is only O(n) effort, and if it compiled, it would only take a fraction of a second even for a million elements. But this expression is too complicated for a fortran compiler, and also I don’t think the recursion that references previously computed elements in the array is allowed. Anyone have any good solution to this common type of compile-time array initialization problem? Maybe this is an issue that should be addressed in the standard somehow?

1 Like

Much of what is now USA did not adopt the Gregorian calendar in 1752. The 13 British colonies did, but Spanish and French colonies, e.g. FL and LA, had already done that in 1582, and AK did it in 1867. When did HI? That’s not a Fortran problem.

1 Like

See Week - Wikipedia for locality-specific data as to whether the first day of the week is Sunday, Monday or Saturday. Greenland and Canada do not start their week on the same day of the week, one may note. What about Antarctica?

If one wanted to look at dates before 1600, then my fortran code above could use 1200 as the reference year instead of 1600. The reference year must be a multiple of 400 in order to keep the arithmetic simple. Of course, those dates between 1201 and 1582 would all be fictitious, “as if” the Gregorian calendar had been in effect then, but the arithmetic would all work with that change. Alaska changed when the US bought the territory from Russia, and Russia itself changed from Julian to Gregorian in 1918 as part of the revolution. Also when the US bought Alaska, the international date line was moved to the west, so that was included in the 11-day shift too, October-7 Julian became October-18 Gregorian 1867. I think they have a state holiday for when that happened. I just did a google search for Hawaii, and they apparently changed in 1752 along with the rest of the British colonies (including the American colonies which would become the US a few years later). It is kind of interesting that when all these changes were made everywhere, they maintained the day of the week sequence, but they changed day dates within the month. In the original papal decree for example, Thursday 4-Oct-1582 was followed by Friday 15-Oct-1582. I guess maintaining the sequence of worship days (Sunday (Christian) and Saturdays (Sabbath)) was more important than the numerical values.

Hawaii was never a British colony. Nobody using a European calendar saw it until 1788: Captain Cook and his crew. But I don’t know when the locals adopted the Gregorian one.

1 Like

[quote=“Harper, post:14, topic:9819”]
when the locals adopted the Gregorian one
[/quote] It would have taken less effort from them to just wait until the Internet, AI and Google came along.Do the native inhabitants of Heard Island and McDonald Islands know on which day they of the week should mail their tariff payments to the US ? Or do they rely on Canberra to do that for them?

I found this article about calendars and local time conventions in Hawaii. https://evols.library.manoa.hawaii.edu/server/api/core/bitstreams/d74e4b2f-99a3-4cfe-900d-24bc3b915043/content

1 Like

Thanks, Ron, interesting paper.
On page 5 it says, “Noon marked the beginning of the day in
astronomical reckoning, the middle of the day in civil reckoning,
and the end of the day in nautical reckoning.” That leads to the question "At what time of day does a new day begin/end? Are there variations in the answer from country to country?

As if this discussion had not already strayed too far from the original post. :slight_smile:

I think this is resolved to be midnight in all countries now, but of course there are cultural exceptions everywhere. Sometimes a new day starts at sunup, sometimes the day ends at sundown. But even if you take midnight as the convention, there are some perplexing questions. With a 12-hour clock convention, what comes after 11:59:59 pm? Is it 12:00:00pm or 12:00:00am? I don’t think 00:00:00am or 00:00:00pm are even options, but why not? With a 24 hour convention, I think it is allowed to write either 24:00:00 or 00:00:00 for midnight, with the latter usually being preferred, but what if you also add the date? I think that 2-Jun 24:00:00 is the same as 3-Jun 00:00:00, right? There is also a little difficulty with the question of what comes after 11:59:59am on a 12-hour clock? Is it 12:00:00am or 12:00:00pm? The answer is the latter, but it is just a convention. In the absence of that convention, one could make arguments either way. Similarly, what time was it a second before 12:00:01am or 12:00:01pm with a 12-hour convention? If one were to write a program, in fortran of course, to answer such questions, a lot of logic is required to cover all the possible situations.

There are also some odd situations regarding the international date line. Apparently James Cook took careful notes when he sailed from New Zealand to Hawaii in 1778, but he never recorded which date convention he was using, so it is possible that his dates were off by one calendar day using modern day dateline boundaries. Another odd situation occurred more recently in 2011. Samoa decided to move its calendar from the east to the west of the date line. They did this after Thursday 29-Dec, so the next day for them was Saturday 31-Dec. They never had a Friday 30-Dec for that year. If I remember correctly, employers were required to pay their employees for that nonexistent day. I remember thinking at the time that they missed an opportunity to be even more confusing; they could have instead changed after 31-Dec-2011 and the next day would have been 2-Jan-2012, but they would have never had a New Years day to begin that year. People there could have gone to a New Years party on Saturday 31-Dec, and then when midnight struck, they could have gone home to go to work the next day Monday 2-Jan.

perhaps you meant “decree” ? Did some popes have university degrees?

Thanks, I edited my post. :slight_smile: Oddly however, yes, some popes do have degrees. The one who just died was a chemist, and the new one is a mathematician.

1 Like