diff --git a/test_fms/time_manager/test_time_manager.F90 b/test_fms/time_manager/test_time_manager.F90 index 914d290560..65626f25c0 100644 --- a/test_fms/time_manager/test_time_manager.F90 +++ b/test_fms/time_manager/test_time_manager.F90 @@ -614,64 +614,6 @@ program test_time_manager call set_calendar_type(GREGORIAN) call get_coded_date( coded_date, date_to_day ) ! assign coded_date and date_to_day used by get/set_date_gregorian_old - ! Check that the get/set_date_gregorian_old here are the same as in time_manager - ! This part of the test will be deleted when the old methods are removed from time_manager - do year=1, 3200 - leap = mod(year,4) == 0 - leap = leap .and. .not.mod(year,100) == 0 - leap = leap .or. mod(year,400) == 0 - do month=1,12 - days_this_month = days_per_month(month) - if(leap .and. month == 2) days_this_month = 29 - do dday=1,days_this_month - ! test set_date_gregorian - Time = set_date(year, month, dday, 0, 0, 0, old_method=.true.) - Time0 = set_date_gregorian_old(year, month, dday, 0, 0, 0, 0, date_to_day) - if( .not. (Time==Time0) ) then - write(outunit,'("ERROR with year",i5,"mo",i5,"dday",i5)') year, month, dday - call mpp_error(FATAL, 'ERROR testing set_date_gregorian_old: Time!=Time0') - end if - ! test #1 get_date - call get_date(Time0, yr, mo, day, hr, min, sec, old_method=.true.) - call get_date_gregorian_old(Time0, coded_date, yr0, mo0, day0, hr0, min0, sec0, ticks0) - if( yr0.ne.yr .or. mo0.ne.mo .or. day0.ne.day ) then - write(outunit,"('expected year ',i5,'but got year ',i5)") yr0, yr - write(outunit,"('expected month',i5,'but got month',i5)") mo0, mo - write(outunit,"('expected day ',i5,'but got day ',i5)") day0, day - call mpp_error(FATAl,'Error testing get_date_gregorian_old 1') - end if - ! test #2 get_date - call get_date(Time, yr, mo, day, hr, min, sec, old_method=.true.) - call get_date_gregorian_old(Time, coded_date, yr0, mo0, day0, hr0, min0, sec0, ticks0) - if( yr0.ne.yr .or. mo0.ne.mo .or. day0.ne.day ) then - write(outunit,"('expected year ',i5,'but got year ',i5)") yr0, yr - write(outunit,"('expected month',i5,'but got month',i5)") mo0, mo - write(outunit,"('expected day ',i5,'but got day ',i5)") day0, day - call mpp_error(FATAl,'Error testing get_date_gregorian 2') - end if - ! test #3 get_date - call get_date(Time, yr, mo, day, hr, min, sec, old_method=.true.) - call get_date_gregorian_old(Time0, coded_date, yr0, mo0, day0, hr0, min0, sec0, ticks0) - if( yr0.ne.yr .or. mo0.ne.mo .or. day0.ne.day ) then - write(outunit,"('expected year ',i5,'but got year ',i5)") yr0, yr - write(outunit,"('expected month',i5,'but got month',i5)") mo0, mo - write(outunit,"('expected day ',i5,'but got day ',i5)") day0, day - call mpp_error(FATAl,'Error testing get_date_gregorian 3') - end if - ! test #4 get_date - call get_date(Time0, yr, mo, day, hr, min, sec, old_method=.true.) - call get_date_gregorian_old(Time, coded_date, yr0, mo0, day0, hr0, min0, sec0, ticks0) - if( yr0.ne.yr .or. mo0.ne.mo .or. day0.ne.day ) then - write(outunit,"('expected year ',i5,'but got year ',i5)") yr0, yr - write(outunit,"('expected month',i5,'but got month',i5)") mo0, mo - write(outunit,"('expected day ',i5,'but got day ',i5)") day0, day - call mpp_error(FATAl,'Error testing get_date_gregorian 4') - end if - enddo - enddo - enddo - write(outunit,'(a)') 'set_date_gregorian_old and get_date_gregorian_old tests successful' - ! test the new Gregorian methods and compare with the old methods do year=1, 3200 leap = mod(year,4) == 0 @@ -824,7 +766,7 @@ function set_date_gregorian_old(year, month, day, hour, minute, second, tick, da day1 = day1 + days_in_400_year_period*((year-1)/400) set_date_gregorian_old = set_time(seconds=second1, days=day1, ticks=tick) - + end function set_date_gregorian_old end program test_time_manager diff --git a/time_manager/time_manager.F90 b/time_manager/time_manager.F90 index 2a9599260a..b77355ced1 100644 --- a/time_manager/time_manager.F90 +++ b/time_manager/time_manager.F90 @@ -155,9 +155,6 @@ module time_manager_mod integer, private :: days_per_month(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/) integer, parameter :: seconds_per_day = rseconds_per_day ! This should automatically cast real to integer integer, parameter :: days_in_400_year_period = 146097 !< Used only for gregorian -integer, dimension(days_in_400_year_period) :: coded_date !< Used only for gregorian, to be removed soon -integer, dimension(400,12,31) :: date_to_day !< Used only for gregorian, to be removed soon -integer, parameter :: invalid_date=-1 !< Used only for gregorian, to be removed soon integer,parameter :: do_floor = 0 integer,parameter :: do_nearest = 1 @@ -171,7 +168,6 @@ module time_manager_mod integer:: seconds integer:: days integer:: ticks - integer:: dummy !< added as a workaround bug on IRIX64 (AP) end type time_type !> Operator override interface for use with @ref time_type @@ -1457,13 +1453,10 @@ end function repeat_alarm ! if(err_msg /= '') call error_mesg('my_routine','additional info: '//trim(err_msg),FATAL) ! -!> @brief Sets calendar_type. The arrays coded_date and days_this_month used for the Gregorian calendar -!! are assigned in this subroutine. The arrays and this component of the subroutine has been kept in order to be used by the original/old -!! get_date_gregorian and set_date_gregorian which are now called get_date_gregorian_old and set_date_gregorian_old. The -!! get/set_date_gregorian_old subroutines have been kept in order to test the new get/set_date_gregorian. The new get/set_date_gregorian -!! do not utilize the coded_date and days_this_month arrays. As done in the get/set_date_gregorian_old, in the new routines, -!! negative years and the proleptic Gregorian calendar are not used; and the discontinuity of days in October 1582 -!! (when the Gregorian calendar was adopted by select groups in Europe) is not taken into account. +!> @brief Sets calendar_type. +!! For the Gregorian calendar, negative years and the proleptic calendar are not used; +!! and the discontinuity of days in October 1582 (when the Gregorian calendar was adopted by select groups in Europe) +!! is also not taken into account. subroutine set_calendar_type(type, err_msg) ! Selects calendar for default mapping from time to date. @@ -1492,24 +1485,6 @@ subroutine set_calendar_type(type, err_msg) calendar_type = type -! this part is to be removed soon with set/get_date_gregorian -if(type == GREGORIAN) then - date_to_day = invalid_date - iday = 0 - do year=1,400 - leap = leap_year_gregorian_int(year) - do month=1,12 - days_this_month = days_per_month(month) - if(leap .and. month ==2) days_this_month = 29 - do day=1,days_this_month - date_to_day(year,month,day) = iday - iday = iday+1 - coded_date(iday) = day + 32*(month + 16*year) - enddo ! do day - enddo ! do month - enddo ! do year -endif - end subroutine set_calendar_type ! @@ -1617,9 +1592,7 @@ end function get_ticks_per_second ! !> @brief Gets the date for different calendar types. - !! The added optional argument old_method allows user to choose either the new or old version - !! of get_date_gregorian. The variable old_method is only useful if the calendar type is Gregorian - subroutine get_date(time, year, month, day, hour, minute, second, tick, err_msg, old_method) + subroutine get_date(time, year, month, day, hour, minute, second, tick, err_msg) ! Given a time, computes the corresponding date given the selected calendar @@ -1627,32 +1600,21 @@ subroutine get_date(time, year, month, day, hour, minute, second, tick, err_msg, integer, intent(out) :: second, minute, hour, day, month, year integer, intent(out), optional :: tick character(len=*), intent(out), optional :: err_msg - logical, intent(in), optional :: old_method !< option to choose betw the new and old ver of get_date_gregorian subroutine. - !! When .true., call get_date_gregorian_old to retrieve the date - !! from the array coded_date. When .false., call get_date_gregorian to - !! compute the date on the fly. Will be removed with set/get_date_gregorian_old character(len=128) :: err_msg_local integer :: tick1 - logical :: old_method_local !< set as .false.. Takes on the value of old_method if old_method is present. Will be removed if(.not.module_is_initialized) call time_manager_init if(present(err_msg)) err_msg = '' select case(calendar_type) case(THIRTY_DAY_MONTHS) - call get_date_thirty (time, year, month, day, hour, minute, second, tick1) + call get_date_thirty(time, year, month, day, hour, minute, second, tick1) case(GREGORIAN) - old_method_local=.false. - if(present(old_method)) old_method_local=old_method - if(old_method_local) then - call get_date_gregorian_old(time, year, month, day, hour, minute, second, tick1) - else - call get_date_gregorian(time, year, month, day, hour, minute, second, tick1) - end if + call get_date_gregorian(time, year, month, day, hour, minute, second, tick1) case(JULIAN) - call get_date_julian_private (time, year, month, day, hour, minute, second, tick1) + call get_date_julian_private(time, year, month, day, hour, minute, second, tick1) case(NOLEAP) - call get_date_no_leap_private (time, year, month, day, hour, minute, second, tick1) + call get_date_no_leap_private(time, year, month, day, hour, minute, second, tick1) case(NO_CALENDAR) err_msg_local = 'Cannot produce a date when the calendar type is NO_CALENDAR' if(error_handler('subroutine get_date', err_msg_local, err_msg)) return @@ -1754,39 +1716,6 @@ subroutine get_date_gregorian(time, year, month, day, hour, minute, second, tick end subroutine get_date_gregorian !------------------------------------------------------------------------ -!> @brief Gets the date on a Gregorian calendar. This is the original/old subroutine. -!! Looks up the year, month, day from the coded_date array -!! This subroutine will be removed soon - subroutine get_date_gregorian_old(time, year, month, day, hour, minute, second, tick) - -! Computes date corresponding to time for gregorian calendar - - type(time_type), intent(in) :: time - integer, intent(out) :: year, month, day, hour, minute, second - integer, intent(out) :: tick - integer :: iday, isec - - if(Time%seconds >= 86400) then ! This check appears to be unecessary. - call error_mesg('get_date','Time%seconds .ge. 86400 in subroutine get_date_gregorian_old',FATAL) - endif - - iday = mod(Time%days+1,days_in_400_year_period) - if(iday == 0) iday = days_in_400_year_period - - year = coded_date(iday)/512 - day = mod(coded_date(iday),32) - month = coded_date(iday)/32 - 16*year - - year = year + 400*((Time%days)/days_in_400_year_period) - - hour = Time%seconds / 3600 - isec = Time%seconds - 3600*hour - minute = isec / 60 - second = isec - 60*minute - tick = time%ticks - - end subroutine get_date_gregorian_old -!------------------------------------------------------------------------ function cut0(string) character(len=256) :: cut0 character(len=*), intent(in) :: string @@ -1993,9 +1922,7 @@ end subroutine get_date_no_leap ! A time interval. !> @brief Sets days for different calendar types. -!! The added optional argument old_method allows user to choose either the new or old version -!! of set_date_gregorian. The variable old_method is only useful if the calendar type is Gregorian - function set_date_private(year, month, day, hour, minute, second, tick, Time_out, err_msg, old_method) + function set_date_private(year, month, day, hour, minute, second, tick, Time_out, err_msg) ! Given a date, computes the corresponding time given the selected ! date time mapping algorithm. Note that it is possible to specify @@ -2006,11 +1933,6 @@ function set_date_private(year, month, day, hour, minute, second, tick, Time_out integer, intent(in) :: year, month, day, hour, minute, second, tick type(time_type) :: Time_out character(len=*), intent(out) :: err_msg - logical, intent(in), optional ::old_method !< option to choose betw the new and old ver of get_date_gregorian subroutine. - !! When .true., call set_date_gregorian_old to retrieve the time%days - !! from the array date_to_day. When .false., call set_date_gregorian to - !! compute the time%days on the fly. This option will be removed with get/set_date_gregorian_old - logical :: old_method_local !< set as .false.. Takes on the value of old_method if old_method is present. Will be removed if(.not.module_is_initialized) call time_manager_init @@ -2018,19 +1940,13 @@ function set_date_private(year, month, day, hour, minute, second, tick, Time_out select case(calendar_type) case(THIRTY_DAY_MONTHS) - set_date_private = set_date_thirty (year, month, day, hour, minute, second, tick, Time_out, err_msg) + set_date_private = set_date_thirty (year, month, day, hour, minute, second, tick, Time_out, err_msg) case(GREGORIAN) - old_method_local = .false. - if( present(old_method) ) old_method_local=old_method - if( old_method_local ) then - set_date_private = set_date_gregorian_old(year, month, day, hour, minute, second, tick, Time_out, err_msg) - else - set_date_private = set_date_gregorian(year, month, day, hour, minute, second, tick, Time_out, err_msg) - end if + set_date_private = set_date_gregorian (year, month, day, hour, minute, second, tick, Time_out, err_msg) case(JULIAN) - set_date_private = set_date_julian_private (year, month, day, hour, minute, second, tick, Time_out, err_msg) + set_date_private = set_date_julian_private (year, month, day, hour, minute, second, tick, Time_out, err_msg) case(NOLEAP) - set_date_private = set_date_no_leap_private (year, month, day, hour, minute, second, tick, Time_out, err_msg) + set_date_private = set_date_no_leap_private(year, month, day, hour, minute, second, tick, Time_out, err_msg) case (NO_CALENDAR) err_msg = 'Cannot produce a date when calendar type is NO_CALENDAR' set_date_private = .false. @@ -2045,20 +1961,13 @@ end function set_date_private !------------------------------------------------------------------------ !> @brief Calls set_date_private to set days for different calendar types. - !! The added optional argument old_method allows user to choose either the new or old version - !! of set_date_gregorian. The variable old_method is only useful if the calendar type is Gregorian - function set_date_i(year, month, day, hour, minute, second, tick, err_msg, old_method) + function set_date_i(year, month, day, hour, minute, second, tick, err_msg) type(time_type) :: set_date_i integer, intent(in) :: day, month, year integer, intent(in), optional :: second, minute, hour, tick - logical, intent(in), optional :: old_method !< option to choose betw the new and old ver of get_date_gregorian subroutine. - !! When .true., call set_date_gregorian_old to retrieve the time%days - !! from the array date_to_day. When .false., call set_date_gregorian to - !! compute the time%days on the fly. This ption will be removed with get/set_date_gregorian_old character(len=*), intent(out), optional :: err_msg integer :: osecond, ominute, ohour, otick character(len=128) :: err_msg_local - logical :: old_method_local !< set as .false.. Takes on the value of old_method if old_method is present. Will be removed if(.not.module_is_initialized) call time_manager_init if(present(err_msg)) err_msg = '' @@ -2069,9 +1978,7 @@ function set_date_i(year, month, day, hour, minute, second, tick, err_msg, old_m ohour = 0; if(present(hour)) ohour = hour otick = 0; if(present(tick)) otick = tick - old_method_local = .false. - if( present(old_method) ) old_method_local=old_method - if(.not.set_date_private(year, month, day, ohour, ominute, osecond, otick, set_date_i, err_msg_local, old_method=old_method_local)) then + if(.not.set_date_private(year, month, day, ohour, ominute, osecond, otick, set_date_i, err_msg_local)) then if(error_handler('function set_date_i', err_msg_local, err_msg)) return end if @@ -2079,9 +1986,7 @@ end function set_date_i !------------------------------------------------------------------------ !> @brief Calls set_date_private for different calendar types when given a string input. - !! The added optional argument old_method allows user to choose either the new or old version - !! of set_date_gregorian. The variable old_method is only useful if the calendar type is Gregorian - function set_date_c(string, zero_year_warning, err_msg, allow_rounding, old_method) + function set_date_c(string, zero_year_warning, err_msg, allow_rounding) ! Examples of acceptable forms of string: @@ -2107,13 +2012,8 @@ function set_date_c(string, zero_year_warning, err_msg, allow_rounding, old_meth logical, intent(in), optional :: zero_year_warning character(len=*), intent(out), optional :: err_msg logical, intent(in), optional :: allow_rounding - logical, intent(in), optional :: old_method !< option to choose betw the new and old ver of set_date_gregorian. - !! When .true., call set_date_gregorian_old to retrieve the days - !! from the array date_to_day. When .false., call set_date_gregorian to - !! compute the days on the fly. Will be removed with set/get_date_gregorian_old character(len=4) :: formt='(i )' logical :: correct_form, zero_year_warning_local, allow_rounding_local - logical :: old_method_local !< set as .false.. Takes on the value of old_method if old_method is present. integer :: i1, i2, i3, i4, i5, i6, i7 character(len=32) :: string_sifted_left integer :: year, month, day, hour, minute, second, tick @@ -2200,9 +2100,7 @@ function set_date_c(string, zero_year_warning, err_msg, allow_rounding, old_meth endif endif - old_method_local = .false. - if( present(old_method) ) old_method_local = old_method - if(.not.set_date_private(year, month, day, hour, minute, second, tick, set_date_c, err_msg_local,old_method=old_method_local)) then + if(.not.set_date_private(year, month, day, hour, minute, second, tick, set_date_c, err_msg_local)) then if(error_handler('function set_date_c', err_msg_local, err_msg)) return end if @@ -2257,9 +2155,9 @@ function set_date_gregorian(year, month, day, hour, minute, second, tick, Time_o select case( month ) case(1) ; dayx = dayx - case(2) ; dayx = dayx + 31 - case(3) ; dayx = dayx + 59 + l - case(4) ; dayx = dayx + 90 + l + case(2) ; dayx = dayx + 31 + case(3) ; dayx = dayx + 59 + l + case(4) ; dayx = dayx + 90 + l case(5) ; dayx = dayx + 120 + l case(6) ; dayx = dayx + 151 + l case(7) ; dayx = dayx + 181 + l @@ -2295,43 +2193,6 @@ end function set_date_gregorian !------------------------------------------------------------------------ -!> @brief Sets Time_out%days on a Gregorian calendar. This is the original/old subroutine. -!! Look up the total number of days between 1/1/0001 to the current month/day/year in the array date_to_day -!! This function will be removed soon. - function set_date_gregorian_old(year, month, day, hour, minute, second, tick, Time_out, err_msg) - logical :: set_date_gregorian_old - -! Computes time corresponding to date for gregorian calendar. - - integer, intent(in) :: year, month, day, hour, minute, second, tick - type(time_type), intent(out) :: Time_out - character(len=*), intent(out) :: err_msg - integer :: yr1, day1 - - if( .not.valid_increments(year,month,day,hour,minute,second,tick,err_msg) ) then - set_date_gregorian_old = .false. - return - endif - - Time_out%seconds = second + 60*(minute + 60*hour) - - yr1 = mod(year,400) - if(yr1 == 0) yr1 = 400 - day1 = date_to_day(yr1,month,day) - if(day1 == invalid_date) then - err_msg = 'Invalid_date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second) - set_date_gregorian_old = .false. - return - endif - - Time_out%days = day1 + days_in_400_year_period*((year-1)/400) - Time_out%ticks = tick - err_msg = '' - set_date_gregorian_old = .true. - - end function set_date_gregorian_old - -!------------------------------------------------------------------------ function set_date_julian_private(year, month, day, hour, minute, second, tick, Time_out, err_msg) logical :: set_date_julian_private