Line data Source code
1 : !> \file mo_datetime.f90
2 : !> \brief \copybrief mo_datetime
3 : !> \details \copydetails mo_datetime
4 :
5 : !> \brief Types to deal with datetimes.
6 : !> \details This module provides four types to deal with date and time
7 : !! 1. \ref puredate : containing year, month and day
8 : !! 2. \ref puretime : containing hour, minute and second
9 : !! 3. \ref datetime : combination of date and time
10 : !! 4. \ref timedelta : difference between two datetimes (or dates) in days and (sub-day) seconds
11 : !!
12 : !! These type can be used in arithmetic operations (+, -, *, /) and can be compared (<, >, <=, >=, ==, /=)
13 : !! where it makes sense.
14 : !!
15 : !! The following example demonstrates the functionality:
16 : !! \code{.f90}
17 : !! program main
18 : !! use mo_datetime, only: puredate, puretime, datetime, timedelta, one_day, midday, DAY_SECONDS, HOUR_SECONDS
19 : !! implicit none
20 : !! type(datetime) :: date1, date2, date3, date4, date5
21 : !! type(puredate) :: day1
22 : !! type(puretime) :: time1
23 : !! type(timedelta) :: delta1
24 : !!
25 : !! ! create dates add time-deltas
26 : !! date1 = datetime(2000, 2, 28)
27 : !! date2 = date1 + one_day()
28 : !! print*, date2%str()
29 : !! date3 = date1 + 2 * one_day()
30 : !! print*, date3%str()
31 : !!
32 : !! ! substract half a day
33 : !! delta1 = one_day() / 2
34 : !! date4 = date3 - delta1
35 : !!
36 : !! ! compare dates/times
37 : !! print*, "is midday: ", date4%time() == midday()
38 : !! print*, "date4 after date2: ", date4 > date2
39 : !!
40 : !! ! create from date and time
41 : !! date5 = datetime(date1%date(), date4%time())
42 : !! print*, date5%str()
43 : !!
44 : !! ! create from datetime string
45 : !! date5 = datetime("2023-05-08 12:32:30")
46 : !! day1 = date("2023-05-08")
47 : !! time1 = time("12:32:30")
48 : !! print*, date5 == time1%with_date(day1)
49 : !! print*, date5 == day1%with_time(time1)
50 : !! print*, date5 == datetime(day1, time1)
51 : !!
52 : !! ! use cf-convention string and value
53 : !! date5 = datetime("seconds since 1992-10-8 15:15:42", DAY_SECONDS - HOUR_SECONDS)
54 : !! print*, date5%str()
55 : !! end program main
56 : !! \endcode
57 : !!
58 : !! Several special constants are provided as well:
59 : !! - integer constants for duration ratios:
60 : !! - \ref year_days : days in standard year (365)
61 : !! - \ref leap_year_days : days in leap year (366)
62 : !! - \ref year_months : months in year (12)
63 : !! - \ref week_days : days in week (7)
64 : !! - \ref day_hours : hours in day (24)
65 : !! - \ref hour_minutes : minutes in hour (60)
66 : !! - \ref minute_seconds : seconds in minute (60)
67 : !! - \ref day_minutes : minutes in day (1440)
68 : !! - \ref day_seconds : seconds in day (86400)
69 : !! - \ref hour_seconds : seconds in hour (3600)
70 : !! - \ref week_hours : hours in week (168)
71 : !! - \ref week_minutes : minutes in week (10080)
72 : !! - \ref week_seconds : seconds in week (604800)
73 : !!
74 : !! Provided convenience routines:
75 : !! - \ref midnight and \ref midday : \ref puretime for special day times
76 : !! - \ref day_hour : \ref puretime for each hour of the day (0-23)
77 : !! - \ref zero_delta , \ref one_week , \ref one_day , \ref one_hour , \ref one_minute and \ref one_second :
78 : !! special \ref timedelta values
79 : !! - \ref currently : \copybrief currently
80 : !! - \ref today : \copybrief today
81 : !! - \ref now : \copybrief now
82 : !! - \ref is_leap_year : \copybrief is_leap_year
83 : !! - \ref days_in_month : \copybrief days_in_month
84 : !! - \ref days_in_year : \copybrief days_in_year
85 : !!
86 : !! A date is assumed to be given in the gregorian calender.
87 : !! That means, there is a leap year (February has 29 days instead of 28) if:
88 : !! - year is divisible by 4
89 : !! - year *is not* divisible by 100 or it *is* divisible by 400
90 : !!
91 : !! \note Dates before 1582-10-15 should be used with caution.
92 : !! The gregorian calender replaced the julian calender and advanced the date by
93 : !! 10 days: Thursday 4 October 1582 was followed by Friday 15 October 1582.
94 : !! Using this module for erlier dates will assume the *proleptic gregorian* calendar.
95 : !!
96 : !> \version 0.1
97 : !> \authors Sebastian Mueller
98 : !> \date May 2023
99 : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
100 : !! mHM is released under the LGPLv3+ license \license_note
101 : module mo_datetime
102 :
103 : use mo_kind, only: i4, i8, dp
104 : use mo_message, only: error_message
105 : use mo_string_utils, only : num2str
106 : use mo_julian, only : dec2date, date2dec
107 :
108 : implicit none
109 :
110 : public :: puredate
111 : public :: puretime
112 : public :: datetime
113 : public :: timedelta
114 : ! system time
115 : public :: today
116 : public :: now
117 : public :: currently
118 : ! constants
119 : public :: zero_delta
120 : public :: one_day
121 : public :: one_hour
122 : public :: one_minute
123 : public :: one_second
124 : public :: one_week
125 : public :: midnight
126 : public :: midday
127 : public :: day_hour
128 : ! checking
129 : public :: is_leap_year
130 : public :: days_in_month
131 : public :: days_in_year
132 :
133 : private
134 :
135 : integer(i4), parameter, public :: YEAR_DAYS = 365_i4 !< days in standard year
136 : integer(i4), parameter, public :: LEAP_YEAR_DAYS = 366_i4 !< days in leap year
137 : integer(i4), parameter, public :: YEAR_MONTHS = 12_i4 !< months in year
138 : integer(i4), parameter, public :: WEEK_DAYS = 7_i4 !< days in week
139 : integer(i4), parameter, public :: DAY_HOURS = 24_i4 !< hours in day
140 : integer(i4), parameter, public :: CLOCK_HOURS = 12_i4 !< hours on a clock
141 : integer(i4), parameter, public :: HOUR_MINUTES = 60_i4 !< minutes in hour
142 : integer(i4), parameter, public :: MINUTE_SECONDS = 60_i4 !< seconds in minute
143 : integer(i4), parameter, public :: DAY_MINUTES = DAY_HOURS * HOUR_MINUTES !< minutes in day
144 : integer(i4), parameter, public :: DAY_SECONDS = DAY_MINUTES * MINUTE_SECONDS !< seconds in day
145 : integer(i4), parameter, public :: HOUR_SECONDS = HOUR_MINUTES * MINUTE_SECONDS !< seconds in hour
146 : integer(i4), parameter, public :: WEEK_HOURS = WEEK_DAYS * DAY_HOURS !< hours in week
147 : integer(i4), parameter, public :: WEEK_MINUTES = WEEK_DAYS * DAY_MINUTES !< minutes in week
148 : integer(i4), parameter, public :: WEEK_SECONDS = WEEK_DAYS * DAY_SECONDS !< seconds in week
149 : integer(i4), parameter :: MIN_YEAR = 1_i4 !< minimum for year
150 : integer(i4), parameter :: MAX_YEAR = 9999_i4 !< maximum for year
151 :
152 : !> \class puredate
153 : !> \brief This is a container to hold only a date.
154 : type puredate
155 : integer(i4), public :: year = 1_i4 !< 1 <= year <= 9999
156 : integer(i4), public :: month = 1_i4 !< 1 <= month <= 12
157 : integer(i4), public :: day = 1_i4 !< 1 <= day <= number of days in the given month and year
158 : contains
159 : !> \copydoc mo_datetime::d_replace
160 : procedure, public :: replace => d_replace !< \see mo_datetime::d_replace
161 : !> \copydoc mo_datetime::dt_from_date_time
162 : procedure, public :: with_time => dt_from_date_time !< \see mo_datetime::dt_from_date_time
163 : !> \copydoc mo_datetime::to_datetime
164 : procedure, public :: to_datetime !< \see mo_datetime::to_datetime
165 : !> \copydoc mo_datetime::to_ordinal
166 : procedure, public :: to_ordinal !< \see mo_datetime::to_ordinal
167 : !> \copydoc mo_datetime::d_str
168 : procedure, public :: str => d_str !< \see mo_datetime::d_str
169 : !> \copydoc mo_datetime::d_julian
170 : procedure, public :: julian => d_julian !< \see mo_datetime::d_julian
171 : !> \copydoc mo_datetime::d_weekday
172 : procedure, public :: weekday => d_weekday !< \see mo_datetime::d_weekday
173 : !> \copydoc mo_datetime::d_doy
174 : procedure, public :: doy => d_doy !< \see mo_datetime::d_doy
175 : !> \copydoc mo_datetime::is_new_year
176 : procedure, public :: is_new_year => d_is_new_year !< \see mo_datetime::is_new_year
177 : !> \copydoc mo_datetime::is_new_month
178 : procedure, public :: is_new_month => d_is_new_month !< \see mo_datetime::is_new_month
179 : !> \copydoc mo_datetime::is_new_week
180 : procedure, public :: is_new_week => d_is_new_week !< \see mo_datetime::is_new_week
181 : procedure, private :: d_eq, d_eq_dt
182 : generic, public :: operator(==) => d_eq, d_eq_dt
183 : procedure, private :: d_neq, d_neq_dt
184 : generic, public :: operator(/=) => d_neq, d_neq_dt
185 : procedure, private :: d_lt, d_lt_dt
186 : generic, public :: operator(<) => d_lt, d_lt_dt
187 : procedure, private :: d_gt, d_gt_dt
188 : generic, public :: operator(>) => d_gt, d_gt_dt
189 : procedure, private :: d_leq, d_leq_dt
190 : generic, public :: operator(<=) => d_leq, d_leq_dt
191 : procedure, private :: d_geq, d_geq_dt
192 : generic, public :: operator(>=) => d_geq, d_geq_dt
193 : procedure, private :: d_add_td
194 : procedure, pass(this), private :: td_add_d
195 : generic, public :: operator(+) => d_add_td, td_add_d
196 : procedure, private :: d_sub_td, d_sub_d, d_sub_dt
197 : generic, public :: operator(-) => d_sub_td, d_sub_d, d_sub_dt
198 : end type puredate
199 :
200 : !> \class puretime
201 : !> \brief This is a container to hold only a time.
202 : type puretime
203 : integer(i4), public :: hour = 0_i4 !< 0 <= hour < 24
204 : integer(i4), public :: minute = 0_i4 !< 0 <= minute < 60
205 : integer(i4), public :: second = 0_i4 !< 0 <= second < 60
206 : contains
207 : !> \copydoc mo_datetime::t_replace
208 : procedure, public :: replace => t_replace !< \see mo_datetime::t_replace
209 : !> \copydoc mo_datetime::dt_from_date_time
210 : procedure, public, pass(in_time) :: with_date => dt_from_date_time !< \see mo_datetime::dt_from_date_time
211 : !> \copydoc mo_datetime::t_str
212 : procedure, public :: str => t_str !< \see mo_datetime::t_str
213 : !> \copydoc mo_datetime::t_day_second
214 : procedure, public :: day_second => t_day_second !< \see mo_datetime::t_day_second
215 : !> \copydoc mo_datetime::t_is_new_day
216 : procedure, public :: is_midnight => t_is_new_day !< \see mo_datetime::t_is_new_day
217 : !> \copydoc mo_datetime::t_is_new_day
218 : procedure, public :: is_new_day => t_is_new_day !< \see mo_datetime::t_is_new_day
219 : !> \copydoc mo_datetime::t_is_new_hour
220 : procedure, public :: is_new_hour => t_is_new_hour !< \see mo_datetime::t_is_new_hour
221 : !> \copydoc mo_datetime::t_is_new_minute
222 : procedure, public :: is_new_minute => t_is_new_minute !< \see mo_datetime::t_is_new_minute
223 : procedure, private :: t_copy
224 : generic, public :: assignment(=) => t_copy
225 : procedure, private :: t_eq
226 : generic, public :: operator(==) => t_eq
227 : procedure, private :: t_neq
228 : generic, public :: operator(/=) => t_neq
229 : procedure, private :: t_lt
230 : generic, public :: operator(<) => t_lt
231 : procedure, private :: t_gt
232 : generic, public :: operator(>) => t_gt
233 : procedure, private :: t_leq
234 : generic, public :: operator(<=) => t_leq
235 : procedure, private :: t_geq
236 : generic, public :: operator(>=) => t_geq
237 : procedure, private :: t_add_td
238 : procedure, pass(this), private :: td_add_t
239 : generic, public :: operator(+) => t_add_td, td_add_t
240 : procedure, private :: t_sub_td, t_sub_t
241 : generic, public :: operator(-) => t_sub_td, t_sub_t
242 : end type puretime
243 :
244 : !> \class datetime
245 : !> \brief This is a container to hold a date-time.
246 : type datetime
247 : integer(i4), public :: year = 1_i4 !< 1 <= year <= 9999
248 : integer(i4), public :: month = 1_i4 !< 1 <= month <= 12
249 : integer(i4), public :: day = 1_i4 !< 1 <= day <= number of days in the given month and year
250 : integer(i4), public :: hour = 0_i4 !< 0 <= hour < 24
251 : integer(i4), public :: minute = 0_i4 !< 0 <= minute < 60
252 : integer(i4), public :: second = 0_i4 !< 0 <= second < 60
253 : contains
254 : !> \copydoc mo_datetime::dt_replace
255 : procedure, public :: replace => dt_replace !< \see mo_datetime::dt_replace
256 : !> \copydoc mo_datetime::get_date
257 : procedure, public :: date => get_date !< \see mo_datetime::get_date
258 : !> \copydoc mo_datetime::get_time
259 : procedure, public :: time => get_time !< \see mo_datetime::get_time
260 : !> \copydoc mo_datetime::dt_str
261 : procedure, public :: str => dt_str !< \see mo_datetime::dt_str
262 : !> \copydoc mo_datetime::dt_julian
263 : procedure, public :: julian => dt_julian !< \see mo_datetime::dt_julian
264 : !> \copydoc mo_datetime::dt_weekday
265 : procedure, public :: weekday => dt_weekday !< \see mo_datetime::dt_weekday
266 : !> \copydoc mo_datetime::dt_doy
267 : procedure, public :: doy => dt_doy !< \see mo_datetime::dt_doy
268 : !> \copydoc mo_datetime::is_new_year
269 : procedure, public :: is_new_year !< \see mo_datetime::is_new_year
270 : !> \copydoc mo_datetime::is_new_month
271 : procedure, public :: is_new_month !< \see mo_datetime::is_new_month
272 : !> \copydoc mo_datetime::is_new_week
273 : procedure, public :: is_new_week !< \see mo_datetime::is_new_week
274 : !> \copydoc mo_datetime::is_new_day
275 : procedure, public :: is_new_day !< \see mo_datetime::is_new_day
276 : !> \copydoc mo_datetime::is_new_hour
277 : procedure, public :: is_new_hour !< \see mo_datetime::is_new_hour
278 : !> \copydoc mo_datetime::is_new_minute
279 : procedure, public :: is_new_minute !< \see mo_datetime::is_new_minute
280 : procedure, private :: dt_copy_dt, dt_copy_d
281 : generic, public :: assignment(=) => dt_copy_dt, dt_copy_d
282 : procedure, private :: dt_eq, dt_eq_d
283 : generic, public :: operator(==) => dt_eq, dt_eq_d
284 : procedure, private :: dt_neq, dt_neq_d
285 : generic, public :: operator(/=) => dt_neq, dt_neq_d
286 : procedure, private :: dt_lt, dt_lt_d
287 : generic, public :: operator(<) => dt_lt, dt_lt_d
288 : procedure, private :: dt_gt, dt_gt_d
289 : generic, public :: operator(>) => dt_gt, dt_gt_d
290 : procedure, private :: dt_leq, dt_leq_d
291 : generic, public :: operator(<=) => dt_leq, dt_leq_d
292 : procedure, private :: dt_geq, dt_geq_d
293 : generic, public :: operator(>=) => dt_geq, dt_geq_d
294 : procedure, private :: dt_add_td
295 : procedure, pass(this), private :: td_add_dt
296 : generic, public :: operator(+) => dt_add_td, td_add_dt
297 : procedure, private :: dt_sub_td, dt_sub_dt, dt_sub_d
298 : generic, public :: operator(-) => dt_sub_td, dt_sub_dt, dt_sub_d
299 : end type datetime
300 :
301 : !> \class timedelta
302 : !> \brief This is a container to hold a defined time span.
303 : type timedelta
304 : integer(i4), public :: days = 0_i4 !< days of the time-span
305 : integer(i4), public :: seconds = 0_i4 !< second of the time-span
306 : contains
307 : !> \copydoc mo_datetime::td_abs
308 : procedure, public :: abs => td_abs !< \see mo_datetime::td_abs
309 : !> \copydoc mo_datetime::td_total_seconds
310 : procedure, public :: total_seconds => td_total_seconds !< \see mo_datetime::td_total_seconds
311 : procedure, private :: td_copy
312 : generic, public :: assignment(=) => td_copy
313 : procedure, private :: td_eq
314 : generic, public :: operator(==) => td_eq
315 : procedure, private :: td_neq
316 : generic, public :: operator(/=) => td_neq
317 : procedure, private :: td_lt
318 : generic, public :: operator(<) => td_lt
319 : procedure, private :: td_gt
320 : generic, public :: operator(>) => td_gt
321 : procedure, private :: td_leq
322 : generic, public :: operator(<=) => td_leq
323 : procedure, private :: td_geq
324 : generic, public :: operator(>=) => td_geq
325 : procedure, private :: td_add, td_pos
326 : generic, public :: operator(+) => td_add, td_pos
327 : procedure, private :: td_sub, td_neg
328 : generic, public :: operator(-) => td_sub, td_neg
329 : procedure, private :: td_mul1, td_mul1_dp
330 : procedure, pass(this), private :: td_mul2, td_mul2_dp
331 : generic, public :: operator(*) => td_mul1, td_mul2, td_mul1_dp, td_mul2_dp
332 : procedure, private :: td_div, td_div_dp, td_div_td
333 : generic, public :: operator(/) => td_div, td_div_dp, td_div_td
334 : end type timedelta
335 :
336 : ! constructor interface for date
337 : interface puredate
338 : procedure d_init
339 : procedure d_from_string
340 : procedure d_from_julian
341 : end interface puredate
342 :
343 : ! constructor interface for time
344 : interface puretime
345 : procedure t_init
346 : procedure t_from_string
347 : procedure t_from_day_second
348 : end interface puretime
349 :
350 : ! constructor interface for datetime
351 : interface datetime
352 : procedure dt_init
353 : procedure dt_from_string
354 : procedure dt_from_date_time
355 : procedure dt_from_cf
356 : procedure dt_from_julian
357 : end interface datetime
358 :
359 : ! constructor interface timedelta
360 : interface timedelta
361 : procedure td_init
362 : end interface timedelta
363 :
364 : contains
365 :
366 : ! CONSTANT DELTAS
367 :
368 : !> \brief zero time delta
369 6 : pure type(timedelta) function zero_delta()
370 : zero_delta%days = 0_i4
371 : zero_delta%seconds = 0_i4
372 6 : end function zero_delta
373 :
374 : !> \brief one week time delta
375 3 : pure type(timedelta) function one_week()
376 3 : one_week%days = WEEK_DAYS
377 : one_week%seconds = 0_i4
378 9 : end function one_week
379 :
380 : !> \brief one day time delta
381 38 : pure type(timedelta) function one_day()
382 38 : one_day%days = 1_i4
383 : one_day%seconds = 0_i4
384 41 : end function one_day
385 :
386 : !> \brief one hour time delta
387 12 : pure type(timedelta) function one_hour()
388 : one_hour%days = 0_i4
389 12 : one_hour%seconds = HOUR_SECONDS
390 50 : end function one_hour
391 :
392 : !> \brief one minute time delta
393 1 : pure type(timedelta) function one_minute()
394 : one_minute%days = 0_i4
395 1 : one_minute%seconds = MINUTE_SECONDS
396 13 : end function one_minute
397 :
398 : !> \brief one second time delta
399 1 : pure type(timedelta) function one_second()
400 : one_second%days = 0_i4
401 1 : one_second%seconds = 1_i4
402 2 : end function one_second
403 :
404 : ! DAYTIMES
405 :
406 : !> \brief midnight (00:00)
407 47 : pure type(puretime) function midnight()
408 : midnight%hour = 0_i4
409 : midnight%minute = 0_i4
410 : midnight%second = 0_i4
411 48 : end function midnight
412 :
413 : !> \brief midday (12:00)
414 10 : pure type(puretime) function midday()
415 10 : midday%hour = CLOCK_HOURS
416 : midday%minute = 0_i4
417 : midday%second = 0_i4
418 57 : end function midday
419 :
420 : !> \brief time for given hour
421 10 : pure type(puretime) function day_hour(hour)
422 : integer(i4), intent(in) :: hour !< hour
423 10 : day_hour%hour = modulo(hour, DAY_HOURS)
424 : day_hour%minute = 0_i4
425 : day_hour%second = 0_i4
426 20 : end function day_hour
427 :
428 : ! CURRENT TIME/DATE
429 :
430 : !> \brief get current \ref datetime
431 6 : type(datetime) function now()
432 : integer(i4) :: values(8)
433 6 : call date_and_time(values=values)
434 6 : now = dt_init(year=values(1), month=values(2), day=values(3), hour=values(5), minute=values(6), second=values(7))
435 22 : end function now
436 :
437 : !> \brief get todays \ref puredate
438 1 : type(puredate) function today()
439 : type(datetime) :: temp
440 1 : temp = now()
441 1 : today = temp%date()
442 6 : end function today
443 :
444 : !> \brief get current \ref puretime
445 2 : type(puretime) function currently()
446 : type(datetime) :: temp
447 2 : temp = now()
448 2 : currently = temp%time()
449 1 : end function currently
450 :
451 : !> \brief day of the week
452 9 : pure integer(i4) function weekday(year, month, day)
453 : implicit none
454 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
455 : integer(i4), intent(in) :: month !< 1 <= month <= 12
456 : integer(i4), intent(in) :: day !< 1 <= day <= number of days in the given month and year
457 : integer(i4) :: year_j, year_k, mon, yea
458 : ! Zeller's congruence
459 9 : yea = year
460 9 : mon = month
461 : ! jan + feb are 13. and 14. month of previous year
462 9 : if (mon < 3_i4) then
463 9 : mon = mon + YEAR_MONTHS
464 9 : yea = yea - 1_i4
465 : end if
466 9 : year_j = yea / 100_i4
467 9 : year_k = mod(yea, 100_i4)
468 9 : weekday = mod(day + (13_i4*(mon+1_i4))/5_i4 + year_k + year_k/4_i4 + year_j/4_i4 + 5_i4*year_j, WEEK_DAYS)
469 : ! convert counting
470 9 : weekday = weekday - 1_i4
471 9 : if (weekday < 1_i4) weekday = weekday + WEEK_DAYS
472 2 : end function weekday
473 :
474 : !> \brief whether a given year is a leap year
475 204 : pure logical function is_leap_year(year)
476 : implicit none
477 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
478 204 : is_leap_year = mod(year, 4_i4) == 0_i4 .and. (mod(year, 100_i4) /= 0_i4 .or. mod(year, 400_i4) == 0_i4)
479 9 : end function is_leap_year
480 :
481 : !> \brief number of days in a given month
482 434 : pure integer(i4) function days_in_month(year, month)
483 : implicit none
484 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
485 : integer(i4), intent(in) :: month !< 1 <= month <= 12
486 : ! february is the special case
487 434 : if (month == 2_i4) then
488 143 : days_in_month = 28_i4
489 143 : if (is_leap_year(year)) days_in_month = 29_i4
490 143 : return
491 : end if
492 : ! even months before august (except february) and odd months from august on have 30 days, others 31
493 291 : if ((mod(month, 2) == 0 .and. month < 8) .or. (mod(month, 2) == 1 .and. month >= 8)) then
494 : days_in_month = 30_i4
495 : else
496 260 : days_in_month = 31_i4
497 : end if
498 638 : end function days_in_month
499 :
500 : !> \brief number of days in a given year
501 55 : pure integer(i4) function days_in_year(year)
502 : implicit none
503 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
504 55 : days_in_year = YEAR_DAYS
505 33 : if (is_leap_year(year)) days_in_year = LEAP_YEAR_DAYS
506 434 : end function days_in_year
507 :
508 : !> \brief number of days before a given year since year 1
509 136 : pure integer(i4) function days_before_year(year)
510 : implicit none
511 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
512 : integer(i4) :: y
513 136 : y = year - 1_i4
514 136 : days_before_year = y*YEAR_DAYS + y/4_i4 - y/100_i4 + y/400_i4
515 55 : end function days_before_year
516 :
517 : !> \brief get date from day of the year
518 21 : pure subroutine doy_to_month_day(year, doy, month, day)
519 : implicit none
520 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
521 : integer(i4), intent(in) :: doy !< 1 <= doy <= days_in_year (will be capped)
522 : integer(i4), intent(out), optional :: month !< month for the given doy
523 : integer(i4), intent(out), optional :: day !< day in month for the given doy
524 : integer(i4) :: i, dim, remain
525 : ! for pure function, we can't raise errors, so we force doy to be valid
526 21 : remain = min(max(doy, 1_i4), days_in_year(year))
527 86 : do i=1_i4, YEAR_MONTHS
528 86 : dim = days_in_month(year=year, month=i)
529 86 : if (remain <= dim) exit
530 86 : remain = remain - dim
531 : end do
532 21 : if (present(month)) month = i
533 21 : if (present(day)) day = remain
534 157 : end subroutine doy_to_month_day
535 :
536 : !> \brief check if a given year is valid
537 19 : subroutine check_year(year)
538 : implicit none
539 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
540 19 : if (year < MIN_YEAR .or. year > MAX_YEAR) &
541 : call error_message("datetime: year is out of range. Got: ", num2str(year)) ! LCOV_EXCL_LINE
542 21 : end subroutine check_year
543 :
544 : !> \brief check if a given month is valid
545 19 : subroutine check_month(month)
546 : implicit none
547 : integer(i4), intent(in) :: month !< 1 <= month <= 12
548 19 : if (month < 1_i4 .or. month > YEAR_MONTHS) &
549 : call error_message("datetime: month is out of range. Got: ", num2str(month)) ! LCOV_EXCL_LINE
550 19 : end subroutine check_month
551 :
552 : !> \brief check if a given day is valid
553 19 : subroutine check_day(year, month, day)
554 : implicit none
555 : integer(i4), intent(in) :: year !< 1 <= year <= 9999
556 : integer(i4), intent(in) :: month !< 1 <= month <= 12
557 : integer(i4), intent(in) :: day !< 1 <= day <= number of days in the given month and year
558 19 : if (day < 1_i4 .or. day > days_in_month(year, month)) &
559 : call error_message("datetime: day is out of range. Got: ", num2str(day)) ! LCOV_EXCL_LINE
560 19 : end subroutine check_day
561 :
562 : !> \brief check if a given hour is valid
563 20 : subroutine check_hour(hour)
564 : implicit none
565 : integer(i4), intent(in), optional :: hour !< 0 <= hour < 24
566 20 : if (hour < 0_i4 .or. hour >= DAY_HOURS) &
567 : call error_message("datetime: hour is out of range. Got: ", num2str(hour)) ! LCOV_EXCL_LINE
568 19 : end subroutine check_hour
569 :
570 : !> \brief check if a given minute is valid
571 20 : subroutine check_minute(minute)
572 : implicit none
573 : integer(i4), intent(in), optional :: minute !< 0 <= minute < 60
574 20 : if (minute < 0_i4 .or. minute >= HOUR_MINUTES) &
575 : call error_message("datetime: minute is out of range. Got: ", num2str(minute)) ! LCOV_EXCL_LINE
576 20 : end subroutine check_minute
577 :
578 : !> \brief check if a given second is valid
579 20 : subroutine check_second(second)
580 : implicit none
581 : integer(i4), intent(in), optional :: second !< 0 <= second < 60
582 20 : if (second < 0_i4 .or. second >= MINUTE_SECONDS) &
583 : call error_message("datetime: second is out of range. Got: ", num2str(second)) ! LCOV_EXCL_LINE
584 20 : end subroutine check_second
585 :
586 : !> \brief check if a datetime is valid
587 28 : subroutine check_datetime(year, month, day, hour, minute, second)
588 : implicit none
589 : integer(i4), intent(in), optional :: year !< 1 <= year <= 9999
590 : integer(i4), intent(in), optional :: month !< 1 <= month <= 12
591 : integer(i4), intent(in), optional :: day !< 1 <= day <= number of days in the given month and year
592 : integer(i4), intent(in), optional :: hour !< 0 <= hour < 24
593 : integer(i4), intent(in), optional :: minute !< 0 <= minute < 60
594 : integer(i4), intent(in), optional :: second !< 0 <= second < 60
595 : ! sanity check for day
596 28 : if (present(day) .and. .not. (present(year) .and. present(month))) &
597 : call error_message("check_datetime: to validate a given 'day', 'year' and 'month' are required.") ! LCOV_EXCL_LINE
598 : ! check components
599 28 : if (present(year)) call check_year(year)
600 28 : if (present(month)) call check_month(month)
601 28 : if (present(day)) call check_day(year, month, day)
602 28 : if (present(hour)) call check_hour(hour)
603 28 : if (present(minute)) call check_minute(minute)
604 28 : if (present(second)) call check_second(second)
605 20 : end subroutine check_datetime
606 :
607 : ! DATETIME
608 :
609 : !> \brief initialize a datetime
610 11 : function dt_init(year, month, day, hour, minute, second) result(out)
611 : implicit none
612 : integer(i4), intent(in), optional :: year !< 1 (default) <= year <= 9999
613 : integer(i4), intent(in), optional :: month !< 1 (default) <= month <= 12
614 : integer(i4), intent(in), optional :: day !< 1 (default) <= day <= number of days in the given month and year
615 : integer(i4), intent(in), optional :: hour !< 0 (default) <= hour < 24
616 : integer(i4), intent(in), optional :: minute !< 0 (default) <= minute < 60
617 : integer(i4), intent(in), optional :: second !< 0 (default) <= second < 60
618 : type(datetime) :: out
619 : out%year = 1_i4
620 11 : if (present(year)) out%year = year
621 : out%month = 1_i4
622 11 : if (present(month)) out%month = month
623 : out%day = 1_i4
624 11 : if (present(day)) out%day = day
625 : out%hour = 0_i4
626 11 : if (present(hour)) out%hour = hour
627 : out%minute = 0_i4
628 11 : if (present(minute)) out%minute = minute
629 : out%second = 0_i4
630 11 : if (present(second)) out%second = second
631 : ! check if datetime is valid
632 11 : call check_datetime(year=out%year, month=out%month, day=out%day, hour=out%hour, minute=out%minute, second=out%second)
633 28 : end function dt_init
634 :
635 : !> \brief datetime from string
636 2 : type(datetime) function dt_from_string(string)
637 11 : use mo_string_utils, only : divide_string
638 : character(*), intent(in) :: string
639 : type(puredate) :: in_date
640 : type(puretime) :: in_time
641 2 : character(256), dimension(:), allocatable :: str_arr
642 2 : call divide_string(trim(string), ' ', str_arr)
643 2 : in_date = d_from_string(str_arr(1))
644 2 : in_time = midnight()
645 2 : if(size(str_arr) > 1_i4) in_time = t_from_string(str_arr(2))
646 2 : dt_from_string = dt_from_date_time(in_date, in_time)
647 2 : end function dt_from_string
648 :
649 : !> \brief datetime from cf-string and value
650 4 : type(datetime) function dt_from_cf(string, value)
651 2 : use mo_string_utils, only : divide_string
652 : character(*), intent(in) :: string
653 : integer(i4), intent(in) :: value
654 : type(puredate) :: in_date
655 : type(puretime) :: in_time
656 : type(timedelta) :: delta
657 4 : character(256), dimension(:), allocatable :: str_arr
658 4 : call divide_string(trim(string), ' ', str_arr)
659 8 : select case(trim(str_arr(1)))
660 : case("days")
661 1 : delta = td_init(days=value)
662 : case("hours")
663 1 : delta = td_init(hours=value)
664 : case("minutes")
665 1 : delta = td_init(minutes=value)
666 : case("seconds")
667 1 : delta = td_init(seconds=value)
668 : case default
669 8 : call error_message("datetime: units not valid for a cf-convetion time. Got: ", trim(str_arr(1)))
670 : end select
671 4 : if (trim(str_arr(2)) /= "since") call error_message("datetime: expected 'since' for cf-convetion. Got: ", trim(str_arr(2)))
672 4 : in_date = d_from_string(str_arr(3))
673 4 : in_time = midnight()
674 4 : if(size(str_arr) > 3_i4) in_time = t_from_string(str_arr(4))
675 4 : dt_from_cf = dt_from_date_time(in_date, in_time) + delta
676 4 : end function dt_from_cf
677 :
678 : !> \brief datetime from date and time
679 39 : pure function dt_from_date_time(in_date, in_time) result(out)
680 : implicit none
681 : class(puredate), intent(in) :: in_date !< date to use
682 : class(puretime), intent(in), optional :: in_time !< time to use (midnight by default)
683 : type(datetime) :: out
684 : type(puretime) :: in_time_
685 39 : in_time_ = midnight()
686 39 : if (present(in_time)) in_time_ = in_time
687 39 : out%year = in_date%year
688 39 : out%month = in_date%month
689 39 : out%day = in_date%day
690 39 : out%hour = in_time_%hour
691 39 : out%minute = in_time_%minute
692 39 : out%second = in_time_%second
693 4 : end function dt_from_date_time
694 :
695 : !> \brief datetime from fractional julian day
696 1 : pure type(datetime) function dt_from_julian(julian, calendar)
697 : real(dp), intent(in) :: julian !< fractional julian day
698 : integer(i4), intent(in), optional :: calendar !< The calendar to use, the global calendar will be used by default
699 : integer(i4) :: year, month, day, hour, minute, second
700 1 : call dec2date(julian, yy=year, mm=month, dd=day, hh=hour, nn=minute, ss=second, calendar=calendar)
701 1 : dt_from_julian%year = year
702 1 : dt_from_julian%month = month
703 1 : dt_from_julian%day = day
704 1 : dt_from_julian%hour = hour
705 1 : dt_from_julian%minute = minute
706 1 : dt_from_julian%second = second
707 39 : end function dt_from_julian
708 :
709 : !> \brief new datetime with specified fields
710 1 : type(datetime) function dt_replace(this, year, month, day, hour, minute, second)
711 : implicit none
712 : class(datetime), intent(in) :: this
713 : integer(i4), intent(in), optional :: year !< 1 <= year <= 9999
714 : integer(i4), intent(in), optional :: month !< 1 <= month <= 12
715 : integer(i4), intent(in), optional :: day !< 1 <= day <= number of days in the given month and year
716 : integer(i4), intent(in), optional :: hour !< 0 <= hour < 24
717 : integer(i4), intent(in), optional :: minute !< 0 <= minute < 60
718 : integer(i4), intent(in), optional :: second !< 0 <= second < 60
719 : integer(i4) :: new_year, new_month, new_day, new_hour, new_minute, new_second
720 1 : new_year = this%year
721 1 : new_month = this%month
722 1 : new_day = this%day
723 1 : new_hour = this%hour
724 1 : new_minute = this%minute
725 1 : new_second = this%second
726 1 : if (present(year)) new_year = year
727 1 : if (present(month)) new_month = month
728 1 : if (present(day)) new_day = day
729 1 : if (present(hour)) new_hour = hour
730 1 : if (present(minute)) new_minute = minute
731 1 : if (present(second)) new_second = second
732 1 : dt_replace = dt_init(new_year, new_month, new_day, new_hour, new_minute, new_second)
733 1 : end function dt_replace
734 :
735 : !> \brief copy a datetime
736 63 : pure subroutine dt_copy_dt(this, that)
737 : implicit none
738 : class(datetime), intent(inout) :: this
739 : class(datetime), intent(in) :: that
740 63 : this%year = that%year
741 63 : this%month = that%month
742 63 : this%day = that%day
743 63 : this%hour = that%hour
744 63 : this%minute = that%minute
745 63 : this%second = that%second
746 1 : end subroutine dt_copy_dt
747 :
748 : !> \brief copy a datetime from a date
749 1 : pure subroutine dt_copy_d(this, that)
750 : implicit none
751 : class(datetime), intent(inout) :: this
752 : class(puredate), intent(in) :: that
753 1 : this%year = that%year
754 1 : this%month = that%month
755 1 : this%day = that%day
756 1 : this%hour = 0_i4
757 1 : this%minute = 0_i4
758 1 : this%second = 0_i4
759 64 : end subroutine dt_copy_d
760 :
761 : !> \brief date of the datetime
762 157 : pure type(puredate) function get_date(this)
763 : implicit none
764 : class(datetime), intent(in) :: this
765 157 : get_date%year = this%year
766 157 : get_date%month = this%month
767 157 : get_date%day = this%day
768 158 : end function get_date
769 :
770 : !> \brief time of the datetime
771 99 : pure type(puretime) function get_time(this)
772 : implicit none
773 : class(datetime), intent(in) :: this
774 99 : get_time%hour = this%hour
775 99 : get_time%minute = this%minute
776 99 : get_time%second = this%second
777 256 : end function get_time
778 :
779 : !> \brief string representation of the datetime
780 5 : pure character(19) function dt_str(this)
781 : implicit none
782 : class(datetime), intent(in) :: this
783 5 : dt_str = d_str(this%date()) // " " // t_str(this%time())
784 104 : end function dt_str
785 :
786 : !> \brief datetime as fractional julian day
787 1 : pure real(dp) function dt_julian(this, calendar)
788 : implicit none
789 : class(datetime), intent(in) :: this
790 : integer(i4), intent(in), optional :: calendar !< The calendar to use, the global calendar will be used by default
791 1 : dt_julian = date2dec(yy=this%year, mm=this%month, dd=this%day, hh=this%hour, nn=this%minute, ss=this%second, calendar=calendar)
792 5 : end function dt_julian
793 :
794 : !> \brief day of the week
795 6 : pure integer(i4) function dt_weekday(this)
796 : implicit none
797 : class(datetime), intent(in) :: this
798 6 : dt_weekday = weekday(this%year, this%month, this%day)
799 7 : end function dt_weekday
800 :
801 : !> \brief day of the year
802 12 : pure integer(i4) function dt_doy(this)
803 : implicit none
804 : class(datetime), intent(in) :: this
805 24 : dt_doy = d_doy(this%date())
806 18 : end function dt_doy
807 :
808 : !> \brief datetime is a new year
809 2 : pure logical function is_new_year(this)
810 : implicit none
811 : class(datetime), intent(in) :: this
812 4 : is_new_year = this%is_new_month() .and. this%month == 1_i4
813 12 : end function is_new_year
814 :
815 : !> \brief datetime is a new month
816 4 : pure logical function is_new_month(this)
817 : implicit none
818 : class(datetime), intent(in) :: this
819 8 : is_new_month = this%is_new_day() .and. this%day == 1_i4
820 2 : end function is_new_month
821 :
822 : !> \brief datetime is a new week
823 2 : pure logical function is_new_week(this)
824 : implicit none
825 : class(datetime), intent(in) :: this
826 2 : is_new_week = this%is_new_day() .and. this%weekday() == 1_i4
827 4 : end function is_new_week
828 :
829 : !> \brief datetime is a new day
830 8 : pure logical function is_new_day(this)
831 : implicit none
832 : class(datetime), intent(in) :: this
833 16 : is_new_day = this%is_new_hour() .and. this%hour == 0_i4
834 2 : end function is_new_day
835 :
836 : !> \brief datetime is a new hour
837 10 : pure logical function is_new_hour(this)
838 : implicit none
839 : class(datetime), intent(in) :: this
840 20 : is_new_hour = this%is_new_minute() .and. this%minute == 0_i4
841 8 : end function is_new_hour
842 :
843 : !> \brief datetime is a new month
844 12 : pure logical function is_new_minute(this)
845 : implicit none
846 : class(datetime), intent(in) :: this
847 12 : is_new_minute = this%second == 0_i4
848 10 : end function is_new_minute
849 :
850 : !> \brief equal comparison of datetimes
851 28 : pure logical function dt_eq(this, that)
852 : implicit none
853 : class(datetime), intent(in) :: this, that
854 28 : dt_eq = this%date() == that%date() .and. this%time() == that%time()
855 40 : end function dt_eq
856 :
857 : !> \brief equal comparison of datetime and date
858 2 : pure logical function dt_eq_d(this, that)
859 : implicit none
860 : class(datetime), intent(in) :: this
861 : class(puredate), intent(in) :: that
862 4 : dt_eq_d = dt_eq(this, that%to_datetime())
863 28 : end function dt_eq_d
864 :
865 : !> \brief not equal comparison of datetimes
866 9 : pure logical function dt_neq(this, that)
867 : implicit none
868 : class(datetime), intent(in) :: this, that
869 9 : dt_neq = .not. dt_eq(this, that)
870 2 : end function dt_neq
871 :
872 : !> \brief not equal comparison of datetime and date
873 1 : pure logical function dt_neq_d(this, that)
874 : implicit none
875 : class(datetime), intent(in) :: this
876 : class(puredate), intent(in) :: that
877 1 : dt_neq_d = .not. dt_eq_d(this, that)
878 10 : end function dt_neq_d
879 :
880 : !> \brief less than comparison of datetimes
881 16 : pure logical function dt_lt(this, that)
882 : implicit none
883 : class(datetime), intent(in) :: this, that
884 16 : dt_lt = this%date() < that%date() .or. (this%date() == that%date() .and. this%time() < that%time())
885 17 : end function dt_lt
886 :
887 : !> \brief less than comparison of datetime and date
888 1 : pure logical function dt_lt_d(this, that)
889 : implicit none
890 : class(datetime), intent(in) :: this
891 : class(puredate), intent(in) :: that
892 : ! they need to be unequal
893 2 : dt_lt_d = dt_lt(this, that%to_datetime())
894 16 : end function dt_lt_d
895 :
896 : !> \brief greater than comparison of datetimes
897 7 : pure logical function dt_gt(this, that)
898 : implicit none
899 : class(datetime), intent(in) :: this, that
900 7 : dt_gt = dt_neq(this, that) .and. .not. dt_lt(this, that)
901 1 : end function dt_gt
902 :
903 : !> \brief greater than comparison of datetime and date
904 1 : pure logical function dt_gt_d(this, that)
905 : implicit none
906 : class(datetime), intent(in) :: this
907 : class(puredate), intent(in) :: that
908 : ! they need to be unequal
909 2 : dt_gt_d = dt_gt(this, that%to_datetime())
910 8 : end function dt_gt_d
911 :
912 : !> \brief less than or equal comparison of datetimes
913 5 : pure logical function dt_leq(this, that)
914 : implicit none
915 : class(datetime), intent(in) :: this, that
916 5 : dt_leq = dt_lt(this, that) .or. dt_eq(this, that)
917 1 : end function dt_leq
918 :
919 : !> \brief less than or equal comparison of datetime and date
920 1 : pure logical function dt_leq_d(this, that)
921 : implicit none
922 : class(datetime), intent(in) :: this
923 : class(puredate), intent(in) :: that
924 : ! they need to be unequal
925 2 : dt_leq_d = dt_leq(this, that%to_datetime())
926 6 : end function dt_leq_d
927 :
928 : !> \brief greater than or equal comparison of datetimes
929 3 : pure logical function dt_geq(this, that)
930 : implicit none
931 : class(datetime), intent(in) :: this, that
932 3 : dt_geq = dt_gt(this, that) .or. dt_eq(this, that)
933 1 : end function dt_geq
934 :
935 : !> \brief less than or equal comparison of datetime and date
936 1 : pure logical function dt_geq_d(this, that)
937 : implicit none
938 : class(datetime), intent(in) :: this
939 : class(puredate), intent(in) :: that
940 : ! they need to be unequal
941 2 : dt_geq_d = dt_geq(this, that%to_datetime())
942 4 : end function dt_geq_d
943 :
944 : !> \brief add a timedelta to a datetime
945 13 : pure type(datetime) function dt_add_td(this, that)
946 : implicit none
947 : class(datetime), intent(in) :: this
948 : class(timedelta), intent(in) :: that
949 : type(timedelta) :: temp
950 : type(puredate) :: new_date
951 : type(puretime) :: new_time
952 : ! handle sub-day timing
953 13 : temp = td_init(days=that%days, seconds=this%second+that%seconds, minutes=this%minute, hours=this%hour)
954 : ! use date/time methods
955 13 : new_date = this%date() + temp
956 13 : new_time = t_from_day_second(temp%seconds)
957 13 : dt_add_td = dt_from_date_time(new_date, new_time)
958 1 : end function dt_add_td
959 :
960 : !> \brief add a timedelta to a datetime
961 1 : pure type(datetime) function td_add_dt(that, this)
962 : implicit none
963 : class(datetime), intent(in) :: this
964 : class(timedelta), intent(in) :: that
965 1 : td_add_dt = dt_add_td(this, that)
966 13 : end function td_add_dt
967 :
968 : !> \brief subtract a timedelta from a datetime
969 2 : pure type(datetime) function dt_sub_td(this, that)
970 : implicit none
971 : class(datetime), intent(in) :: this
972 : class(timedelta), intent(in) :: that
973 2 : dt_sub_td = this + (-that)
974 1 : end function dt_sub_td
975 :
976 : !> \brief difference between two datetimes
977 6 : pure type(timedelta) function dt_sub_dt(this, that)
978 : implicit none
979 : class(datetime), intent(in) :: this, that
980 : type(timedelta) :: tmp_this, tmp_that
981 : integer(i4) :: minyear, maxyear, days_this, days_that, day_year_diff, i
982 6 : minyear = min(this%year, that%year)
983 6 : maxyear = max(this%year, that%year)
984 : ! get year difference in days
985 6 : day_year_diff = 0_i4
986 16 : do i=minyear, maxyear-1_i4
987 16 : day_year_diff = day_year_diff + days_in_year(i)
988 : end do
989 6 : days_this = this%doy()
990 6 : days_that = that%doy()
991 6 : if (this%year < that%year) days_that = days_that + day_year_diff
992 6 : if (this%year > that%year) days_this = days_this + day_year_diff
993 : ! substract the differences of both dates to <min_year-1>-12-31
994 6 : tmp_this = timedelta(days=days_this, seconds=this%second, minutes=this%minute, hours=this%hour)
995 6 : tmp_that = timedelta(days=days_that, seconds=that%second, minutes=that%minute, hours=that%hour)
996 6 : dt_sub_dt = tmp_this - tmp_that
997 2 : end function dt_sub_dt
998 :
999 : !> \brief difference between datetime and date
1000 1 : pure type(timedelta) function dt_sub_d(this, that)
1001 : implicit none
1002 : class(datetime), intent(in) :: this
1003 : class(puredate), intent(in) :: that
1004 1 : dt_sub_d = dt_sub_dt(this, that%to_datetime())
1005 6 : end function dt_sub_d
1006 :
1007 : ! DATE
1008 :
1009 : !> \brief initialize a date
1010 8 : function d_init(year, month, day) result(out)
1011 : implicit none
1012 : integer(i4), intent(in), optional :: year !< 1 (default) <= year <= 9999
1013 : integer(i4), intent(in), optional :: month !< 1 (default) <= month <= 12
1014 : integer(i4), intent(in), optional :: day !< 1 (default) <= day <= number of days for given month and year
1015 : type(puredate) :: out
1016 : out%year = 1_i4
1017 8 : if (present(year)) out%year = year
1018 : out%month = 1_i4
1019 8 : if (present(month)) out%month = month
1020 : out%day = 1_i4
1021 8 : if (present(day)) out%day = day
1022 8 : call check_datetime(year=out%year, month=out%month, day=out%day)
1023 1 : end function d_init
1024 :
1025 : !> \brief date from string
1026 7 : type(puredate) function d_from_string(string)
1027 8 : use mo_string_utils, only : divide_string
1028 : character(*), intent(in) :: string
1029 7 : character(256), dimension(:), allocatable :: date_str
1030 : integer(i4) :: year, month, day
1031 7 : call divide_string(trim(string), '-', date_str)
1032 7 : read(date_str(1), *) year
1033 7 : read(date_str(2), *) month
1034 7 : read(date_str(3), *) day
1035 7 : d_from_string = d_init(year=year, month=month, day=day)
1036 7 : end function d_from_string
1037 :
1038 : !> \brief date from fractional julian day
1039 1 : pure type(puredate) function d_from_julian(julian, calendar)
1040 : real(dp), intent(in) :: julian !< fractional julian day
1041 : integer(i4), intent(in), optional :: calendar !< The calendar to use, the global calendar will be used by default
1042 : integer(i4) :: year, month, day
1043 1 : call dec2date(julian, yy=year, mm=month, dd=day, calendar=calendar)
1044 1 : d_from_julian%year = year
1045 1 : d_from_julian%month = month
1046 1 : d_from_julian%day = day
1047 7 : end function d_from_julian
1048 :
1049 : !> \brief new date with specified fields
1050 1 : type(puredate) function d_replace(this, year, month, day)
1051 : implicit none
1052 : class(puredate), intent(in) :: this
1053 : integer(i4), intent(in), optional :: year !< 1 <= year <= 9999
1054 : integer(i4), intent(in), optional :: month !< 1 <= month <= 12
1055 : integer(i4), intent(in), optional :: day !< 1 <= day <= number of days in the given month and year
1056 : integer(i4) :: new_year, new_month, new_day
1057 1 : new_year = this%year
1058 1 : new_month = this%month
1059 1 : new_day = this%day
1060 1 : if (present(year)) new_year = year
1061 1 : if (present(month)) new_month = month
1062 1 : if (present(day)) new_day = day
1063 1 : d_replace = d_init(new_year, new_month, new_day)
1064 1 : end function d_replace
1065 :
1066 : !> \brief convert date to a datetime
1067 16 : pure type(datetime) function to_datetime(this)
1068 : implicit none
1069 : class(puredate), intent(in) :: this
1070 16 : to_datetime = dt_from_date_time(this)
1071 1 : end function to_datetime
1072 :
1073 : !> \brief convert date to number of days since year 1
1074 136 : pure integer(i4) function to_ordinal(this)
1075 : implicit none
1076 : class(puredate), intent(in) :: this
1077 272 : to_ordinal = days_before_year(this%year) + this%doy()
1078 16 : end function to_ordinal
1079 :
1080 : !> \brief string representation of the date
1081 5 : pure character(10) function d_str(this)
1082 : implicit none
1083 : class(puredate), intent(in) :: this
1084 5 : write(d_str, "(i4.4, '-' ,i2.2, '-', i2.2)") this%year, this%month, this%day
1085 136 : end function d_str
1086 :
1087 : !> \brief date as fractional julian day
1088 1 : pure real(dp) function d_julian(this, calendar)
1089 : implicit none
1090 : class(puredate), intent(in) :: this
1091 : integer(i4), intent(in), optional :: calendar !< The calendar to use, the global calendar will be used by default
1092 1 : d_julian = date2dec(yy=this%year, mm=this%month, dd=this%day, calendar=calendar)
1093 5 : end function d_julian
1094 :
1095 : !> \brief day of the week
1096 3 : pure integer(i4) function d_weekday(this)
1097 : implicit none
1098 : class(puredate), intent(in) :: this
1099 3 : d_weekday = weekday(this%year, this%month, this%day)
1100 4 : end function d_weekday
1101 :
1102 : !> \brief day of the year
1103 169 : pure integer(i4) function d_doy(this)
1104 : implicit none
1105 : class(puredate), intent(in) :: this
1106 : integer(i4) :: i
1107 169 : d_doy = this%day
1108 494 : do i=1_i4, this%month-1_i4
1109 494 : d_doy = d_doy + days_in_month(year=this%year, month=i)
1110 : end do
1111 172 : end function d_doy
1112 :
1113 : !> \brief date is a new year
1114 2 : pure logical function d_is_new_year(this)
1115 : implicit none
1116 : class(puredate), intent(in) :: this
1117 4 : d_is_new_year = this%is_new_month() .and. this%month == 1_i4
1118 169 : end function d_is_new_year
1119 :
1120 : !> \brief date is a new month
1121 4 : pure logical function d_is_new_month(this)
1122 : implicit none
1123 : class(puredate), intent(in) :: this
1124 4 : d_is_new_month = this%day == 1_i4
1125 2 : end function d_is_new_month
1126 :
1127 : !> \brief date is a new week
1128 2 : pure logical function d_is_new_week(this)
1129 : implicit none
1130 : class(puredate), intent(in) :: this
1131 4 : d_is_new_week = this%weekday() == 1_i4
1132 6 : end function d_is_new_week
1133 :
1134 : !> \brief equal comparison of dates
1135 49 : pure logical function d_eq(this, that)
1136 : implicit none
1137 : class(puredate), intent(in) :: this, that
1138 49 : d_eq = this%to_ordinal() == that%to_ordinal()
1139 2 : end function d_eq
1140 :
1141 : !> \brief equal comparison of date and datetime
1142 1 : pure logical function d_eq_dt(this, that)
1143 : implicit none
1144 : class(puredate), intent(in) :: this
1145 : class(datetime), intent(in) :: that
1146 2 : d_eq_dt = dt_eq(this%to_datetime(), that)
1147 49 : end function d_eq_dt
1148 :
1149 : !> \brief not equal comparison of dates
1150 2 : pure logical function d_neq(this, that)
1151 : implicit none
1152 : class(puredate), intent(in) :: this, that
1153 2 : d_neq = .not. d_eq(this, that)
1154 1 : end function d_neq
1155 :
1156 : !> \brief not equal comparison of date and datetime
1157 1 : pure logical function d_neq_dt(this, that)
1158 : implicit none
1159 : class(puredate), intent(in) :: this
1160 : class(datetime), intent(in) :: that
1161 2 : d_neq_dt = dt_neq(this%to_datetime(), that)
1162 3 : end function d_neq_dt
1163 :
1164 : !> \brief less than comparison of dates
1165 19 : pure logical function d_lt(this, that)
1166 : implicit none
1167 : class(puredate), intent(in) :: this, that
1168 19 : d_lt = this%to_ordinal() < that%to_ordinal()
1169 1 : end function d_lt
1170 :
1171 : !> \brief less than comparison of date and datetime
1172 1 : pure logical function d_lt_dt(this, that)
1173 : implicit none
1174 : class(puredate), intent(in) :: this
1175 : class(datetime), intent(in) :: that
1176 2 : d_lt_dt = dt_lt(this%to_datetime(), that)
1177 19 : end function d_lt_dt
1178 :
1179 : !> \brief greater than comparison of dates
1180 2 : pure logical function d_gt(this, that)
1181 : implicit none
1182 : class(puredate), intent(in) :: this, that
1183 2 : d_gt = d_neq(this, that) .and. .not. d_lt(this, that)
1184 1 : end function d_gt
1185 :
1186 : !> \brief greater than comparison of date and datetime
1187 1 : pure logical function d_gt_dt(this, that)
1188 : implicit none
1189 : class(puredate), intent(in) :: this
1190 : class(datetime), intent(in) :: that
1191 2 : d_gt_dt = dt_gt(this%to_datetime(), that)
1192 3 : end function d_gt_dt
1193 :
1194 : !> \brief less than or equal comparison of dates
1195 1 : pure logical function d_leq(this, that)
1196 : implicit none
1197 : class(puredate), intent(in) :: this, that
1198 1 : d_leq = d_lt(this, that) .or. d_eq(this, that)
1199 1 : end function d_leq
1200 :
1201 : !> \brief less than or equal comparison of date and datetime
1202 1 : pure logical function d_leq_dt(this, that)
1203 : implicit none
1204 : class(puredate), intent(in) :: this
1205 : class(datetime), intent(in) :: that
1206 2 : d_leq_dt = dt_leq(this%to_datetime(), that)
1207 2 : end function d_leq_dt
1208 :
1209 : !> \brief greater than or equal comparison of dates
1210 1 : pure logical function d_geq(this, that)
1211 : implicit none
1212 : class(puredate), intent(in) :: this, that
1213 1 : d_geq = d_gt(this, that) .or. d_eq(this, that)
1214 1 : end function d_geq
1215 :
1216 : !> \brief greater than or equal comparison of date and datetime
1217 1 : pure logical function d_geq_dt(this, that)
1218 : implicit none
1219 : class(puredate), intent(in) :: this
1220 : class(datetime), intent(in) :: that
1221 2 : d_geq_dt = dt_geq(this%to_datetime(), that)
1222 2 : end function d_geq_dt
1223 :
1224 : !> \brief add a timedelta to a date
1225 21 : pure type(puredate) function d_add_td(this, that)
1226 : implicit none
1227 : class(puredate), intent(in) :: this
1228 : class(timedelta), intent(in) :: that
1229 : integer(i4) :: new_year, new_month, new_day, day_delta, diy
1230 : ! find the new year
1231 21 : new_year = this%year
1232 42 : day_delta = this%doy() + that%days
1233 21 : if (day_delta > 0_i4) then
1234 2 : do while (.true.)
1235 22 : diy = days_in_year(new_year)
1236 22 : if (day_delta <= diy) exit
1237 2 : new_year = new_year + 1_i4
1238 22 : day_delta = day_delta - diy
1239 : end do
1240 : else
1241 : do while (.true.)
1242 2 : new_year = new_year - 1_i4
1243 2 : diy = days_in_year(new_year)
1244 2 : day_delta = day_delta + diy
1245 2 : if (day_delta > 0_i4) exit
1246 : end do
1247 : end if
1248 : ! get date from new year and doy
1249 21 : call doy_to_month_day(year=new_year, doy=day_delta, month=new_month, day=new_day)
1250 21 : d_add_td%year = new_year
1251 21 : d_add_td%month = new_month
1252 21 : d_add_td%day = new_day
1253 1 : end function d_add_td
1254 :
1255 : !> \brief add a timedelta to a date
1256 1 : pure type(puredate) function td_add_d(that, this)
1257 : implicit none
1258 : class(puredate), intent(in) :: this
1259 : class(timedelta), intent(in) :: that
1260 1 : td_add_d = d_add_td(this, that)
1261 21 : end function td_add_d
1262 :
1263 : !> \brief subtract a timedelta from a date
1264 1 : pure type(puredate) function d_sub_td(this, that)
1265 : implicit none
1266 : class(puredate), intent(in) :: this
1267 : class(timedelta), intent(in) :: that
1268 1 : d_sub_td = this + (-that)
1269 3 : end function d_sub_td
1270 :
1271 : !> \brief difference between two dates
1272 1 : pure type(timedelta) function d_sub_d(this, that)
1273 : implicit none
1274 : class(puredate), intent(in) :: this, that
1275 : ! use datetime routine
1276 1 : d_sub_d = this%to_datetime() - that%to_datetime()
1277 1 : end function d_sub_d
1278 :
1279 : !> \brief difference between date and datetime
1280 1 : pure type(timedelta) function d_sub_dt(this, that)
1281 : implicit none
1282 : class(puredate), intent(in) :: this
1283 : class(datetime), intent(in) :: that
1284 : ! use datetime routine
1285 1 : d_sub_dt = this%to_datetime() - that
1286 1 : end function d_sub_dt
1287 :
1288 : ! TIME
1289 :
1290 : !> \brief initialize a time
1291 9 : function t_init(hour, minute, second) result(out)
1292 : implicit none
1293 : integer(i4), intent(in) :: hour !< 0 <= hour < 24
1294 : integer(i4), intent(in) :: minute !< 0 <= minute < 60
1295 : integer(i4), intent(in), optional :: second !< 0 (default) <= second < 60
1296 : type(puretime) :: out
1297 9 : out%hour = hour
1298 9 : out%minute = minute
1299 : out%second = 0_i4
1300 9 : if (present(second)) out%second = second
1301 : ! check if datetime is valid
1302 9 : call check_datetime(hour=out%hour, minute=out%minute, second=out%second)
1303 1 : end function t_init
1304 :
1305 : !> \brief time from string
1306 7 : type(puretime) function t_from_string(string)
1307 9 : use mo_string_utils, only : divide_string
1308 : character(*), intent(in) :: string
1309 7 : character(256), dimension(:), allocatable :: time_str
1310 : integer(i4) :: hour, minute, second
1311 7 : call divide_string(trim(string), ':', time_str)
1312 7 : read(time_str(1), *) hour
1313 7 : read(time_str(2), *) minute
1314 7 : read(time_str(3), *) second
1315 7 : t_from_string = t_init(hour=hour, minute=minute, second=second)
1316 7 : end function t_from_string
1317 :
1318 : !> \brief time from day second
1319 22 : pure type(puretime) function t_from_day_second(day_second)
1320 : implicit none
1321 : integer(i4), intent(in) :: day_second !< second of the day (will be capped)
1322 : integer(i4) :: temp_seconds
1323 : ! cap second for pure function (no error raise possible)
1324 22 : temp_seconds = min(max(day_second, 0_i4), DAY_SECONDS-1_i4)
1325 : ! calculate hour, minute and second
1326 22 : t_from_day_second%hour = temp_seconds / HOUR_SECONDS
1327 22 : temp_seconds = mod(temp_seconds, HOUR_SECONDS)
1328 22 : t_from_day_second%minute = temp_seconds / MINUTE_SECONDS
1329 22 : t_from_day_second%second = mod(temp_seconds, MINUTE_SECONDS)
1330 7 : end function t_from_day_second
1331 :
1332 : !> \brief copy a time
1333 120 : pure subroutine t_copy(this, that)
1334 : implicit none
1335 : class(puretime), intent(inout) :: this
1336 : class(puretime), intent(in) :: that
1337 120 : this%hour = that%hour
1338 120 : this%minute = that%minute
1339 120 : this%second = that%second
1340 142 : end subroutine t_copy
1341 :
1342 : !> \brief new time with specified fields
1343 2 : type(puretime) function t_replace(this, hour, minute, second)
1344 : implicit none
1345 : class(puretime), intent(in) :: this
1346 : integer(i4), intent(in), optional :: hour !< 0 <= hour < 24
1347 : integer(i4), intent(in), optional :: minute !< 0 <= minute < 60
1348 : integer(i4), intent(in), optional :: second !< 0 <= second < 60
1349 : integer(i4) :: new_hour, new_minute, new_second
1350 2 : new_hour = this%hour
1351 2 : new_minute = this%minute
1352 2 : new_second = this%second
1353 2 : if (present(hour)) new_hour = hour
1354 2 : if (present(minute)) new_minute = minute
1355 2 : if (present(second)) new_second = second
1356 2 : t_replace = t_init(new_hour, new_minute, new_second)
1357 124 : end function t_replace
1358 :
1359 : !> \brief string representation of the time
1360 5 : pure character(8) function t_str(this)
1361 : implicit none
1362 : class(puretime), intent(in) :: this
1363 5 : write(t_str, "(i2.2, ':', i2.2, ':', i2.2)") this%hour, this%minute, this%second
1364 2 : end function t_str
1365 :
1366 : !> \brief time to second of the day
1367 133 : pure integer(i4) function t_day_second(this)
1368 : implicit none
1369 : class(puretime), intent(in) :: this
1370 133 : t_day_second = this%hour * HOUR_SECONDS + this%minute * MINUTE_SECONDS + this%second
1371 5 : end function t_day_second
1372 :
1373 : !> \brief time is a new day / midnight
1374 2 : pure logical function t_is_new_day(this)
1375 : implicit none
1376 : class(puretime), intent(in) :: this
1377 4 : t_is_new_day = this%is_new_hour() .and. this%hour == 0_i4
1378 135 : end function t_is_new_day
1379 :
1380 : !> \brief time is a new hour
1381 4 : pure logical function t_is_new_hour(this)
1382 : implicit none
1383 : class(puretime), intent(in) :: this
1384 8 : t_is_new_hour = this%is_new_minute() .and. this%minute == 0_i4
1385 2 : end function t_is_new_hour
1386 :
1387 : !> \brief time is a new month
1388 6 : pure logical function t_is_new_minute(this)
1389 : implicit none
1390 : class(puretime), intent(in) :: this
1391 6 : t_is_new_minute = this%second == 0_i4
1392 4 : end function t_is_new_minute
1393 :
1394 : !> \brief equal comparison of times
1395 40 : pure logical function t_eq(this, that)
1396 : implicit none
1397 : class(puretime), intent(in) :: this, that
1398 40 : t_eq = this%day_second() == that%day_second()
1399 46 : end function t_eq
1400 :
1401 : !> \brief not equal comparison of times
1402 2 : pure logical function t_neq(this, that)
1403 : implicit none
1404 : class(puretime), intent(in) :: this, that
1405 2 : t_neq = .not. t_eq(this, that)
1406 40 : end function t_neq
1407 :
1408 : !> \brief less than comparison of times
1409 17 : pure logical function t_lt(this, that)
1410 : implicit none
1411 : class(puretime), intent(in) :: this, that
1412 17 : t_lt = this%day_second() < that%day_second()
1413 19 : end function t_lt
1414 :
1415 : !> \brief greater than comparison of times
1416 1 : pure logical function t_gt(this, that)
1417 : implicit none
1418 : class(puretime), intent(in) :: this, that
1419 1 : t_gt = this%day_second() > that%day_second()
1420 17 : end function t_gt
1421 :
1422 : !> \brief less than or equal comparison of times
1423 1 : pure logical function t_leq(this, that)
1424 : implicit none
1425 : class(puretime), intent(in) :: this, that
1426 1 : t_leq = this%day_second() <= that%day_second()
1427 1 : end function t_leq
1428 :
1429 : !> \brief greater than or equal comparison of times
1430 1 : pure logical function t_geq(this, that)
1431 : implicit none
1432 : class(puretime), intent(in) :: this, that
1433 1 : t_geq = this%day_second() >= that%day_second()
1434 1 : end function t_geq
1435 :
1436 : !> \brief add a timedelta to a time
1437 9 : pure type(puretime) function t_add_td(this, that)
1438 : implicit none
1439 : class(puretime), intent(in) :: this
1440 : class(timedelta), intent(in) :: that
1441 : ! ignore days in timedelta and do a module 24h
1442 9 : t_add_td = t_from_day_second(int(modulo(int(this%day_second(), i8) + that%total_seconds(), int(DAY_SECONDS, i8)), i4))
1443 1 : end function t_add_td
1444 :
1445 : !> \brief add a timedelta to a time
1446 1 : pure type(puretime) function td_add_t(that, this)
1447 : implicit none
1448 : class(puretime), intent(in) :: this
1449 : class(timedelta), intent(in) :: that
1450 1 : td_add_t = t_add_td(this, that)
1451 9 : end function td_add_t
1452 :
1453 : !> \brief subtract a timedelta from a time
1454 4 : pure type(puretime) function t_sub_td(this, that)
1455 : implicit none
1456 : class(puretime), intent(in) :: this
1457 : class(timedelta), intent(in) :: that
1458 4 : t_sub_td = this + (-that)
1459 1 : end function t_sub_td
1460 :
1461 : !> \brief difference between two times
1462 2 : pure type(timedelta) function t_sub_t(this, that)
1463 : implicit none
1464 : class(puretime), intent(in) :: this, that
1465 : ! use datetime routine
1466 2 : t_sub_t = timedelta(seconds=this%day_second() - that%day_second())
1467 4 : end function t_sub_t
1468 :
1469 : ! TIMEDELTA
1470 :
1471 : !> \brief initialize a timedelta
1472 91 : pure function td_init(days, seconds, minutes, hours, weeks) result(out)
1473 : implicit none
1474 : integer(i4), intent(in), optional :: days !< days defining time-span
1475 : integer(i4), intent(in), optional :: seconds !< seconds defining time-span
1476 : integer(i4), intent(in), optional :: minutes !< minutes defining time-span
1477 : integer(i4), intent(in), optional :: hours !< hours defining time-span
1478 : integer(i4), intent(in), optional :: weeks !< weeks defining time-span
1479 : type(timedelta) :: out
1480 : integer(i4) :: neg_days, remain_sec
1481 :
1482 86 : if (present(days)) out%days = days
1483 91 : if (present(weeks)) out%days = out%days + weeks * WEEK_DAYS
1484 91 : if (present(seconds)) out%seconds = seconds
1485 91 : if (present(minutes)) out%seconds = out%seconds + minutes * MINUTE_SECONDS
1486 91 : if (present(hours)) out%seconds = out%seconds + hours * HOUR_SECONDS
1487 :
1488 : ! force: 0 <= seconds < 86400
1489 91 : if (out%seconds < 0) then
1490 10 : neg_days = abs(out%seconds) / DAY_SECONDS
1491 10 : remain_sec = mod(abs(out%seconds), DAY_SECONDS)
1492 : ! add full days in negative seconds
1493 10 : out%seconds = out%seconds + neg_days * DAY_SECONDS
1494 10 : out%days = out%days - neg_days
1495 : ! add one days to remaining seconds if still negative
1496 10 : if (remain_sec > 0) then
1497 10 : out%seconds = out%seconds + DAY_SECONDS
1498 10 : out%days = out%days - 1_i4
1499 : end if
1500 : end if
1501 91 : if (out%seconds >= DAY_SECONDS) then
1502 5 : neg_days = out%seconds / DAY_SECONDS
1503 5 : out%seconds = out%seconds - neg_days * DAY_SECONDS
1504 5 : out%days = out%days + neg_days
1505 : end if
1506 2 : end function td_init
1507 :
1508 : !> \brief absolute timedelta
1509 3 : pure type(timedelta) function td_abs(this)
1510 : implicit none
1511 : class(timedelta), intent(in) :: this
1512 : integer(i4) :: days, seconds
1513 3 : if (this%days < 0_i4) then
1514 2 : days = -this%days
1515 2 : seconds = -this%seconds
1516 : else
1517 1 : days = this%days
1518 1 : seconds = this%seconds
1519 : end if
1520 3 : td_abs = timedelta(days=days, seconds=seconds)
1521 91 : end function td_abs
1522 :
1523 : !> \brief timedelta in seconds (may need i8)
1524 82 : pure integer(i8) function td_total_seconds(this)
1525 : implicit none
1526 : class(timedelta), intent(in) :: this
1527 82 : td_total_seconds = int(this%days, i8) * int(DAY_SECONDS, i8) + int(this%seconds, i8)
1528 3 : end function td_total_seconds
1529 :
1530 8 : pure type(timedelta) function from_total_seconds(total_seconds)
1531 : integer(i8), intent(in) :: total_seconds
1532 : integer(i8) :: daysec
1533 8 : daysec = int(DAY_SECONDS, i8)
1534 8 : from_total_seconds = timedelta(days=int(total_seconds / daysec, i4), seconds=int(mod(total_seconds, daysec), i4))
1535 98 : end function from_total_seconds
1536 :
1537 : !> \brief copy a timedelta
1538 139 : pure subroutine td_copy(this, that)
1539 : implicit none
1540 : class(timedelta), intent(inout) :: this
1541 : class(timedelta), intent(in) :: that
1542 139 : this%days = that%days
1543 139 : this%seconds = that%seconds
1544 8 : end subroutine td_copy
1545 :
1546 : !> \brief equal comparison of timedeltas
1547 18 : pure logical function td_eq(this, that)
1548 : implicit none
1549 : class(timedelta), intent(in) :: this, that
1550 18 : td_eq = this%total_seconds() == that%total_seconds()
1551 157 : end function td_eq
1552 :
1553 : !> \brief not equal comparison of timedeltas
1554 1 : pure logical function td_neq(this, that)
1555 : implicit none
1556 : class(timedelta), intent(in) :: this, that
1557 1 : td_neq = .not. td_eq(this, that)
1558 18 : end function td_neq
1559 :
1560 : !> \brief less than comparison of timedeltas
1561 4 : pure logical function td_lt(this, that)
1562 : implicit none
1563 : class(timedelta), intent(in) :: this, that
1564 4 : td_lt = this%total_seconds() < that%total_seconds()
1565 5 : end function td_lt
1566 :
1567 : !> \brief greater than comparison of timedeltas
1568 5 : pure logical function td_gt(this, that)
1569 : implicit none
1570 : class(timedelta), intent(in) :: this, that
1571 5 : td_gt = this%total_seconds() > that%total_seconds()
1572 4 : end function td_gt
1573 :
1574 : !> \brief less than or equal comparison of timedeltas
1575 1 : pure logical function td_leq(this, that)
1576 : implicit none
1577 : class(timedelta), intent(in) :: this, that
1578 1 : td_leq = this%total_seconds() <= that%total_seconds()
1579 5 : end function td_leq
1580 :
1581 : !> \brief greater than or equal comparison of timedeltas
1582 3 : pure logical function td_geq(this, that)
1583 : implicit none
1584 : class(timedelta), intent(in) :: this, that
1585 3 : td_geq = this%total_seconds() >= that%total_seconds()
1586 1 : end function td_geq
1587 :
1588 : !> \brief adding two timedeltas
1589 4 : pure type(timedelta) function td_add(this, that)
1590 : implicit none
1591 : class(timedelta), intent(in) :: this, that
1592 4 : td_add = timedelta(days=this%days+that%days, seconds=this%seconds+that%seconds)
1593 3 : end function td_add
1594 :
1595 : !> \brief adding two timedeltas
1596 9 : pure type(timedelta) function td_sub(this, that)
1597 : implicit none
1598 : class(timedelta), intent(in) :: this, that
1599 9 : td_sub = timedelta(days=this%days-that%days, seconds=this%seconds-that%seconds)
1600 4 : end function td_sub
1601 :
1602 : !> \brief negative timedelta
1603 11 : pure type(timedelta) function td_neg(this)
1604 : implicit none
1605 : class(timedelta), intent(in) :: this
1606 11 : td_neg = timedelta(days=-this%days, seconds=-this%seconds)
1607 9 : end function td_neg
1608 :
1609 : !> \brief positive timedelta
1610 2 : pure type(timedelta) function td_pos(this)
1611 : implicit none
1612 : class(timedelta), intent(in) :: this
1613 2 : td_pos = this
1614 11 : end function td_pos
1615 :
1616 : !> \brief multiply a timedelta with an integer
1617 20 : pure type(timedelta) function td_mul1(this, that)
1618 : implicit none
1619 : class(timedelta), intent(in) :: this
1620 : integer(i4), intent(in) :: that
1621 20 : td_mul1 = timedelta(days=this%days*that, seconds=this%seconds*that)
1622 2 : end function td_mul1
1623 :
1624 : !> \brief multiply a timedelta with an integer
1625 19 : pure type(timedelta) function td_mul2(that, this)
1626 : implicit none
1627 : class(timedelta), intent(in) :: this
1628 : integer(i4), intent(in) :: that
1629 19 : td_mul2 = td_mul1(this, that)
1630 20 : end function td_mul2
1631 :
1632 : !> \brief multiply a timedelta with a real
1633 7 : pure type(timedelta) function td_mul1_dp(this, that)
1634 : implicit none
1635 : class(timedelta), intent(in) :: this
1636 : real(dp), intent(in) :: that
1637 7 : td_mul1_dp = from_total_seconds(int(this%total_seconds() * that, i8))
1638 19 : end function td_mul1_dp
1639 :
1640 : !> \brief multiply a timedelta with a real
1641 3 : pure type(timedelta) function td_mul2_dp(that, this)
1642 : implicit none
1643 : class(timedelta), intent(in) :: this
1644 : real(dp), intent(in) :: that
1645 3 : td_mul2_dp = td_mul1_dp(this, that)
1646 7 : end function td_mul2_dp
1647 :
1648 : !> \brief divide a timedelta by an integer
1649 1 : pure type(timedelta) function td_div(this, that)
1650 : implicit none
1651 : class(timedelta), intent(in) :: this
1652 : integer(i4), intent(in) :: that
1653 1 : td_div = from_total_seconds(this%total_seconds() / int(that, i8))
1654 3 : end function td_div
1655 :
1656 : !> \brief divide a timedelta by a real
1657 1 : pure type(timedelta) function td_div_dp(this, that)
1658 : implicit none
1659 : class(timedelta), intent(in) :: this
1660 : real(dp), intent(in) :: that
1661 1 : td_div_dp = this * (1.0_dp / that)
1662 1 : end function td_div_dp
1663 :
1664 : !> \brief divide a timedelta by a timedelta
1665 1 : pure real(dp) function td_div_td(this, that)
1666 : implicit none
1667 : class(timedelta), intent(in) :: this, that
1668 1 : td_div_td = real(this%total_seconds(), dp) / real(that%total_seconds(), dp)
1669 1 : end function td_div_td
1670 :
1671 1 : end module mo_datetime
|
