Back in 2021, for a challenge, I taught myself part of the Python programming language and wrote a program based on the idea of a Fortran program I wrote decades ago. Now, for another challenge, I’ve written the same program – in Fortran! I had to dig out a free compiler from the Internet (Fortran 90). Things have developed and changed since I was a programmer and I have had to learn new things in the language. Back then I think I used Fortran 66 and Fortran 77.
It’s been fun coding in Fortran, again! For the record, I downloaded and used a free product Code::Blocks, which I’ve found to be successful. I also found this YouTube video to explain configuring of Code::Blocks for Fortran.
! ===================================================================
! Program REMINDER
!
! Decades ago I wrote a FORTRAN program to take a file of reminders
! and to display the records in a sorted and pretty format.
! In March 2021, for fun, I wrote a Python version of the program.
! Now, in January 2023, for fun, I have again written a FORTRAN version.
!
! Version 0.1 20-Jan-2023 Start of conversion of the Python code
! Version 1.0 29-Jan-2023 Final version.....?
!
! ===================================================================
program Reminder
use ReminderModule ! All the functions/subroutines are in this module.
implicit none
type (rec_data) ReminderTable(100)
character myfile*100
integer Nreminders
myFile = "C:\Users\Mike\Documents\Documents\MyFortranCode\MyReminderProject\Reminder.dat"
call GetReminderData(myFile,ReminderTable,Nreminders)
call SortList (ReminderTable,Nreminders)
call PrintList(ReminderTable,Nreminders)
end program Reminder
!
!==========================================================
! Module REMINDERMODULE containing all the functions and subroutines.
!==========================================================
module ReminderModule
!
implicit none
type rec_data !Structure to hold the reminder records
character*11 rec_date !reminder date
character*50 rec_event !reminder event
integer rec_numdays !Calculate days between date and today's date
end type rec_data
contains
!============================================================
!Subroutine GETREMINDERDATA to get the reminder records
!Records are of the form dd-mmm-yyyy,"Event description" and are unordered
!============================================================
subroutine GetReminderData(filename,ReminderTable,N)
implicit none
integer mystatus,N,ans,ans_today
character filename*(*), mystatusmessage*200,mydate*11,mytext*50,today*8
character monthchar*3,months*36
integer d,m,y
type (rec_data) ReminderTable(*)
data months/"JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"/
open (unit=1,file=filename,action='read', &
form='formatted',iostat=mystatus,iomsg=mystatusmessage)
if (myStatus /= 0) then
write (*,'(///2a)') "OOPS! ", mystatusmessage
stop
endif
!
! Calculate the number of days between today and a base date
!
call date_and_time(date=today) ! Inbuilt procedure
read(unit=today,fmt='(i4,i2,i2)')y,m,d ! This used to be done using an ENCODE statement!
call getDays(d,m,y,ans_today) !Get the number of days between today and a base date
!
! Get the reminder records
!
N = 0
do
read (unit=1,fmt=*,iostat=mystatus,iomsg=mystatusmessage)mydate,mytext
if (mystatus /= 0) then
exit
else
N=N+1
ReminderTable(N)%rec_date = mydate
ReminderTable(N)%rec_event = mytext
read (unit=mydate,fmt='(i2,1x,a3,1x,i4)')d,monthchar,y ! Get the date components
m = index(months,uppercase(monthchar))/3+1 ! Lookup the month number using the month text
call getDays(d,m,y,ans) !Get the number of days between the date and a base date
ReminderTable(N)%rec_numdays = ans - ans_today !Number of days between date and today's date
end if
end do
close (unit=1)
end subroutine
!============================================================
! Subroutine GETDAYS to calculate the number of days between
! the supplied date and an arbitrary base date (01/01/2000)
!============================================================
subroutine getDays( day,month,year ,ans)
implicit none
integer ans,i,daysPerMonth(1:12),daysPerMonthLeapYear(1:12)
integer day,month,year
data daysPerMonth / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /
data daysPerMonthLeapYear / 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /
ans=0
do i = 2000, year-1 ! Add up the days in the preceding years of the supplied date
ans=ans +365
if (isLeap(i)) ans=ans + 1
end do
!
do i =1,month-1,1 ! Add up the days in the preceding months in the year of the supplied date
if (isLeap(year)) then
ans = ans + daysPerMonthLeapYear(i)
else
ans=ans + daysPerMonth(i)
end if
end do
!
ans = ans + day - 1 ! Finally add in the number of days (less 1) of the month of the supplied date
!
end subroutine getdays
!=============================================================
! Function ISLEAP to determine if a year is a leap year
!=============================================================
logical function isLeap(Y)
!
integer Y
!
! A leap year is divisible by 400 or, is divisible by 4 but not by 100
!
isLeap = (mod(Y,400) .EQ. 0) .OR. (mod(Y,4) .EQ. 0 .AND. mod(Y,100) .NE. 0)
end function isleap
!
!=============================================================
! Subroutine SORTLIST to sort the data in date order.
!=============================================================
subroutine SortList (ReminderTable,N)
type (rec_data) :: ReminderTable(*),temp
integer :: N,i,j
logical :: Swapped
DO j = N-1, 1, -1
swapped = .FALSE.
DO i = 1, j
IF (ReminderTable(i)%rec_numdays > ReminderTable(i+1)%rec_numdays) THEN
temp = ReminderTable(i)
ReminderTable(i) = ReminderTable(i+1)
ReminderTable(i+1) = temp
swapped = .TRUE.
END IF
END DO
IF (.NOT. swapped) EXIT
END DO
end subroutine
!
!=============================================================
! Function UPPERCASE to convert text to upper case.
!=============================================================
function uppercase(string)
character(len=*), intent(in) :: string
character(len=len(string)) :: uppercase
integer :: j
do j = 1,len(string)
if(string(j:j) >= "a" .and. string(j:j) <= "z") then
uppercase(j:j) = achar(iachar(string(j:j)) - 32)
else
uppercase(j:j) = string(j:j)
end if
end do
end function uppercase
!
!====================================================
! Function PRINTLIST to nicely print the data
!====================================================
subroutine PrintList (ReminderTable,N)
type (rec_data) :: ReminderTable(*)
integer :: N, nDays, i
logical :: tChange
character*16 t1
character*75,parameter :: mySectionSeparator="---------------------------------------------------"
tChange = .TRUE.
write (*,'(/////)')
write (*,'(2x,a)')mySectionSeparator
write (*,'(2x,a)')" Welcome to my FORTRAN Reminder program!"
write (*,'(2x,a)')mySectionSeparator
do i = 1, N
nDays = ReminderTable(i)%rec_numdays
if (tChange .eqv. .TRUE. .and. nDays > 0) then
tChange = .False.
write (*,'(2x,a)') mySectionSeparator
end if
if (nDays == 0) then
t1 = " Today "
else if (nDays == -1) then
t1 = " Yesterday "
else if (nDays == 1) then
t1 = " Tomorrow "
else if (nDays < 0) then
write(unit=t1,fmt='(i4,a)')-ndays," days since" !In my days it was the ENCODE statement
else
write(unit=t1,fmt='(i4,a)')ndays," days until"
end if
write (*,'(2x,a,1x,a,1x,a,a)')ReminderTable(i)%rec_date,t1,ReminderTable(i)%rec_event
end do
write (*,'(2x,a///)')mySectionSeparator
end subroutine
end module
And the output is….
things change 