SUEWS API Site
Documentation of SUEWS source code
suews_util_datetime.f95
Go to the documentation of this file.
1 ! Courtesy of wavebitscientific
2 ! https://wavebitscientific.github.io/datetime-fortran/
3 
4 !
5 ! datetime-fortran - A Fortran library for date and time manipulation
6 ! Copyright (c) 2013-2017, Wavebit Scientific LLC
7 ! All rights reserved.
8 !
9 ! Licensed under the BSD 3-clause license. See LICENSE for details.
10 !
12 !=======================================================================
13 !
14 ! mod_strftime: Interfaces to strftime and strptime procedures from
15 ! from C/C++ standard library.
16 !
17 !=======================================================================
18 
19  use, intrinsic :: iso_c_binding, only: c_char, c_int
20 
21  implicit none
22 
23  private
24 
25  public :: tm_struct
26  public :: c_strftime
27  public :: c_strptime
28 
29  type, bind(c) :: tm_struct
30 
31  !! A derived type provided for compatibility with C/C++ time struct.
32  !! Allows for calling strftime and strptime procedures through the
33  !! iso_c_binding.
34 
35  integer(kind=c_int) :: tm_sec !! Seconds [0-60] (1 leap second)
36  integer(kind=c_int) :: tm_min !! Minutes [0-59]
37  integer(kind=c_int) :: tm_hour !! Hours [0-23]
38  integer(kind=c_int) :: tm_mday !! Day [1-31]
39  integer(kind=c_int) :: tm_mon !! Month [0-11]
40  integer(kind=c_int) :: tm_year !! Year - 1900
41  integer(kind=c_int) :: tm_wday !! Day of week [0-6]
42  integer(kind=c_int) :: tm_yday !! Days in year [0-365]
43  integer(kind=c_int) :: tm_isdst !! DST [-1/0/1]
44 
45  endtype tm_struct
46 !=======================================================================
47 
48  interface
49 
50  !! Interface to C procedures strftime and strptime through
51  !! iso_c_binding.
52 
53  function c_strftime(str, slen, format, tm) &
54  bind(c, name='strftime') result(rc)
55 
56  !! Returns a formatted time string, given input time struct and
57  !! format. Refer to C standard library documentation for more
58  !! information.
59 
60  import :: c_char, c_int
61  import :: tm_struct
62 
63  implicit none
64 
65  ! Arguments
66  character(kind=c_char), dimension(*), intent(out) :: str !! result string
67  integer(kind=c_int), value, intent(in) :: slen !! string length
68  character(kind=c_char), dimension(*), intent(in) :: format !! time format
69  type(tm_struct), intent(in) :: tm !! tm_struct instance
70  integer(kind=c_int) :: rc !! return code
71 
72  endfunction c_strftime
73 
74  function c_strptime(str, format, tm) bind(c, name='strptime') result(rc)
75 
76  !! Returns a time struct object based on the input time string str,
77  !! formatted using format. Refer to C standard library documentation
78  !! for more information.
79 
80  import :: c_char, c_int
81  import :: tm_struct
82 
83  implicit none
84 
85  ! Arguments
86  character(kind=c_char), dimension(*), intent(in) :: str !! input string
87  character(kind=c_char), dimension(*), intent(in) :: format !! time format
88  type(tm_struct), intent(out) :: tm !! result tm_struct
89  integer(kind=c_int) :: rc !! return code
90 
91  endfunction c_strptime
92 
93  endinterface
94 !=======================================================================
95 endmodule mod_strftime
96 
97 !
98 ! datetime-fortran - A Fortran library for date and time manipulation
99 ! Copyright (c) 2013-2016, Wavebit Scientific LLC
100 ! All rights reserved.
101 !
102 ! Licensed under the BSD-3 clause license. See LICENSE for details.
103 !
105 !=======================================================================
106 !
107 ! mod_constants: Basic constants and time conversion factors.
108 !
109 !=======================================================================
110 
111  use, intrinsic :: iso_fortran_env, only: real32, real64
112 
113  implicit none
114 
115  private
116 
117  public :: zero, one, d2h, h2d, d2m, m2d, m2h, s2d, d2s, h2s, s2h, m2s, s2m, maxstrlen
118 
119  real(kind=real64), parameter :: zero = 0_real64 !! 0
120  real(kind=real64), parameter :: one = 1_real64 !! 1
121 
122 ! Constant multipliers that transform a number
123 ! of some time unit to another:
124  real(kind=real64), parameter :: d2h = 24_real64 !! day -> hour
125  real(kind=real64), parameter :: h2d = one/d2h !! hour -> day
126  real(kind=real64), parameter :: d2m = d2h*60_real64 !! day -> minute
127  real(kind=real64), parameter :: m2d = one/d2m !! minute -> day
128  real(kind=real64), parameter :: m2h = one/60_real64 !! minute -> hour
129  real(kind=real64), parameter :: s2d = m2d/60_real64 !! second -> day
130  real(kind=real64), parameter :: d2s = 86400_real64 !! day -> second
131  real(kind=real64), parameter :: h2s = 3600_real64 !! hour -> second
132  real(kind=real64), parameter :: s2h = one/h2s !! second -> hour
133  real(kind=real64), parameter :: m2s = 60_real64 !! minute -> second
134  real(kind=real64), parameter :: s2m = one/m2s !! second -> minute
135 
136 ! Maximum string length for strftime.
137 ! Constant for now; may become a preprocessor macro later.
138  integer, parameter :: maxstrlen = 99
139 
140 !=======================================================================
141 endmodule mod_constants
142 
143 !
144 ! datetime-fortran - A Fortran library for date and time manipulation
145 ! Copyright (c) 2013-2017, Wavebit Scientific LLC
146 ! All rights reserved.
147 !
148 ! Licensed under the BSD 3-clause license. See LICENSE for details.
149 !
151 !=======================================================================
152 !
153 ! mod_timedelta: Module that provides the timedelta class and its
154 ! type-bound methods and operators.
155 !
156 !=======================================================================
157 
158  use, intrinsic :: iso_fortran_env, only: real32, real64
159 
160  implicit none
161 
162  private
163 
164  public :: timedelta
165 
166  type :: timedelta
167 
168  !! Class of objects that define difference between two datetime
169  !! instances.
170 
171  private
172 
173  integer :: days = 0 !! number of days
174  integer :: hours = 0 !! number of hours
175  integer :: minutes = 0 !! number of minutes
176  integer :: seconds = 0 !! number of seconds
177  integer :: milliseconds = 0 !! number of milliseconds
178 
179  contains
180 
181  ! getter functions
182  procedure, pass(self), public :: getDays
183  procedure, pass(self), public :: getHours
184  procedure, pass(self), public :: getMinutes
185  procedure, pass(self), public :: getSeconds
186  procedure, pass(self), public :: getMilliseconds
187 
188  ! public methods
189  procedure, public :: total_seconds
190 
191  ! operator overloading procedures
192  procedure, private :: timedelta_plus_timedelta
193  procedure, private :: timedelta_minus_timedelta
194  procedure, private :: unary_minus_timedelta
195  procedure, private :: eq
196  procedure, private :: neq
197  procedure, private :: gt
198  procedure, private :: ge
199  procedure, private :: lt
200  procedure, private :: le
201 
202  generic :: operator(+) => timedelta_plus_timedelta
203  generic :: operator(-) => timedelta_minus_timedelta, &
204  unary_minus_timedelta
205  generic :: operator(==) => eq
206  generic :: operator(/=) => neq
207  generic :: operator(>) => gt
208  generic :: operator(>=) => ge
209  generic :: operator(<) => lt
210  generic :: operator(<=) => le
211 
212  endtype timedelta
213 
214  interface timedelta
215  module procedure :: timedelta_constructor
216  endinterface timedelta
217 
218 !=======================================================================
219 contains
220 
221  pure elemental type(timedelta) function timedelta_constructor(days, &
222  hours, minutes, seconds, milliseconds)
224  !! Constructor function for the `timedelta` class.
225 
226  integer, intent(in), optional :: days !! number of days
227  integer, intent(in), optional :: hours !! number of hours
228  integer, intent(in), optional :: minutes !! number of minutes
229  integer, intent(in), optional :: seconds !! number of seconds
230  integer, intent(in), optional :: milliseconds !! number of milliseconds
231 
232  if (present(days)) then
233  timedelta_constructor%days = days
234  else
235  timedelta_constructor%days = 0
236  endif
237 
238  if (present(hours)) then
239  timedelta_constructor%hours = hours
240  else
241  timedelta_constructor%hours = 0
242  endif
243 
244  if (present(minutes)) then
245  timedelta_constructor%minutes = minutes
246  else
247  timedelta_constructor%minutes = 0
248  endif
249 
250  if (present(seconds)) then
251  timedelta_constructor%seconds = seconds
252  else
253  timedelta_constructor%seconds = 0
254  endif
255 
256  if (present(milliseconds)) then
257  timedelta_constructor%milliseconds = milliseconds
258  else
259  timedelta_constructor%milliseconds = 0
260  endif
261 
262  endfunction timedelta_constructor
263 
264 ! timedelta getters
265 !=======================================================================
266 
267  pure elemental integer function getdays(self)
268  !! Returns the number of days.
269  class(timedelta), intent(in) :: self !! `timedelta` instance
270  getdays = self%days
271  endfunction getdays
272 
273  pure elemental integer function gethours(self)
274  !! Returns the number of hours.
275  class(timedelta), intent(in) :: self !! `timedelta` instance
276  gethours = self%hours
277  endfunction gethours
278 
279  pure elemental integer function getminutes(self)
280  !! Returns the number of minutes.
281  class(timedelta), intent(in) :: self !! `timedelta` instance
282  getminutes = self%minutes
283  endfunction getminutes
284 
285  pure elemental integer function getseconds(self)
286  !! Returns the number of seconds.
287  class(timedelta), intent(in) :: self !! `timedelta` instance
288  getseconds = self%seconds
289  endfunction getseconds
290 
291  pure elemental integer function getmilliseconds(self)
292  !! Returns the number of milliseconds.
293  class(timedelta), intent(in) :: self !! `timedelta` instance
294  getmilliseconds = self%milliseconds
295  endfunction getmilliseconds
296 
297  pure elemental real(kind=real64) function total_seconds(self)
299  !! Returns a total number of seconds contained in a `timedelta`
300  !! instance.
301 
302  class(timedelta), intent(in) :: self !! `timedelta` instance
303 
304  total_seconds = self%days*86400._real64 &
305  + self%hours*3600._real64 &
306  + self%minutes*60._real64 &
307  + self%seconds &
308  + self%milliseconds*1e-3_real64
309 
310  endfunction total_seconds
311 
312  pure elemental function timedelta_plus_timedelta(t0, t1) result(t)
314  !! Adds two `timedelta` instances together and returns a `timedelta`
315  !! instance. Overloads the operator `+`.
316 
317  class(timedelta), intent(in) :: t0 !! lhs `timedelta` instance
318  type(timedelta), intent(in) :: t1 !! rhs `timedelta` instance
319  type(timedelta) :: t !! result
320 
321  t = timedelta(days=t0%days + t1%days, &
322  hours=t0%hours + t1%hours, &
323  minutes=t0%minutes + t1%minutes, &
324  seconds=t0%seconds + t1%seconds, &
325  milliseconds=t0%milliseconds + t1%milliseconds)
326 
327  endfunction timedelta_plus_timedelta
328 
329  pure elemental function timedelta_minus_timedelta(t0, t1) result(t)
331  !! Subtracts a `timedelta` instance from another. Returns a
332  !! `timedelta` instance. Overloads the operator `-`.
333 
334  class(timedelta), intent(in) :: t0 !! lhs `timedelta` instance
335  type(timedelta), intent(in) :: t1 !! lhs `timedelta` instance
336  type(timedelta) :: t !! result
337 
338  t = t0 + (-t1)
339 
340  endfunction timedelta_minus_timedelta
341 
342  pure elemental function unary_minus_timedelta(t0) result(t)
344  !! Takes a negative of a `timedelta` instance. Overloads the operator
345  !! `-`.
346 
347  class(timedelta), intent(in) :: t0 !! `timedelta` instance
348  type(timedelta) :: t !! result
349 
350  t%days = -t0%days
351  t%hours = -t0%hours
352  t%minutes = -t0%minutes
353  t%seconds = -t0%seconds
354  t%milliseconds = -t0%milliseconds
355 
356  endfunction unary_minus_timedelta
357 
358  pure elemental logical function eq(td0, td1)
360  !! `timedelta` object comparison operator. Returns `.true.` if `td0`
361  !! is equal to `td1` and `.false.` otherwise. Overloads the operator
362  !! `==`.
363 
364  class(timedelta), intent(in) :: td0 !! lhs `timedelta` instance
365  type(timedelta), intent(in) :: td1 !! rhs `timedelta` instance
366 
367  eq = td0%total_seconds() == td1%total_seconds()
368 
369  endfunction eq
370 
371  pure elemental logical function neq(td0, td1)
373  !! `timedelta` object comparison operator. Returns `.true.` if `td0`
374  !! is not equal to `td1` and `.false.` otherwise. Overloads the
375  !! operator `/=`.
376 
377  class(timedelta), intent(in) :: td0 !! lhs `timedelta` instance
378  type(timedelta), intent(in) :: td1 !! rhs `timedelta` instance
379 
380  neq = .not. (td0%total_seconds() == td1%total_seconds())
381 
382  endfunction neq
383 
384  pure elemental logical function gt(td0, td1)
386  !! `timedelta` object comparison operator. Returns `.true.` if
387  !! `td0` is greater than `td1` and `.false.` otherwise. Overloads the
388  !! operator `>`.
389 
390  class(timedelta), intent(in) :: td0 !! lhs `timedelta` instance
391  type(timedelta), intent(in) :: td1 !! rhs `timedelta` instance
392 
393  gt = td0%total_seconds() > td1%total_seconds()
394 
395  endfunction gt
396 
397  pure elemental logical function ge(td0, td1)
399  !! `timedelta` object comparison operator. Returns `.true.` if `td0`
400  !! is greater than or equal to `td1` and `.false.` otherwise.
401  !! Overloads the operator >=.
402 
403  class(timedelta), intent(in) :: td0 !! lhs `timedelta` instance
404  type(timedelta), intent(in) :: td1 !! rhs `timedelta` instance
405 
406  ge = td0%total_seconds() >= td1%total_seconds()
407 
408  endfunction ge
409 
410  pure elemental logical function lt(td0, td1)
412  !! `timedelta` object comparison operator. Returns `.true.` if `td0`
413  !! is less than `td1` and `.false.` otherwise. Overloads the operator
414  !! `<`.
415 
416  class(timedelta), intent(in) :: td0 !! lhs `timedelta` instance
417  type(timedelta), intent(in) :: td1 !! rhs `timedelta` instance
418 
419  lt = td0%total_seconds() < td1%total_seconds()
420 
421  endfunction lt
422 
423  pure elemental logical function le(td0, td1)
425  !! `timedelta` object comparison operator. Returns `.true.` if `td0`
426  !! is less than or equal to `td1` and `.false.` otherwise. Overloads
427  !! the operator `<=`.
428 
429  class(timedelta), intent(in) :: td0 !! lhs `timedelta` instance
430  type(timedelta), intent(in) :: td1 !! rhs `timedelta` instance
431 
432  le = td0%total_seconds() <= td1%total_seconds()
433 
434  endfunction le
435 !=======================================================================
436 endmodule mod_timedelta
437 
438 !
439 ! datetime-fortran - A Fortran library for date and time manipulation
440 ! Copyright (c) 2013-2017, Wavebit Scientific LLC
441 ! All rights reserved.
442 !
443 ! Licensed under the BSD 3-clause license. See LICENSE for details.
444 !
446 !=======================================================================
447 !
448 ! mod_datetime: Module that provides the datetime class and its
449 ! type-bound methods and operators. At the time being,
450 ! this module also includes some procedures not
451 ! associated with datetime.
452 !
453 !=======================================================================
454 
455  use, intrinsic :: iso_fortran_env, only: real32, real64
456  use, intrinsic :: iso_c_binding, only: c_char, c_int, c_null_char
457  use :: mod_timedelta, only:timedelta
459  use :: mod_constants
460 
461  implicit none
462 
463  private
464 
465  public :: datetime
466  public :: date2num
467  public :: datetimerange
468  public :: daysinmonth
469  public :: daysinyear
470  public :: isleapyear
471  public :: num2date
472  public :: strptime
473  public :: tm2date
474 
475  type :: datetime
476 
477  !! Main datetime class for date and time representation.
478 
479  private
480 
481  integer :: year = 1 !! year [1-HUGE(year)]
482  integer :: month = 1 !! month in year [1-12]
483  integer :: day = 1 !! day in month [1-31]
484  integer :: hour = 0 !! hour in day [0-23]
485  integer :: minute = 0 !! minute in hour [0-59]
486  integer :: second = 0 !! second in minute [0-59]
487  integer :: millisecond = 0 !! milliseconds in second [0-999]
488 
489  real(kind=real64) :: tz = 0 !! timezone offset from UTC [hours]
490 
491  contains
492 
493  ! getter functions
494  procedure, pass(self), public :: getYear
495  procedure, pass(self), public :: getMonth
496  procedure, pass(self), public :: getDay
497  procedure, pass(self), public :: getHour
498  procedure, pass(self), public :: getMinute
499  procedure, pass(self), public :: getSecond
500  procedure, pass(self), public :: getMillisecond
501  procedure, pass(self), public :: getTz
502 
503  ! public methods
504  procedure, pass(self), public :: isocalendar
505  procedure, pass(self), public :: isoformat
506  procedure, pass(self), public :: isValid
507  procedure, nopass, public :: now
508  procedure, pass(self), public :: secondsSinceEpoch
509  procedure, pass(self), public :: strftime
510  procedure, pass(self), public :: tm
511  procedure, pass(self), public :: tzOffset
512  procedure, pass(self), public :: utc
513  procedure, pass(self), public :: weekday
514  procedure, pass(self), public :: isoweekday
515  procedure, pass(self), public :: weekdayLong
516  procedure, pass(self), public :: isoweekdayLong
517  procedure, pass(self), public :: weekdayShort
518  procedure, pass(self), public :: isoweekdayShort
519  procedure, pass(self), public :: yearday
520 
521  ! private methods
522  procedure, pass(self), private :: addMilliseconds
523  procedure, pass(self), private :: addSeconds
524  procedure, pass(self), private :: addMinutes
525  procedure, pass(self), private :: addHours
526  procedure, pass(self), private :: addDays
527 
528  ! operator overloading procedures
529  procedure, pass(d0), private :: datetime_plus_timedelta
530  procedure, pass(d0), private :: timedelta_plus_datetime
531  procedure, pass(d0), private :: datetime_minus_datetime
532  procedure, pass(d0), private :: datetime_minus_timedelta
533  procedure, pass(d0), private :: eq
534  procedure, pass(d0), private :: neq
535  procedure, pass(d0), private :: gt
536  procedure, pass(d0), private :: ge
537  procedure, pass(d0), private :: lt
538  procedure, pass(d0), private :: le
539 
540  generic :: operator(+) => datetime_plus_timedelta, &
541  timedelta_plus_datetime
542  generic :: operator(-) => datetime_minus_datetime, &
543  datetime_minus_timedelta
544  generic :: operator(==) => eq
545  generic :: operator(/=) => neq
546  generic :: operator(>) => gt
547  generic :: operator(>=) => ge
548  generic :: operator(<) => lt
549  generic :: operator(<=) => le
550 
551  endtype datetime
552 
553  interface datetime
554  module procedure :: datetime_constructor
555  endinterface datetime
556 
557 !=======================================================================
558 contains
559 
560  pure elemental type(datetime) function datetime_constructor(year, month, &
561  day, hour, minute, second, millisecond, tz)
563  !! Constructor function for the `datetime` class.
564 
565  integer, intent(in), optional :: year !! year
566  integer, intent(in), optional :: month !! month
567  integer, intent(in), optional :: day !! day
568  integer, intent(in), optional :: hour !! hour
569  integer, intent(in), optional :: minute !! minute
570  integer, intent(in), optional :: second !! second
571  integer, intent(in), optional :: millisecond !! millisecond
572  real(kind=real64), intent(in), optional :: tz !! timezone offset in hours
573 
574  if (present(year)) then
575  datetime_constructor%year = year
576  else
577  datetime_constructor%year = 1
578  endif
579 
580  if (present(month)) then
581  datetime_constructor%month = month
582  else
583  datetime_constructor%month = 1
584  endif
585 
586  if (present(day)) then
587  datetime_constructor%day = day
588  else
589  datetime_constructor%day = 1
590  endif
591 
592  if (present(hour)) then
593  datetime_constructor%hour = hour
594  else
595  datetime_constructor%hour = 0
596  endif
597 
598  if (present(minute)) then
599  datetime_constructor%minute = minute
600  else
601  datetime_constructor%minute = 0
602  endif
603 
604  if (present(second)) then
605  datetime_constructor%second = second
606  else
607  datetime_constructor%second = 0
608  endif
609 
610  if (present(millisecond)) then
611  datetime_constructor%millisecond = millisecond
612  else
613  datetime_constructor%millisecond = 0
614  endif
615 
616  if (present(tz)) then
617  datetime_constructor%tz = tz
618  else
619  datetime_constructor%tz = 0
620  endif
621 
622  endfunction datetime_constructor
623 
624 ! datetime getters
625 !=======================================================================
626 
627  pure elemental integer function getyear(self)
628  !! Returns the year component
629  class(datetime), intent(in) :: self !! `datetime` instance
630  getyear = self%year
631  endfunction getyear
632 
633  pure elemental integer function getmonth(self)
634  !! Returns the year component
635  class(datetime), intent(in) :: self !! `datetime` instance
636  getmonth = self%month
637  endfunction getmonth
638 
639  pure elemental integer function getday(self)
640  !! Returns the year component
641  class(datetime), intent(in) :: self !! `datetime` instance
642  getday = self%day
643  endfunction getday
644 
645  pure elemental integer function gethour(self)
646  !! Returns the year component
647  class(datetime), intent(in) :: self !! `datetime` instance
648  gethour = self%hour
649  endfunction gethour
650 
651  pure elemental integer function getminute(self)
652  !! Returns the year component
653  class(datetime), intent(in) :: self !! `datetime` instance
654  getminute = self%minute
655  endfunction getminute
656 
657  pure elemental integer function getsecond(self)
658  !! Returns the year component
659  class(datetime), intent(in) :: self !! `datetime` instance
660  getsecond = self%second
661  endfunction getsecond
662 
663  pure elemental integer function getmillisecond(self)
664  !! Returns the year component
665  class(datetime), intent(in) :: self !! `datetime` instance
666  getmillisecond = self%millisecond
667  endfunction getmillisecond
668 
669  pure elemental real(kind=real64) function gettz(self)
670  !! Returns the timezone offset component
671  class(datetime), intent(in) :: self !! `datetime` instance
672  gettz = self%tz
673  endfunction gettz
674 
675  pure elemental subroutine addmilliseconds(self, ms)
677  !! Adds an integer number of milliseconds to self. Called by `datetime`
678  !! addition (`+`) and subtraction (`-`) operators.
679 
680  class(datetime), intent(inout) :: self !! `datetime` instance
681  integer, intent(in) :: ms !! number of milliseconds to add
682 
683  self%millisecond = self%millisecond + ms
684 
685  do
686  if (self%millisecond >= 1000) then
687  call self%addSeconds(self%millisecond/1000)
688  self%millisecond = mod(self%millisecond, 1000)
689  elseif (self%millisecond < 0) then
690  call self%addSeconds(self%millisecond/1000 - 1)
691  self%millisecond = mod(self%millisecond, 1000) + 1000
692  else
693  exit
694  endif
695  enddo
696 
697  endsubroutine addmilliseconds
698 
699 ! datetime-bound methods
700 !=======================================================================
701 
702  pure elemental subroutine addseconds(self, s)
704  !! Adds an integer number of seconds to self. Called by `datetime`
705  !! addition (`+`) and subtraction (`-`) operators.
706 
707  class(datetime), intent(inout) :: self !! `datetime` instance
708  integer, intent(in) :: s !! number of seconds to add
709 
710  self%second = self%second + s
711 
712  do
713  if (self%second >= 60) then
714  call self%addMinutes(self%second/60)
715  self%second = mod(self%second, 60)
716  elseif (self%second < 0) then
717  call self%addMinutes(self%second/60 - 1)
718  self%second = mod(self%second, 60) + 60
719  else
720  exit
721  endif
722  enddo
723 
724  endsubroutine addseconds
725 
726  pure elemental subroutine addminutes(self, m)
728  !! Adds an integer number of minutes to self. Called by `datetime`
729  !! addition (`+`) and subtraction (`-`) operators.
730 
731  class(datetime), intent(inout) :: self !! `datetime` instance
732  integer, intent(in) :: m !! number of minutes to add
733 
734  self%minute = self%minute + m
735 
736  do
737  if (self%minute >= 60) then
738  call self%addHours(self%minute/60)
739  self%minute = mod(self%minute, 60)
740  elseif (self%minute < 0) then
741  call self%addHours(self%minute/60 - 1)
742  self%minute = mod(self%minute, 60) + 60
743  else
744  exit
745  endif
746  enddo
747 
748  endsubroutine addminutes
749 
750  pure elemental subroutine addhours(self, h)
752  !! Adds an integer number of hours to self. Called by `datetime`
753  !! addition (`+`) and subtraction (`-`) operators.
754 
755  class(datetime), intent(inout) :: self !! `datetime` instance
756  integer, intent(in) :: h !! number of hours to add
757 
758  self%hour = self%hour + h
759 
760  do
761  if (self%hour >= 24) then
762  call self%addDays(self%hour/24)
763  self%hour = mod(self%hour, 24)
764  elseif (self%hour < 0) then
765  call self%addDays(self%hour/24 - 1)
766  self%hour = mod(self%hour, 24) + 24
767  else
768  exit
769  endif
770  enddo
771 
772  endsubroutine addhours
773 
774  pure elemental subroutine adddays(self, d)
776  !! Adds an integer number of dayss to self. Called by `datetime`
777  !! addition (`+`) and subtraction (`-`) operators.
778 
779  class(datetime), intent(inout) :: self !! `datetime` instance
780  integer, intent(in) :: d !! number of days to add
781 
782  integer :: daysInCurrentMonth
783 
784  self%day = self%day + d
785  do
786  daysincurrentmonth = daysinmonth(self%month, self%year)
787  if (self%day > daysincurrentmonth) then
788  self%day = self%day - daysincurrentmonth
789  self%month = self%month + 1
790  if (self%month > 12) then
791  self%year = self%year + self%month/12
792  self%month = mod(self%month, 12)
793  endif
794  elseif (self%day < 1) then
795  self%month = self%month - 1
796  if (self%month < 1) then
797  self%year = self%year + self%month/12 - 1
798  self%month = 12 + mod(self%month, 12)
799  endif
800  self%day = self%day + daysinmonth(self%month, self%year)
801  else
802  exit
803  endif
804  enddo
805 
806  endsubroutine adddays
807 
808  pure elemental character(len=23) function isoformat(self, sep)
810  !! Returns character string with time in ISO 8601 format.
811 
812  class(datetime), intent(in) :: self !! `datetime instance`
813  character(len=1), intent(in), optional :: sep
814  !! separator character, 'T' is default
815 
816  character(len=1) :: separator
817 
818  if (present(sep)) then
819  separator = sep
820  else
821  separator = 'T'
822  endif
823 
824  ! TODO below is a bit cumbersome and was implemented
825  ! at a time before the interface to strftime. Now we
826  ! could do something like:
827  !
828  ! isoformat = self % strftime('%Y-%m-%d'//separator//'%H:%M:%S')
829  !
830  isoformat = int2str(self%year, 4)//'-'// &
831  int2str(self%month, 2)//'-'// &
832  int2str(self%day, 2)//separator// &
833  int2str(self%hour, 2)//':'// &
834  int2str(self%minute, 2)//':'// &
835  int2str(self%second, 2)//'.'// &
836  int2str(self%millisecond, 3)
837 
838  endfunction isoformat
839 
840  pure elemental logical function isvalid(self)
842  !! Checks whether the `datetime` instance has valid component values.
843  !! Returns `.true.` if the `datetime` instance is valid, and `.false.`
844  !! otherwise.
845 
846  class(datetime), intent(in) :: self !! `datetime` instance
847 
848  ! assume valid
849  isvalid = .true.
850 
851  if (self%year < 1) then
852  isvalid = .false.
853  return
854  endif
855 
856  if (self%month < 1 .or. self%month > 12) then
857  isvalid = .false.
858  return
859  endif
860 
861  if (self%day < 1 .or. &
862  self%day > daysinmonth(self%month, self%year)) then
863  isvalid = .false.
864  return
865  endif
866 
867  if (self%hour < 0 .or. self%hour > 23) then
868  isvalid = .false.
869  return
870  endif
871 
872  if (self%minute < 0 .or. self%minute > 59) then
873  isvalid = .false.
874  return
875  endif
876 
877  if (self%second < 0 .or. self%second > 59) then
878  isvalid = .false.
879  return
880  endif
881 
882  if (self%millisecond < 0 .or. self%millisecond > 999) then
883  isvalid = .false.
884  return
885  endif
886 
887  endfunction isvalid
888 
889  type(datetime) function now()
891  !! Returns a `datetime` instance with current time.
892  !! No input arguments.
893 
894  character(len=5) :: zone
895  integer, dimension(8) :: values
896 
897  integer :: hour, minute
898 
899  ! Obtain local machine time zone information
900  call date_and_time(zone=zone, values=values)
901 
902  read (unit=zone(1:3), fmt='(I3)') hour
903  read (unit=zone(4:5), fmt='(I2)') minute
904 
905  now = datetime(year=values(1), &
906  month=values(2), &
907  day=values(3), &
908  hour=values(5), &
909  minute=values(6), &
910  second=values(7), &
911  millisecond=values(8))
912 
913  now%tz = hour + minute*m2h
914 
915  endfunction now
916 
917  pure elemental integer function weekday(self)
919  !! Returns the day of the week calculated using Zeller's congruence.
920  !! Returned value is an integer scalar in the range [0-6], such that:
921  !!
922  !! 0: Sunday
923  !! 1: Monday
924  !! 2: Tuesday
925  !! 3: Wednesday
926  !! 4: Thursday
927  !! 5: Friday
928  !! 6: Saturday
929 
930  class(datetime), intent(in) :: self !! `datetime` instance
931 
932  integer :: year, month
933  integer :: j, k
934 
935  year = self%year
936  month = self%month
937 
938  if (month <= 2) then
939  month = month + 12
940  year = year - 1
941  endif
942 
943  j = year/100
944  k = mod(year, 100)
945 
946  weekday = mod(self%day + ((month + 1)*26)/10 + k + k/4 + j/4 + 5*j, 7) - 1
947 
948  if (weekday < 0) weekday = 6
949 
950  endfunction weekday
951 
952  pure elemental integer function isoweekday(self)
954  !! Returns the day of the week per ISO 8601 returned from weekday().
955  !! Returned value is an integer scalar in the range [1-7], such that:
956  !!
957  !! 1: Monday
958  !! 2: Tuesday
959  !! 3: Wednesday
960  !! 4: Thursday
961  !! 5: Friday
962  !! 6: Saturday
963  !! 7: Sunday
964 
965  class(datetime), intent(in) :: self !! `datetime` instance
966 
967  isoweekday = self%weekday()
968 
969  if (isoweekday == 0) then
970  isoweekday = 7
971  end if
972 
973  endfunction isoweekday
974 
975  pure elemental character(len=9) function weekdaylong(self)
977  !! Returns the full name of the day of the week.
978 
979  class(datetime), intent(in) :: self !! `datetime` instance
980 
981  character(len=9), parameter, dimension(7) :: &
982  days = ['Sunday ', 'Monday ', 'Tuesday ', 'Wednesday', &
983  'Thursday ', 'Friday ', 'Saturday ']
984 
985  weekdaylong = days(self%weekday() + 1)
986 
987  endfunction weekdaylong
988 
989  pure elemental character(len=9) function isoweekdaylong(self)
991  !! Returns the full name of the day of the week for ISO 8601
992  !! ordered weekdays.
993 
994  class(datetime), intent(in) :: self !! `datetime` instance
995 
996  character(len=9), parameter, dimension(7) :: &
997  days = ['Monday ', 'Tuesday ', 'Wednesday', 'Thursday ', &
998  'Friday ', 'Saturday ', 'Sunday ']
999 
1000  isoweekdaylong = days(self%isoweekday())
1001 
1002  endfunction isoweekdaylong
1003 
1004  pure elemental character(len=3) function weekdayshort(self)
1006  !! Returns the short (3-letter) name of the day of the week.
1007 
1008  class(datetime), intent(in) :: self !! `datetime` instance
1009 
1010  character(len=3), parameter, dimension(7) :: &
1011  days = ['Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat']
1012 
1013  weekdayshort = days(self%weekday() + 1)
1014 
1015  endfunction weekdayshort
1016 
1017  pure elemental character(len=3) function isoweekdayshort(self)
1019  !! Returns the short (3-letter) name of the day of the week
1020  !! based on ISO 8601 ordering.
1021 
1022  class(datetime), intent(in) :: self !! `datetime` instance
1023 
1024  character(len=3), parameter, dimension(7) :: &
1025  days = ['Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun']
1026 
1027  isoweekdayshort = days(self%isoweekday())
1028 
1029  endfunction isoweekdayshort
1030 
1031  function isocalendar(self)
1033  !! Returns an array of 3 integers, year, week number, and week day,
1034  !! as defined by ISO 8601 week date. Essentially a wrapper around C
1035  !! `strftime` function.
1036 
1037  class(datetime), intent(in) :: self !! `datetime` instance
1038 
1039  integer, dimension(3) :: isocalendar
1040  integer :: year, week, wday
1041  integer :: rc
1042  character(len=20) :: string
1043 
1044  rc = c_strftime(string, len(string), '%G %V %u'//c_null_char, &
1045  self%tm())
1046 
1047  read (unit=string(1:4), fmt='(I4)') year
1048  read (unit=string(6:7), fmt='(I2)') week
1049  read (unit=string(9:9), fmt='(I1)') wday
1050 
1051  isocalendar = [year, week, wday]
1052 
1053  endfunction isocalendar
1054 
1055  integer function secondssinceepoch(self)
1057  !! Returns an integer number of seconds since the UNIX Epoch,
1058  !! `1970-01-01 00:00:00`. Note that this is a wrapper around C's
1059  !! `strftime('%s')`, so the number of seconds will reflect the time
1060  !! zone of the local machine on which the function is being called.
1061 
1062  class(datetime), intent(in) :: self !! `datetime` instance
1063 
1064  character(len=11) :: string
1065 
1066  string = self%strftime('%s')
1067  read (unit=string, fmt='(I10)') secondssinceepoch
1068 
1069  endfunction secondssinceepoch
1070 
1071  function strftime(self, format)
1073  !! Wrapper around C/C++ `strftime` function.
1074 
1075  class(datetime), intent(in) :: self !! `datetime` instance
1076  character(len=*), intent(in) :: format !! format string
1077 
1078  character(len=:), allocatable :: strftime
1079 
1080  integer :: n, rc
1081  character(len=MAXSTRLEN) :: resultString
1082 
1083  resultstring = ""
1084  rc = c_strftime(resultstring, maxstrlen, trim(format)//c_null_char, &
1085  self%tm())
1086  strftime = trim(resultstring)
1087  n = len(strftime)
1088  strftime = strftime(1:n - 1)
1089 
1090  endfunction strftime
1091 
1092  pure elemental type(tm_struct) function tm(self)
1094  !! Returns a `tm_struct` instance of the current `datetime`.
1095 
1096  class(datetime), intent(in) :: self !! `datetime` instance
1097 
1098  tm%tm_sec = self%second
1099  tm%tm_min = self%minute
1100  tm%tm_hour = self%hour
1101  tm%tm_mday = self%day
1102  tm%tm_mon = self%month - 1
1103  tm%tm_year = self%year - 1900
1104  tm%tm_wday = self%weekday()
1105  tm%tm_yday = self%yearday() - 1
1106  tm%tm_isdst = -1
1107 
1108  endfunction tm
1109 
1110  pure elemental character(len=5) function tzoffset(self)
1112  !! Returns a character string with timezone offset in hours from UTC,
1113  !! in format +/-[hh][mm].
1114 
1115  class(datetime), intent(in) :: self !! `datetime` instance
1116 
1117  integer :: hours, minutes
1118 
1119  if (self%tz < 0) then
1120  tzoffset(1:1) = '-'
1121  else
1122  tzoffset(1:1) = '+'
1123  endif
1124 
1125  hours = int(abs(self%tz))
1126  minutes = nint((abs(self%tz) - hours)*60)
1127 
1128  if (minutes == 60) then
1129  minutes = 0
1130  hours = hours + 1
1131  endif
1132 
1133  write (unit=tzoffset(2:5), fmt='(2I2.2)') hours, minutes
1134 
1135  endfunction tzoffset
1136 
1137  pure elemental type(datetime) function utc(self)
1139  !! Returns the `datetime` instance at Coordinated Universal Time (UTC).
1140 
1141  class(datetime), intent(in) :: self !! `datetime` instance
1142 
1143  integer :: hours, minutes, sgn
1144 
1145  hours = int(abs(self%tz))
1146  minutes = nint((abs(self%tz) - hours)*60)
1147  sgn = int(sign(one, self%tz))
1148 
1149  utc = self - timedelta(hours=sgn*hours, minutes=sgn*minutes)
1150  utc%tz = 0
1151 
1152  endfunction utc
1153 
1154  pure elemental integer function yearday(self)
1156  !! Returns the integer day of the year (ordinal date).
1157 
1158  class(datetime), intent(in) :: self !! `datetime` instance
1159 
1160  integer :: month
1161 
1162  yearday = 0
1163  do month = 1, self%month - 1
1164  yearday = yearday + daysinmonth(month, self%year)
1165  enddo
1166  yearday = yearday + self%day
1167 
1168  endfunction yearday
1169 
1170 ! datetime operators
1171 !=======================================================================
1172 
1173  pure elemental function datetime_plus_timedelta(d0, t) result(d)
1175  !! Adds a `timedelta` instance to a `datetime` instance, and returns a
1176  !! new `datetime` instance. Overloads the operator `+`.
1177 
1178  class(datetime), intent(in) :: d0 !! `datetime` instance
1179  class(timedelta), intent(in) :: t !! `timedelta` instance
1180  type(datetime) :: d
1181 
1182  integer :: milliseconds, seconds, minutes, hours, days
1183 
1184  d = datetime(year=d0%getYear(), &
1185  month=d0%getMonth(), &
1186  day=d0%getDay(), &
1187  hour=d0%getHour(), &
1188  minute=d0%getMinute(), &
1189  second=d0%getSecond(), &
1190  millisecond=d0%getMillisecond(), &
1191  tz=d0%getTz())
1192 
1193  milliseconds = t%getMilliseconds()
1194  seconds = t%getSeconds()
1195  minutes = t%getMinutes()
1196  hours = t%getHours()
1197  days = t%getDays()
1198 
1199  if (milliseconds /= 0) call d%addMilliseconds(milliseconds)
1200  if (seconds /= 0) call d%addSeconds(seconds)
1201  if (minutes /= 0) call d%addMinutes(minutes)
1202  if (hours /= 0) call d%addHours(hours)
1203  if (days /= 0) call d%addDays(days)
1204 
1205  endfunction datetime_plus_timedelta
1206 
1207  pure elemental function timedelta_plus_datetime(t, d0) result(d)
1209  !! Adds a `timedelta` instance to a `datetime` instance, and returns a
1210  !! new `datetime` instance. Overloads the operator `+`.
1211 
1212  class(timedelta), intent(in) :: t !! `timedelta` instance
1213  class(datetime), intent(in) :: d0 !! `datetime` instance
1214  type(datetime) :: d
1215 
1216  d = d0 + t
1217 
1218  endfunction timedelta_plus_datetime
1219 
1220  pure elemental function datetime_minus_timedelta(d0, t) result(d)
1222  !! Subtracts a `timedelta` instance from a `datetime` instance and
1223  !! returns a new `datetime` instance. Overloads the operator `-`.
1224 
1225  class(datetime), intent(in) :: d0 !! `datetime` instance
1226  class(timedelta), intent(in) :: t !! `timedelta` instance
1227  type(datetime) :: d
1228 
1229  d = d0 + (-t)
1230 
1231  endfunction datetime_minus_timedelta
1232 
1233  pure elemental function datetime_minus_datetime(d0, d1) result(t)
1235  !! Subtracts a `datetime` instance from another `datetime` instance,
1236  !! and returns a `timedelta` instance. Overloads the operator `-`.
1237 
1238  class(datetime), intent(in) :: d0 !! lhs `datetime` instance
1239  class(datetime), intent(in) :: d1 !! rhs `datetime` instance
1240  type(timedelta) :: t
1241 
1242  real(kind=real64) :: daysDiff
1243  integer :: days, hours, minutes, seconds, milliseconds
1244  integer :: sign_
1245 
1246  daysdiff = date2num(d0) - date2num(d1)
1247 
1248  if (daysdiff < 0) then
1249  sign_ = -1
1250  daysdiff = abs(daysdiff)
1251  else
1252  sign_ = 1
1253  endif
1254 
1255  days = int(daysdiff)
1256  hours = int((daysdiff - days)*d2h)
1257  minutes = int((daysdiff - days - hours*h2d)*d2m)
1258  seconds = int((daysdiff - days - hours*h2d-minutes*m2d)*d2s)
1259  milliseconds = nint((daysdiff - days - hours*h2d-minutes*m2d &
1260  -seconds*s2d)*d2s*1e3_real64)
1261 
1262  t = timedelta(sign_*days, sign_*hours, sign_*minutes, sign_*seconds, &
1263  sign_*milliseconds)
1264 
1265  endfunction datetime_minus_datetime
1266 
1267  pure elemental logical function gt(d0, d1)
1269  !! `datetime` comparison operator that eturns `.true.` if `d0` is
1270  !! greater than `d1` and `.false.` otherwise. Overloads the
1271  !! operator `>`.
1272 
1273  class(datetime), intent(in) :: d0 !! lhs `datetime` instance
1274  class(datetime), intent(in) :: d1 !! rhs `datetime` instance
1275 
1276  type(datetime) :: d0_utc, d1_utc
1277 
1278  ! Convert to UTC before making comparison
1279  d0_utc = d0%utc()
1280  d1_utc = d1%utc()
1281 
1282  ! Year comparison block
1283  if (d0_utc%year > d1_utc%year) then
1284  gt = .true.
1285  elseif (d0_utc%year < d1_utc%year) then
1286  gt = .false.
1287  else
1288 
1289  ! Month comparison block
1290  if (d0_utc%month > d1_utc%month) then
1291  gt = .true.
1292  elseif (d0_utc%month < d1_utc%month) then
1293  gt = .false.
1294  else
1295 
1296  ! Day comparison block
1297  if (d0_utc%day > d1_utc%day) then
1298  gt = .true.
1299  elseif (d0_utc%day < d1_utc%day) then
1300  gt = .false.
1301  else
1302 
1303  ! Hour comparison block
1304  if (d0_utc%hour > d1_utc%hour) then
1305  gt = .true.
1306  elseif (d0_utc%hour < d1_utc%hour) then
1307  gt = .false.
1308  else
1309 
1310  ! Minute comparison block
1311  if (d0_utc%minute > d1_utc%minute) then
1312  gt = .true.
1313  elseif (d0_utc%minute < d1_utc%minute) then
1314  gt = .false.
1315  else
1316 
1317  ! Second comparison block
1318  if (d0_utc%second > d1_utc%second) then
1319  gt = .true.
1320  elseif (d0_utc%second < d1_utc%second) then
1321  gt = .false.
1322  else
1323 
1324  ! Millisecond comparison block
1325  if (d0_utc%millisecond > d1_utc%millisecond) then
1326  gt = .true.
1327  else
1328  gt = .false.
1329  endif
1330 
1331  endif
1332  endif
1333  endif
1334  endif
1335  endif
1336  endif
1337 
1338  endfunction gt
1339 
1340  pure elemental logical function lt(d0, d1)
1342  !! `datetime` comparison operator that returns `.true.` if `d0` is
1343  !! less than `d1` and `.false.` otherwise. Overloads the operator `<`.
1344 
1345  class(datetime), intent(in) :: d0 !! lhs `datetime` instance
1346  class(datetime), intent(in) :: d1 !! rhs `datetime` instance
1347 
1348  lt = d1 > d0
1349 
1350  endfunction lt
1351 
1352  pure elemental logical function eq(d0, d1)
1354  !! `datetime` comparison operator that returns `.true.` if `d0` is
1355  !! equal to `d1` and `.false.` otherwise. Overloads the operator `==`.
1356 
1357  class(datetime), intent(in) :: d0 !! lhs `datetime` instance
1358  class(datetime), intent(in) :: d1 !! rhs `datetime` instance
1359 
1360  type(datetime) :: d0_utc, d1_utc
1361 
1362  ! Convert to UTC before making comparison
1363  d0_utc = d0%utc()
1364  d1_utc = d1%utc()
1365 
1366  eq = d0_utc%year == d1_utc%year .and. &
1367  d0_utc%month == d1_utc%month .and. &
1368  d0_utc%day == d1_utc%day .and. &
1369  d0_utc%hour == d1_utc%hour .and. &
1370  d0_utc%minute == d1_utc%minute .and. &
1371  d0_utc%second == d1_utc%second .and. &
1372  d0_utc%millisecond == d1_utc%millisecond
1373 
1374  endfunction eq
1375 
1376  pure elemental logical function neq(d0, d1)
1378  !! `datetime` comparison operator that eturns `.true.` if `d0` is
1379  !! not equal to `d1` and `.false.` otherwise. Overloads the operator `/=`.
1380 
1381  class(datetime), intent(in) :: d0 !! lhs `datetime` instance
1382  class(datetime), intent(in) :: d1 !! rhs `datetime` instance
1383 
1384  neq = .not. d0 == d1
1385 
1386  endfunction neq
1387 
1388  pure elemental logical function ge(d0, d1)
1390  !! `datetime` comparison operator. Returns `.true.` if `d0` is greater
1391  !! than or equal to `d1` and `.false.` otherwise. Overloads the
1392  !! operator `>=`.
1393 
1394  class(datetime), intent(in) :: d0 !! lhs `datetime` instance
1395  class(datetime), intent(in) :: d1 !! rhs `datetime` instance
1396 
1397  ge = d0 > d1 .or. d0 == d1
1398 
1399  endfunction ge
1400 
1401  pure elemental logical function le(d0, d1)
1403  !! `datetime` comparison operator. Returns `.true.` if `d0` is less
1404  !! than or equal to `d1`, and `.false.` otherwise. Overloads the
1405  !! operator `<=`.
1406 
1407  class(datetime), intent(in) :: d0 !! lhs `datetime` instance
1408  class(datetime), intent(in) :: d1 !! rhs `datetime` instance
1409 
1410  le = d1 > d0 .or. d0 == d1
1411 
1412  endfunction le
1413 
1414 ! public procedures
1415 !=======================================================================
1416 
1417  pure elemental logical function isleapyear(year)
1419  !! Returns `.true.` if year is leap year and `.false.` otherwise.
1420 
1421  integer, intent(in) :: year !! year
1422 
1423  isleapyear = (mod(year, 4) == 0 .and. .not. mod(year, 100) == 0) &
1424  .or. (mod(year, 400) == 0)
1425 
1426  endfunction isleapyear
1427 
1428  pure function datetimerange(d0, d1, t)
1430  !! Given start and end `datetime` instances `d0` and `d1` and time
1431  !! increment as `timedelta` instance `t`, returns an array of
1432  !! `datetime` instances. The number of elements is the number of whole
1433  !! time increments contained between datetimes `d0` and `d1`.
1434 
1435  type(datetime), intent(in) :: d0 !! start time
1436  type(datetime), intent(in) :: d1 !! end time
1437  type(timedelta), intent(in) :: t !! time increment
1438 
1439  real(kind=real64) :: datenum0, datenum1, increment
1440  real(kind=real64) :: eps
1441 
1442  type(datetime), dimension(:), allocatable :: datetimeRange
1443 
1444  integer :: n, nm
1445 
1446  eps = 1e-10_real64
1447 
1448  datenum0 = date2num(d0)
1449  datenum1 = date2num(d1)
1450 
1451  increment = t%total_seconds()*s2d
1452 
1453  nm = floor((datenum1 - datenum0 + eps)/increment) + 1
1454 
1455  allocate (datetimerange(nm))
1456 
1457  do n = 1, nm
1458  datetimerange(n) = num2date(datenum0 + (n - 1)*increment)
1459  enddo
1460 
1461  endfunction datetimerange
1462 
1463  pure elemental integer function daysinmonth(month, year)
1465  !! Given integer month and year, returns an integer number
1466  !! of days in that particular month.
1467 
1468  integer, intent(in) :: month !! month
1469  integer, intent(in) :: year !! year
1470 
1471  integer, parameter, dimension(12) :: &
1472  days = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
1473 
1474  if (month < 1 .or. month > 12) then
1475  ! Should raise an error and abort here, however we want to keep
1476  ! the pure and elemental attributes. Make sure this function is
1477  ! called with the month argument in range.
1478  daysinmonth = 0
1479  return
1480  endif
1481 
1482  if (month == 2 .and. isleapyear(year)) then
1483  daysinmonth = 29
1484  else
1485  daysinmonth = days(month)
1486  endif
1487 
1488  endfunction daysinmonth
1489 
1490  pure elemental integer function daysinyear(year)
1492  !! Returns the number of days in year.
1493 
1494  integer, intent(in) :: year !! year
1495 
1496  if (isleapyear(year)) then
1497  daysinyear = 366
1498  else
1499  daysinyear = 365
1500  endif
1501 
1502  endfunction daysinyear
1503 
1504  pure elemental real(kind=real64) function date2num(d)
1506  !! Given a datetime instance d, returns number of days since
1507  !! `0001-01-01 00:00:00`, taking into account the timezone offset.
1508 
1509  type(datetime), intent(in) :: d !! `datetime` instance
1510 
1511  type(datetime) :: d_utc
1512  integer :: year
1513 
1514  ! Convert to UTC first
1515  d_utc = d%utc()
1516 
1517  ! d_utc % year must be positive:
1518  if (d_utc%year < 1) then
1519  date2num = 0
1520  return
1521  endif
1522 
1523  date2num = 0
1524  do year = 1, d_utc%year - 1
1525  date2num = date2num + daysinyear(year)
1526  enddo
1527 
1528  date2num = date2num &
1529  + d_utc%yearday() &
1530  + d_utc%hour*h2d &
1531  +d_utc%minute*m2d &
1532  +(d_utc%second + 1e-3_real64*d_utc%millisecond)*s2d
1533 
1534  endfunction date2num
1535 
1536  pure elemental type(datetime) function num2date(num)
1538  !! Given number of days since `0001-01-01 00:00:00`, returns a
1539  !! correspoding `datetime` instance.
1540 
1541  real(kind=real64), intent(in) :: num
1542  !! number of days since `0001-01-01 00:00:00`
1543 
1544  integer :: year, month, day, hour, minute, second, millisecond
1545  real(kind=real64) :: days, totseconds
1546 
1547  ! num must be positive:
1548  if (num < 0) then
1549  num2date = datetime(1)
1550  return
1551  endif
1552 
1553  days = num
1554 
1555  year = 1
1556  do
1557  if (int(days) <= daysinyear(year)) exit
1558  days = days - daysinyear(year)
1559  year = year + 1
1560  enddo
1561 
1562  month = 1
1563  do
1564  if (int(days) <= daysinmonth(month, year)) exit
1565  days = days - daysinmonth(month, year)
1566  month = month + 1
1567  enddo
1568 
1569  day = int(days)
1570  totseconds = (days - day)*d2s
1571  hour = int(totseconds*s2h)
1572  minute = int((totseconds - hour*h2s)*s2m)
1573  second = int(totseconds - hour*h2s - minute*m2s)
1574  millisecond = nint((totseconds - int(totseconds))*1e3_real64)
1575 
1576  num2date = datetime(year, month, day, hour, minute, second, millisecond, tz=zero)
1577 
1578  ! Handle a special case caused by floating-point arithmethic:
1579  if (num2date%millisecond == 1000) then
1580  num2date%millisecond = 0
1581  call num2date%addSeconds(1)
1582  endif
1583 
1584  if (num2date%second == 60) then
1585  num2date%second = 0
1586  call num2date%addMinutes(1)
1587  endif
1588  if (num2date%minute == 60) then
1589  num2date%minute = 0
1590  call num2date%addHours(1)
1591  endif
1592  if (num2date%hour == 60) then
1593  num2date%hour = 0
1594  call num2date%addDays(1)
1595  endif
1596 
1597  endfunction num2date
1598 
1599  type(datetime) function strptime(str, format)
1601  !! A wrapper function around C/C++ strptime function.
1602  !! Returns a `datetime` instance.
1603 
1604  character(len=*), intent(in) :: str !! time string
1605  character(len=*), intent(in) :: format !! time format
1606 
1607  integer :: rc
1608  type(tm_struct) :: tm
1609 
1610  rc = c_strptime(trim(str)//c_null_char, trim(format)//c_null_char, tm)
1611  strptime = tm2date(tm)
1612 
1613  endfunction strptime
1614 
1615  pure elemental type(datetime) function tm2date(ctime)
1617  !! Given a `tm_struct` instance, returns a corresponding `datetime`
1618  !! instance.
1619 
1620  type(tm_struct), intent(in) :: ctime !! C-style time struct
1621 
1622  tm2date%millisecond = 0
1623  tm2date%second = ctime%tm_sec
1624  tm2date%minute = ctime%tm_min
1625  tm2date%hour = ctime%tm_hour
1626  tm2date%day = ctime%tm_mday
1627  tm2date%month = ctime%tm_mon + 1
1628  tm2date%year = ctime%tm_year + 1900
1629  tm2date%tz = 0
1630 
1631  endfunction tm2date
1632 
1633 ! private procedures
1634 !=======================================================================
1635 
1636  pure function int2str(i, length)
1638  !! Converts an integer `i` into a character string of requested length,
1639  !! pre-pending zeros if necessary.
1640 
1641  integer, intent(in) :: i !! integer to convert to string
1642  integer, intent(in) :: length !! desired length of string
1643 
1644  character(len=length) :: int2str
1645  character(len=2) :: string
1646 
1647  write (unit=string, fmt='(I2)') length
1648  write (unit=int2str, fmt='(I'//string//'.'//string//')') i
1649 
1650  endfunction int2str
1651 !=======================================================================
1652 endmodule mod_datetime
1653 
1654 !
1655 ! datetime-fortran - A Fortran library for date and time manipulation
1656 ! Copyright (c) 2013-2017, Wavebit Scientific LLC
1657 ! All rights reserved.
1658 !
1659 ! Licensed under the BSD 3-clause license. See LICENSE for details.
1660 !
1662 !=======================================================================
1663 !
1664 ! mod_clock
1665 !
1666 !=======================================================================
1667 
1668  use, intrinsic :: iso_fortran_env, only: real32, real64
1669  use, intrinsic :: iso_c_binding, only: c_char, c_int, c_null_char
1670  use :: mod_datetime, only:datetime
1671  use :: mod_timedelta, only:timedelta
1672 
1673  implicit none
1674 
1675  private
1676 
1677 ! Derived types:
1678  public :: clock
1679 
1680  type :: clock
1681 
1682  !! A clock object with a start, stop and current times, tick interval
1683  !! and tick methods.
1684 
1685  type(datetime) :: starttime
1686  type(datetime) :: stoptime
1687  type(datetime) :: currenttime
1688 
1689  type(timedelta) :: tickinterval
1690 
1691  ! May become Alarm class in some future release;
1692  ! for now, just a switch
1693  logical :: alarm = .false.
1694 
1695  ! Clock status flags
1696  logical :: started = .false.
1697  logical :: stopped = .false.
1698 
1699  contains
1700 
1701  procedure :: reset
1702  procedure :: tick
1703 
1704  endtype clock
1705 !=======================================================================
1706 contains
1707 
1708 !=======================================================================
1709  pure elemental subroutine reset(self)
1711  !! Resets the clock to its start time.
1712 
1713  class(clock), intent(inout) :: self
1714 
1715  self%currentTime = self%startTime
1716 
1717  self%started = .false.
1718  self%stopped = .false.
1719 
1720  endsubroutine reset
1721 !=======================================================================
1722 
1723 !=======================================================================
1724  pure elemental subroutine tick(self)
1726  !! Increments the currentTime of the clock instance by one tickInterval.
1727 
1728  class(clock), intent(inout) :: self
1729 
1730  if (self%stopped) then
1731  return
1732  endif
1733 
1734  if (.not. self%started) then
1735  self%started = .true.
1736  self%currentTime = self%startTime
1737  endif
1738 
1739  self%currentTime = self%currentTime + self%tickInterval
1740 
1741  if (self%currentTime >= self%stopTime) then
1742  self%stopped = .true.
1743  endif
1744 
1745  endsubroutine tick
1746 !=======================================================================
1747 endmodule mod_clock
1748 
1749 ! datetime-fortran - A Fortran library for date and time manipulation
1750 ! Copyright (c) 2013-2017, Wavebit Scientific LLC
1751 ! All rights reserved.
1752 !
1753 ! Licensed under the BSD-3 clause license. See LICENSE for details.
1754 !
1756 
1757 !! Provides entry point to all items defined in datetime, timedelta,
1758 !! clock and strftime modules.
1759 
1760  use mod_datetime
1761  use mod_timedelta
1762  use mod_clock
1763  use mod_strftime
1764 
1765 endmodule datetime_module
pure elemental integer function, public daysinmonth(month, year)
pure elemental type(datetime) function, public num2date(num)
pure elemental subroutine addseconds(self, s)
pure elemental integer function weekday(self)
pure elemental logical function le(d0, d1)
real(kind=real64), parameter, public h2s
pure elemental integer function getmilliseconds(self)
pure elemental subroutine tick(self)
pure character(len=length) function int2str(i, length)
pure elemental subroutine addmilliseconds(self, ms)
pure elemental type(timedelta) function timedelta_constructor(days, hours, minutes, seconds, milliseconds)
pure elemental integer function gethours(self)
pure elemental logical function lt(d0, d1)
pure elemental integer function getminutes(self)
pure elemental type(timedelta) function unary_minus_timedelta(t0)
pure elemental real(kind=real64) function gettz(self)
pure elemental real(kind=real64) function total_seconds(self)
pure elemental character(len=9) function isoweekdaylong(self)
pure elemental integer function getmonth(self)
real(kind=real64), parameter, public one
pure elemental integer function getmillisecond(self)
pure elemental subroutine adddays(self, d)
pure elemental type(datetime) function, public tm2date(ctime)
real(kind=real64), parameter, public s2h
pure elemental logical function, public isleapyear(year)
pure type(datetime) function, dimension(:), allocatable, public datetimerange(d0, d1, t)
pure elemental type(datetime) function utc(self)
pure elemental subroutine addhours(self, h)
type(datetime) function, public strptime(str, format)
pure elemental logical function isvalid(self)
pure elemental integer function getminute(self)
pure elemental character(len=5) function tzoffset(self)
type(datetime) function now()
pure elemental logical function ge(d0, d1)
pure elemental subroutine addminutes(self, m)
character(len=:) function, allocatable strftime(self, format)
pure elemental type(datetime) function datetime_constructor(year, month, day, hour, minute, second, millisecond, tz)
pure elemental logical function gt(d0, d1)
pure elemental character(len=3) function weekdayshort(self)
pure elemental logical function neq(d0, d1)
pure elemental integer function getsecond(self)
pure elemental logical function gt(td0, td1)
pure elemental type(datetime) function datetime_minus_timedelta(d0, t)
pure elemental type(datetime) function datetime_plus_timedelta(d0, t)
pure elemental logical function le(td0, td1)
pure elemental character(len=9) function weekdaylong(self)
real(kind=real64), parameter, public s2d
real(kind=real64), parameter, public d2m
pure elemental real(kind=real64) function, public date2num(d)
pure elemental integer function getdays(self)
pure elemental logical function eq(td0, td1)
real(kind=real64), parameter, public d2h
real(kind=real64), parameter, public h2d
pure elemental integer function getyear(self)
pure elemental integer function gethour(self)
real(kind=real64), parameter, public zero
real(kind=real64), parameter, public s2m
pure elemental type(datetime) function timedelta_plus_datetime(t, d0)
pure elemental integer function, public daysinyear(year)
pure elemental logical function neq(td0, td1)
pure elemental integer function getseconds(self)
pure elemental integer function getday(self)
pure elemental integer function isoweekday(self)
pure elemental type(tm_struct) function tm(self)
pure elemental type(timedelta) function timedelta_minus_timedelta(t0, t1)
pure elemental character(len=3) function isoweekdayshort(self)
real(kind=real64), parameter, public d2s
integer function secondssinceepoch(self)
real(kind=real64), parameter, public m2d
real(kind=real64), parameter, public m2h
pure elemental character(len=23) function isoformat(self, sep)
pure elemental type(timedelta) function timedelta_plus_timedelta(t0, t1)
pure elemental logical function lt(td0, td1)
pure elemental subroutine reset(self)
integer function, dimension(3) isocalendar(self)
real(kind=real64), parameter, public m2s
integer, parameter, public maxstrlen
pure elemental logical function ge(td0, td1)
pure elemental type(timedelta) function datetime_minus_datetime(d0, d1)
pure elemental logical function eq(d0, d1)
pure elemental integer function yearday(self)