Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

mixed precision: time_manager reals to r8 and clean up #1196

Merged
merged 15 commits into from
Jun 7, 2023
Merged

mixed precision: time_manager reals to r8 and clean up #1196

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
15 commits
Select commit Hold shift + click to select a range
46d8e44
Update mixedmode_base branch to main (#1144)
mlee03 Mar 8, 2023
dde0b88
update the mixedmode_base branch to main (#1154)
mlee03 Mar 15, 2023
bc9e4d9
Merge branch 'mixedmode' into mixedmode_base
rem1776 Apr 5, 2023
2977578
rm accidental empty line
Apr 5, 2023
b3374f6
chore: bring mixedmode_base up to date with main (#1173)
mlee03 Apr 5, 2023
b6b12dd
clean up comments and any default/double sized reals
Apr 19, 2023
dcd1969
forgot some changes
Apr 19, 2023
91590e1
fix incorrect variable name, whitespace
Apr 19, 2023
2900f85
fix line lengths, add missed use
Apr 19, 2023
6c2bdad
add interface for r4
Apr 19, 2023
3dd1af3
linelength
Apr 19, 2023
51f8b6b
add interface and test for conversions
Apr 19, 2023
0b01311
whitespace again
Apr 19, 2023
1597338
review fixes
May 3, 2023
ef8cb15
finish up review changes and any lingering implicit conversions
May 3, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 12 additions & 4 deletions test_fms/time_manager/test_time_manager.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@ program test_time_manager
use time_manager_mod, only: operator(-), operator(+), operator(*), operator(/), &
operator(>), operator(>=), operator(==), operator(/=), &
operator(<), operator(<=), operator(//), assignment(=)
use platform_mod, only: r4_kind, r8_kind

implicit none

Expand Down Expand Up @@ -598,12 +599,19 @@ program test_time_manager

if(test19) then
write(outunit,'(/,a)') '################################# test19 #################################'
call print_time(real_to_time_type(86401.1), 'real_to_time_type(86401.1):', unit=outunit)
Time = real_to_time_type(-1.0, err_msg)
call print_time(real_to_time_type(86401.1_r8_kind), 'real_to_time_type(86401.1):', unit=outunit)
Time = real_to_time_type(-1.0_r8_kind, err_msg)
if(err_msg == '') then
call mpp_error(FATAL, 'test19.3 fails: did not get the expected error message')
call mpp_error(FATAL, 'test19.3 fails: did not get the expected error message for r8')
else
write(outunit,'(a)') 'test successful: '//trim(err_msg)
write(outunit,'(a)') 'r8 test successful: '//trim(err_msg)
endif
call print_time(real_to_time_type(86401.1_r4_kind), 'real_to_time_type(86401.1):', unit=outunit)
Time = real_to_time_type(-1.0_r4_kind, err_msg)
if(err_msg == '') then
call mpp_error(FATAL, 'test19.3 fails: did not get the expected error message for r4')
else
write(outunit,'(a)') 'r4 test successful: '//trim(err_msg)
endif
endif
!==============================================================================================
Expand Down
85 changes: 55 additions & 30 deletions time_manager/get_cal_time.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,7 @@ module get_cal_time_mod
set_calendar_type, get_calendar_type, set_date, &
get_date, days_in_month, valid_calendar_types
use mpp_mod, only: input_nml_file
use platform_mod, only: r8_kind, r4_kind

implicit none
private
Expand All @@ -59,6 +60,14 @@ module get_cal_time_mod
! Include variable "version" to be written to log file.
#include<file_version.h>

!> Added for mixed precision support.
!! Updates force time_manager math to be done with kind=8 reals
!! _wrap just casts a passed in r4 to r8 and calls r8 version
interface get_cal_time
module procedure get_calendar_time
module procedure get_calendar_time_wrap
end interface

contains
!> @brief Calculates what a given calendar time would be after a interval of time
!!
Expand Down Expand Up @@ -150,28 +159,28 @@ module get_cal_time_mod
!!
!! @note This option was originally coded to allow noleap calendar as input when
!! the julian calendar was in effect by the time_manager.
function get_cal_time(time_increment, units, calendar, permit_calendar_conversion)
real, intent(in) :: time_increment
function get_calendar_time(time_increment, units, calendar, permit_calendar_conversion)
real(r8_kind), intent(in) :: time_increment
character(len=*), intent(in) :: units
character(len=*), intent(in) :: calendar
logical, intent(in), optional :: permit_calendar_conversion
type(time_type) :: get_cal_time
type(time_type) :: get_calendar_time
integer :: year, month, day, hour, minute, second
integer :: i1, increment_seconds, increment_days, increment_years, increment_months
real :: month_fraction
real(r8_kind) :: month_fraction
integer :: calendar_tm_i, calendar_in_i, ierr, io, logunit
logical :: correct_form
character(len=32) :: calendar_in_c
character(len=64) :: err_msg
type(time_type) :: base_time, base_time_plus_one_yr
real :: dt
real(r8_kind) :: dt
logical :: permit_conversion_local

if(.not.module_is_initialized) then
read (input_nml_file, get_cal_time_nml, iostat=io)
ierr = check_nml_error (io, 'get_cal_time_nml')

call write_version_number("GET_CAL_TIME_MOD", version)
call write_version_number("get_cal_time_MOD", version)
logunit = stdlog()
if(mpp_pe() == mpp_root_pe()) write (logunit, nml=get_cal_time_nml)
module_is_initialized = .true.
Expand All @@ -192,7 +201,7 @@ function get_cal_time(time_increment, units, calendar, permit_calendar_conversio
(trim(calendar_in_c)) == 'gregorian'

if(.not.correct_form) then
call error_mesg('get_cal_time','"'//trim(calendar_in_c)//'"'// &
call error_mesg('get_calendar_time','"'//trim(calendar_in_c)//'"'// &
' is not an acceptable calendar attribute. acceptable calendars are: '// &
' noleap, 365_day, 365_days, 360_day, julian, no_calendar, thirty_day_months, gregorian',FATAL)
endif
Expand All @@ -209,7 +218,7 @@ function get_cal_time(time_increment, units, calendar, permit_calendar_conversio
(trim(calendar_in_c) == 'no_calendar' .and. calendar_tm_i == NO_CALENDAR) .or. &
(trim(calendar_in_c) == 'gregorian' .and. calendar_tm_i == GREGORIAN)
if(.not.correct_form) then
call error_mesg('get_cal_time','calendar not consistent with calendar type in use by time_manager.'// &
call error_mesg('get_calendar_time','calendar not consistent with calendar type in use by time_manager.'// &
' calendar='//trim(calendar_in_c)//'. Type in use by time_manager='// &
& valid_calendar_types(calendar_tm_i),FATAL)
endif
Expand All @@ -234,8 +243,8 @@ function get_cal_time(time_increment, units, calendar, permit_calendar_conversio
case ('gregorian')
calendar_in_i = GREGORIAN
case default
call error_mesg('get_cal_time', &
trim(calendar_in_c)//' is an invalid calendar type (specified in call to get_cal_time)',FATAL)
call error_mesg('get_calendar_time', &
trim(calendar_in_c)//' is an invalid calendar type (specified in call to get_calendar_time)',FATAL)
end select
else
calendar_in_i = calendar_tm_i
Expand All @@ -253,7 +262,7 @@ function get_cal_time(time_increment, units, calendar, permit_calendar_conversio
endif

if(.not.correct_form) then
call error_mesg('get_cal_time',trim(units)//' is an invalid string for units.' // &
call error_mesg('get_calendar_time',trim(units)//' is an invalid string for units.' // &
' units must begin with a time unit then the word "since"' // &
' Valid time units are: "seconds" "minutes", "hours", "days", and, ' // &
' except when NO_CALENDAR is in effect, "months" and "years"',FATAL)
Expand Down Expand Up @@ -282,16 +291,16 @@ function get_cal_time(time_increment, units, calendar, permit_calendar_conversio

if(lowercase(units(1:10)) == 'days since') then
increment_days = floor(time_increment)
increment_seconds = int(86400*(time_increment - increment_days))
increment_seconds = int(86400.0_r8_kind*(time_increment - real(increment_days, r8_kind)))
else if(lowercase(units(1:11)) == 'hours since') then
increment_days = floor(time_increment/24)
increment_seconds = int(86400*(time_increment/24 - increment_days))
increment_seconds = int(86400.0_r8_kind*(time_increment/24.0_r8_kind - real(increment_days, r8_kind)))
else if(lowercase(units(1:13)) == 'minutes since') then
increment_days = floor(time_increment/1440)
increment_seconds = int(86400*(time_increment/1440 - increment_days))
increment_seconds = int(86400.0_r8_kind*(time_increment/1440.0_r8_kind - real(increment_days, r8_kind)))
else if(lowercase(units(1:13)) == 'seconds since') then
increment_days = floor(time_increment/86400)
increment_seconds = int(86400*(time_increment/86400 - increment_days))
increment_seconds = int(86400.0_r8_kind*(time_increment/86400.0_r8_kind - real(increment_days, r8_kind)))
else if(lowercase(units(1:11)) == 'years since') then
! The time period between between (base_time + time_increment) and
! (base_time + time_increment + 1 year) may be 360, 365, or 366 days.
Expand All @@ -300,47 +309,63 @@ function get_cal_time(time_increment, units, calendar, permit_calendar_conversio
base_time = set_date(year+floor(time_increment) ,month,day,hour,minute,second)
base_time_plus_one_yr = set_date(year+floor(time_increment)+1,month,day,hour,minute,second)
call get_time(base_time_plus_one_yr - base_time, second, day)
dt = (day*86400+second)*(time_increment-floor(time_increment))
increment_days = floor(dt/86400)
increment_seconds = int(dt - increment_days*86400)
dt = real(day*86400+second, r8_kind)*(time_increment-real(floor(time_increment), r8_kind))
increment_days = floor(dt/86400.0_r8_kind)
increment_seconds = int(dt - real(increment_days*86400, r8_kind))
else if(lowercase(units(1:12)) == 'months since') then
month_fraction = time_increment - floor(time_increment)
month_fraction = time_increment - real(floor(time_increment), r8_kind)
increment_years = floor(time_increment/12)
increment_months = floor(time_increment) - 12*increment_years
call get_date(base_time, year,month,day,hour,minute,second)
base_time = set_date(year+increment_years,month+increment_months ,day,hour,minute,second)
dt = 86400*days_in_month(base_time) * month_fraction
dt = real( 86400*days_in_month(base_time), r8_kind) * month_fraction
increment_days = floor(dt/86400)
increment_seconds = int(dt - increment_days*86400)
increment_seconds = int(dt - real(increment_days, r8_kind)*86400.0_r8_kind)
else
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

lines 292 -323, time_increment and dt are reals doing math with ints

call error_mesg('get_cal_time','"'//trim(units)//'" is not an acceptable units attribute of time.'// &
call error_mesg('get_calendar_time','"'//trim(units)//'" is not an acceptable units attribute of time.'// &
& ' It must begin with: "years since", "months since", "days since", "hours since", "minutes since",'// &
& ' or "seconds since"',FATAL)
endif

if (calendar_in_i /= calendar_tm_i) then
if(calendar_in_i == NO_CALENDAR .or. calendar_tm_i == NO_CALENDAR) then
call error_mesg('get_cal_time','Cannot do calendar conversion because input calendar is '// &
call error_mesg('get_calendar_time','Cannot do calendar conversion because input calendar is '// &
trim(valid_calendar_types(calendar_in_i))//' and time_manager is using '// &
trim(valid_calendar_types(calendar_tm_i))// &
' Conversion cannot be done if either is NO_CALENDAR',FATAL)
endif
call get_date(base_time,year, month, day, hour, minute, second)
get_cal_time = set_date(year,month,day,hour,minute,second) + set_time(increment_seconds, increment_days)
call get_date(get_cal_time,year,month,day,hour,minute,second)
get_calendar_time = set_date(year,month,day,hour,minute,second) + set_time(increment_seconds, increment_days)
call get_date(get_calendar_time,year,month,day,hour,minute,second)
call set_calendar_type(calendar_tm_i)
get_cal_time = set_date(year,month,day,hour,minute,second, err_msg=err_msg)
get_calendar_time = set_date(year,month,day,hour,minute,second, err_msg=err_msg)
if(err_msg /= '') then
call error_mesg('get_cal_time','Error in function get_cal_time: '//trim(err_msg)// &
call error_mesg('get_calendar_time','Error in function get_calendar_time: '//trim(err_msg)// &
' Note that the time_manager is using the '//trim(valid_calendar_types(calendar_tm_i))//' calendar '// &
'while the calendar type passed to function get_cal_time is '//calendar_in_c,FATAL)
'while the calendar type passed to function get_calendar_time is '//calendar_in_c,FATAL)
endif
else
get_cal_time = base_time + set_time(increment_seconds, increment_days)
get_calendar_time = base_time + set_time(increment_seconds, increment_days)
endif

end function get_cal_time
end function get_calendar_time

!------------------------------------------------------------------------

!> For mixed precision support, just casts to passed in increment to r8
function get_calendar_time_wrap(time_increment, units, calendar, permit_calendar_conversion)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

wondering if this function is needed

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It was needed to compile with current mixed mode so I think it'll be needed

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

do you think using class(*) for time_increment would work? Or is that going to make things messier..

real(r4_kind), intent(in) :: time_increment
character(len=*), intent(in) :: units
character(len=*), intent(in) :: calendar
logical, intent(in), optional :: permit_calendar_conversion
type(time_type) :: get_calendar_time_wrap

get_calendar_time_wrap = get_cal_time( real(time_increment, r8_kind), units, calendar, &
permit_calendar_conversion=permit_calendar_conversion)
end function

!------------------------------------------------------------------------

function cut0(string)
character(len=256) :: cut0
character(len=*), intent(in) :: string
Expand Down
Loading