FMS 2025.01.02-dev
Flexible Modeling System
Loading...
Searching...
No Matches
get_cal_time.F90
1!***********************************************************************
2!* GNU Lesser General Public License
3!*
4!* This file is part of the GFDL Flexible Modeling System (FMS).
5!*
6!* FMS is free software: you can redistribute it and/or modify it under
7!* the terms of the GNU Lesser General Public License as published by
8!* the Free Software Foundation, either version 3 of the License, or (at
9!* your option) any later version.
10!*
11!* FMS is distributed in the hope that it will be useful, but WITHOUT
12!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14!* for more details.
15!*
16!* You should have received a copy of the GNU Lesser General Public
17!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18!***********************************************************************
19!> @defgroup get_cal_time_mod get_cal_time_mod
20!> @ingroup time_manager
21!> @brief Given a time increment as a real number, and base time and calendar
22!! as a character strings, returns time as a time_type variable.
23
24!> @addtogroup get_cal_time_mod
25!> @{
26module get_cal_time_mod
27
28use fms_mod, only: error_mesg, fatal, write_version_number, lowercase, &
29 check_nml_error, stdlog, &
30 mpp_pe, mpp_root_pe
31
32use time_manager_mod, only: time_type, operator(+), operator(-), set_time, get_time, &
33 no_calendar, thirty_day_months, noleap, julian, gregorian, &
36use mpp_mod, only: input_nml_file
37use platform_mod, only: r8_kind, r4_kind
38
39implicit none
40private
41
42public :: get_cal_time
43
44logical :: module_is_initialized=.false. !> This module is initialized on
45 !! the first call to get_cal_time
46 !! because there is no constructor.
47! <NAMELIST NAME="get_cal_time_nml">
48! <DATA NAME="allow_calendar_conversion" TYPE="logical" DEFAULT=".true.">
49! This sets the default value of the optional argument named "permit_calendar_conversion" of get_cal_time.
50! This namelist is deprecated as of the memphis release.
51! If calendar conversion is not desired, then it is recommended that permit_calendar_conversion
52! be present in the call to get_cal_time and that it be set to .false.
53! </DATA>
54
55logical :: allow_calendar_conversion=.true.
56
57namelist / get_cal_time_nml / allow_calendar_conversion
58! </NAMELIST>
59
60! Include variable "version" to be written to log file.
61#include<file_version.h>
62
63!> Added for mixed precision support.
64!! Updates force time_manager math to be done with kind=8 reals
65!! _wrap just casts a passed in r4 to r8 and calls r8 version
66interface get_cal_time
67 module procedure get_calendar_time
68 module procedure get_calendar_time_wrap
69end interface
70
71contains
72!> @brief Calculates what a given calendar time would be after a interval of time
73!!
74!! @param time_increment A time interval
75!! @param units
76!! Examples of acceptable values of units:
77!! - 'days since 1980-01-01 00:00:00'
78!! - 'hours since 1980-1-1 0:0:0'
79!! - 'minutes since 0001-4-12'
80!! The first word in the string must be
81!! 'years', 'months', 'days', 'hours', 'minutes' or 'seconds'.
82!! The second word must be 'since'.
83!! year number must occupy 4 spaces.
84!! Number of months, days, hours, minutes, seconds may occupy 1 or 2 spaces
85!! year, month and day must be separated by a '-'
86!! hour, minute, second must be separated by a ':'
87!! hour, minute, second are optional. If not present then zero is assumed.
88!!
89!! Because months are not equal increments of time, and, for julian calendar,
90!! neither are years, the 'years since' and 'month since' cases deserve
91!! further explaination.
92!!
93!! When 'years since' is used:
94!! The year number is increased by floor(time_increment) to obtain a time T1.
95!! The year number is increased by floor(time_increment)+1 to obtain a time T2.
96!! The time returned is T1 + (time_increment-floor(time_increment))*(T2-T1).
97!!
98!! When 'months since' is used:
99!! The month number is increased by floor(time_increment). If it falls outside
100!! to range 1 to 12 then it is adjusted along with the year number to convert
101!! to a valid date. The number of days in the month of this date is used to
102!! compute the time interval of the fraction.
103!! That is:
104!! The month number is increased by floor(time_increment) to obtain a time T1.
105!! delt = the number of days in the month in which T1 falls.
106!! The time returned is T1 + ((time_increment-floor(time_increment))*delt.
107!! Two of the consequences of this scheme should be kept in mind.
108!! -- The time since should not be from the 29'th to 31'st of a month,
109!! since an invalid date is likely to result, triggering an error stop.
110!! -- When time since is from the begining of a month, the fraction of a month
111!! will never advance into the month after that which results from only
112!! the whole number.
113!!
114!! When NO_CALENDAR is in effect, units attribute must specify a starting
115!! day and second, with day number appearing first
116!!
117!! Example: 'days since 100 0' Indicates 100 days 0 seconds
118!!
119!! @param calendar
120!! Acceptable values of calendar are:
121!! 'noleap'
122!! '365_day'
123!! '360_day'
124!! 'julian'
125!! 'thirty_day_months'
126!! 'no_calendar'
127!!
128!! @param optional permit_calendar_conversion
129!! It is sometimes desirable to allow the value of the intent(in) argument
130!! "calendar" to be different than the calendar in use by time_manager_mod.
131!! If this is not desirable, then the optional variable "permit_calendar_conversion"
132!! should be set to .false. so as to allow an error check.
133!! When calendar conversion is done, the time returned is the time in the
134!! time_manager's calendar, but corresponds to the date computed using the input calendar.
135!! For example, suppose the time_manager is using the julian calendar and
136!! the values of the input arguments of get_cal_time are:
137!! time_increment = 59.0
138!! units = 'days since 1980-1-1 00:00:00'
139!! calendar = 'noleap'
140!! Because it will use the noleap calendar to calculate the date, get_cal_time will return
141!! value of time for midnight March 1 1980, but it will be time in the julian calendar
142!! rather than the noleap calendar. It will never return a value of time corresponding
143!! to anytime during the day Feb 29.
144!!
145!! Another example:
146!! Suppose the time_manager is using either the noleap or julian calendars,
147!! and the values of the input arguments are:
148!! time_increment = 30.0
149!! units = 'days since 1980-1-1'
150!! calendar = 'thirty_day_months'
151!! In this case get_cal_time will return the value of time for Feb 1 1980 00:00:00,
152!! but in the time_manager's calendar.
153!!
154!! Calendar conversion may result in a fatal error when the input calendar type is
155!! a calendar that has more days per year than that of the time_manager's calendar.
156!! For example, if the input calendar type is julian and the time_manager's calendar
157!! is thirty_day_months, then get_cal_time will try to convert Jan 31 to a time in
158!! the thirty_day_months calendar, resulting in a fatal error.
159!!
160!! @note This option was originally coded to allow noleap calendar as input when
161!! the julian calendar was in effect by the time_manager.
162function get_calendar_time(time_increment, units, calendar, permit_calendar_conversion)
163real(r8_kind), intent(in) :: time_increment
164character(len=*), intent(in) :: units
165character(len=*), intent(in) :: calendar
166logical, intent(in), optional :: permit_calendar_conversion
168integer :: year, month, day, hour, minute, second
169integer :: i1, increment_seconds, increment_days, increment_years, increment_months
170real(r8_kind) :: month_fraction
171integer :: calendar_tm_i, calendar_in_i, ierr, io, logunit
172logical :: correct_form
173character(len=32) :: calendar_in_c
174character(len=64) :: err_msg
175type(time_type) :: base_time, base_time_plus_one_yr
176real(r8_kind) :: dt
177logical :: permit_conversion_local
178integer, parameter :: spd_int = 86400 !< seconds per day as int
179real(r8_kind), parameter :: spd_real = 86400.0_r8_kind !< seconds per day as 64 bit real
180
181if(.not.module_is_initialized) then
182 read (input_nml_file, get_cal_time_nml, iostat=io)
183 ierr = check_nml_error(io, 'get_cal_time_nml')
184
185 call write_version_number("get_cal_time_MOD", version)
186 logunit = stdlog()
187 if(mpp_pe() == mpp_root_pe()) write (logunit, nml=get_cal_time_nml)
188 module_is_initialized = .true.
189endif
190
191if(present(permit_calendar_conversion)) then
192 permit_conversion_local = permit_calendar_conversion
193else
194 permit_conversion_local = allow_calendar_conversion
195endif
196
197calendar_in_c = lowercase(trim(cut0(calendar)))
198
199correct_form = (trim(calendar_in_c)) == 'noleap' .or. (trim(calendar_in_c)) == '365_day' .or. &
200 (trim(calendar_in_c)) == '365_days' .or. &
201 (trim(calendar_in_c)) == '360_day' .or. (trim(calendar_in_c)) == 'julian' .or. &
202 (trim(calendar_in_c)) == 'no_calendar'.or. (trim(calendar_in_c)) == 'thirty_day_months' .or. &
203 (trim(calendar_in_c)) == 'gregorian'
204
205if(.not.correct_form) then
206 call error_mesg('get_calendar_time','"'//trim(calendar_in_c)//'"'// &
207 ' is not an acceptable calendar attribute. acceptable calendars are: '// &
208 ' noleap, 365_day, 365_days, 360_day, julian, no_calendar, thirty_day_months, gregorian',fatal)
209endif
210
211calendar_tm_i = get_calendar_type()
212
213if(.not.permit_conversion_local) then
214 correct_form = (trim(calendar_in_c) == 'noleap' .and. calendar_tm_i == noleap) .or. &
215 (trim(calendar_in_c) == '365_day' .and. calendar_tm_i == noleap) .or. &
216 (trim(calendar_in_c) == '365_days' .and. calendar_tm_i == noleap) .or. &
217 (trim(calendar_in_c) == '360_day' .and. calendar_tm_i == thirty_day_months) .or. &
218 (trim(calendar_in_c) == 'thirty_day_months' .and. calendar_tm_i == thirty_day_months) .or. &
219 (trim(calendar_in_c) == 'julian' .and. calendar_tm_i == julian) .or. &
220 (trim(calendar_in_c) == 'no_calendar' .and. calendar_tm_i == no_calendar) .or. &
221 (trim(calendar_in_c) == 'gregorian' .and. calendar_tm_i == gregorian)
222 if(.not.correct_form) then
223 call error_mesg('get_calendar_time','calendar not consistent with calendar type in use by time_manager.'// &
224 ' calendar='//trim(calendar_in_c)//'. Type in use by time_manager='// &
225 & valid_calendar_types(calendar_tm_i),fatal)
226 endif
227endif
228
229if (permit_conversion_local) then
230 select case (trim(calendar_in_c))
231 case ('noleap')
232 calendar_in_i = noleap
233 case ('365_day')
234 calendar_in_i = noleap
235 case ('365_days')
236 calendar_in_i = noleap
237 case ('360_day')
238 calendar_in_i = thirty_day_months
239 case ('thirty_day_months')
240 calendar_in_i = thirty_day_months
241 case ('julian')
242 calendar_in_i = julian
243 case ('no_calendar')
244 calendar_in_i = no_calendar
245 case ('gregorian')
246 calendar_in_i = gregorian
247 case default
248 call error_mesg('get_calendar_time', &
249 trim(calendar_in_c)//' is an invalid calendar type (specified in call to get_calendar_time)',fatal)
250 end select
251else
252 calendar_in_i = calendar_tm_i
253end if
254
255correct_form = lowercase(units(1:10)) == 'days since' .or. &
256 lowercase(units(1:11)) == 'hours since' .or. &
257 lowercase(units(1:13)) == 'minutes since' .or. &
258 lowercase(units(1:13)) == 'seconds since'
259
260if(calendar_in_i /= no_calendar) then
261 correct_form = correct_form .or. &
262 lowercase(units(1:11)) == 'years since' .or. &
263 lowercase(units(1:12)) == 'months since'
264endif
265
266if(.not.correct_form) then
267 call error_mesg('get_calendar_time',trim(units)//' is an invalid string for units.' // &
268 ' units must begin with a time unit then the word "since"' // &
269 ' Valid time units are: "seconds" "minutes", "hours", "days", and, ' // &
270 ' except when NO_CALENDAR is in effect, "months" and "years"',fatal)
271endif
272
273if(calendar_in_i /= calendar_tm_i) then
274! switch to calendar type specified as input argument,
275! will switch back before returning.
276 call set_calendar_type(calendar_in_i)
277endif
278
279! index(string, substring[,back])
280! Returns the starting position of substring as a substring of string,
281! or zero if it does not occur as a substring. Default value of back is
282! .false. If back is .false., the starting position of the first such
283! substring is returned. If back is .true., the starting position of the
284! last such substring is returned.
285! Returns zero if substring is not a substring of string (regardless of value of back)
286
287i1 = index(units,'since') + 5
288if(calendar_in_i == no_calendar) then
289 base_time = set_time(units(i1:len_trim(units)))
290else
291 base_time = set_date(units(i1:len_trim(units)))
292endif
293
294if(lowercase(units(1:10)) == 'days since') then
295 increment_days = floor(time_increment)
296 increment_seconds = int(spd_real*(time_increment - real(increment_days, r8_kind)))
297else if(lowercase(units(1:11)) == 'hours since') then
298 increment_days = floor(time_increment/24.0_r8_kind)
299 increment_seconds = int(spd_real*(time_increment/24.0_r8_kind - real(increment_days, r8_kind)))
300else if(lowercase(units(1:13)) == 'minutes since') then
301 increment_days = floor(time_increment/1440.0_r8_kind)
302 increment_seconds = int(spd_real*(time_increment/1440.0_r8_kind - real(increment_days, r8_kind)))
303else if(lowercase(units(1:13)) == 'seconds since') then
304 increment_days = floor(time_increment/spd_real)
305 increment_seconds = int(spd_real*(time_increment/spd_real - real(increment_days, r8_kind)))
306else if(lowercase(units(1:11)) == 'years since') then
307! The time period between between (base_time + time_increment) and
308! (base_time + time_increment + 1 year) may be 360, 365, or 366 days.
309! This must be determined to handle time increments with year fractions.
310 call get_date(base_time, year,month,day,hour,minute,second)
311 base_time = set_date(year+floor(time_increment) ,month,day,hour,minute,second)
312 base_time_plus_one_yr = set_date(year+floor(time_increment)+1,month,day,hour,minute,second)
313 call get_time(base_time_plus_one_yr - base_time, second, day)
314 dt = real(day*spd_int+second, r8_kind)*(time_increment-real(floor(time_increment), r8_kind))
315 increment_days = floor(dt/spd_real)
316 increment_seconds = int(dt - real(increment_days*spd_int, r8_kind))
317else if(lowercase(units(1:12)) == 'months since') then
318 month_fraction = time_increment - real(floor(time_increment), r8_kind)
319 increment_years = floor(time_increment/12.0_r8_kind)
320 increment_months = floor(time_increment) - 12*increment_years
321 call get_date(base_time, year,month,day,hour,minute,second)
322 base_time = set_date(year+increment_years,month+increment_months ,day,hour,minute,second)
323 dt = real( spd_int*days_in_month(base_time), r8_kind) * month_fraction
324 increment_days = floor(dt/spd_real)
325 increment_seconds = int(dt - real(increment_days, r8_kind)*spd_real)
326else
327 call error_mesg('get_calendar_time','"'//trim(units)//'" is not an acceptable units attribute of time.'// &
328 & ' It must begin with: "years since", "months since", "days since", "hours since", "minutes since",'// &
329 & ' or "seconds since"',fatal)
330endif
331
332if (calendar_in_i /= calendar_tm_i) then
333 if(calendar_in_i == no_calendar .or. calendar_tm_i == no_calendar) then
334 call error_mesg('get_calendar_time','Cannot do calendar conversion because input calendar is '// &
335 trim(valid_calendar_types(calendar_in_i))//' and time_manager is using '// &
336 trim(valid_calendar_types(calendar_tm_i))// &
337 ' Conversion cannot be done if either is NO_CALENDAR',fatal)
338 endif
339 call get_date(base_time,year, month, day, hour, minute, second)
340 get_calendar_time = set_date(year,month,day,hour,minute,second) + set_time(increment_seconds, increment_days)
341 call get_date(get_calendar_time,year,month,day,hour,minute,second)
342 call set_calendar_type(calendar_tm_i)
343 get_calendar_time = set_date(year,month,day,hour,minute,second, err_msg=err_msg)
344 if(err_msg /= '') then
345 call error_mesg('get_calendar_time','Error in function get_calendar_time: '//trim(err_msg)// &
346 ' Note that the time_manager is using the '//trim(valid_calendar_types(calendar_tm_i))//' calendar '// &
347 'while the calendar type passed to function get_calendar_time is '//calendar_in_c,fatal)
348 endif
349else
350 get_calendar_time = base_time + set_time(increment_seconds, increment_days)
351endif
352
353end function get_calendar_time
354
355!------------------------------------------------------------------------
356
357!> For mixed precision support, just casts to passed in increment to r8
358function get_calendar_time_wrap(time_increment, units, calendar, permit_calendar_conversion)
359 real(r4_kind), intent(in) :: time_increment
360 character(len=*), intent(in) :: units
361 character(len=*), intent(in) :: calendar
362 logical, intent(in), optional :: permit_calendar_conversion
364
365 get_calendar_time_wrap = get_cal_time( real(time_increment, r8_kind), units, calendar, &
366 permit_calendar_conversion=permit_calendar_conversion)
367end function
368
369!------------------------------------------------------------------------
370
371function cut0(string)
372character(len=256) :: cut0
373character(len=*), intent(in) :: string
374integer :: i
375
376cut0 = string
377
378do i=1,len(string)
379 if(ichar(string(i:i)) == 0 ) then
380 cut0(i:i) = ' '
381 endif
382enddo
383
384return
385end function cut0
386!------------------------------------------------------------------------
387end module get_cal_time_mod
388!> @}
389! close documentation grouping
type(time_type) function get_calendar_time(time_increment, units, calendar, permit_calendar_conversion)
Calculates what a given calendar time would be after a interval of time.
type(time_type) function get_calendar_time_wrap(time_increment, units, calendar, permit_calendar_conversion)
For mixed precision support, just casts to passed in increment to r8.
Added for mixed precision support. Updates force time_manager math to be done with kind=8 reals _wrap...
character(len=24) function, public valid_calendar_types(ncal, err_msg)
Returns a character string that describes the calendar type corresponding to the input integer.
integer function, public get_calendar_type()
Returns default calendar type for mapping from time to date.
subroutine, public set_calendar_type(type, err_msg)
Sets calendar_type for mapping an interval to a date. For the Gregorian calendar, negative years and ...
integer function, public days_in_month(time, err_msg)
Given a time, computes the corresponding date given the selected date time mapping algorithm.
subroutine, public get_time(time, seconds, days, ticks, err_msg)
Returns days and seconds ( < 86400 ) corresponding to a time. err_msg should be checked for any error...
subroutine, public get_date(time, year, month, day, hour, minute, second, tick, err_msg)
Gets the date for different calendar types. Given a time_interval, returns the corresponding date und...
Given an input date in year, month, days, etc., creates a time_type that represents this time interva...
Given some number of seconds and days, returns the corresponding time_type.
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.