├── .gitignore
├── .gitmodules
├── CMakeLists.txt
├── README.md
├── cmake
└── FortranDatetimeConfig.cmake
└── src
├── datetime.F90
├── datetime_mod.F90
├── datetime_test.F90
├── timedelta_mod.F90
└── timedelta_test.F90
/.gitignore:
--------------------------------------------------------------------------------
1 | build
2 |
--------------------------------------------------------------------------------
/.gitmodules:
--------------------------------------------------------------------------------
1 | [submodule "lib/unit-test"]
2 | path = lib/unit-test
3 | url = https://gitee.com/dongli85/fortran-unit-test
4 |
--------------------------------------------------------------------------------
/CMakeLists.txt:
--------------------------------------------------------------------------------
1 | cmake_minimum_required(VERSION 3.0)
2 |
3 | set(CMAKE_MACOSX_RPATH ON)
4 |
5 | project(FortranDatetime Fortran)
6 |
7 | set(version 0.0.2)
8 |
9 | if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
10 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none")
11 | endif ()
12 | set(CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}")
13 |
14 | set(sources
15 | src/timedelta_mod.F90
16 | src/datetime_mod.F90
17 | src/datetime.F90
18 | )
19 |
20 | add_library(fortran_datetime STATIC ${sources})
21 | set_property(TARGET fortran_datetime PROPERTY VERSION ${version})
22 | set_property(TARGET fortran_datetime PROPERTY SOVERSION 1)
23 |
24 | get_directory_property(parent_dir PARENT_DIRECTORY)
25 | if (EXISTS ${PROJECT_SOURCE_DIR}/lib/unit-test/CMakeLists.txt AND NOT parent_dir)
26 | add_subdirectory("lib/unit-test")
27 | include_directories(${UNIT_TEST_INCLUDE_DIR})
28 |
29 | add_executable(timedelta_test "${PROJECT_SOURCE_DIR}/src/timedelta_test.F90")
30 | target_link_libraries(timedelta_test fortran_unit_test fortran_datetime)
31 |
32 | add_executable(datetime_test "${PROJECT_SOURCE_DIR}/src/datetime_test.F90")
33 | target_link_libraries(datetime_test fortran_unit_test fortran_datetime)
34 | endif ()
35 |
36 | install(TARGETS fortran_datetime EXPORT FortranDatetimeTargets
37 | ARCHIVE DESTINATION lib
38 | LIBRARY DESTINATION lib
39 | )
40 |
41 | install(FILES
42 | "${CMAKE_BINARY_DIR}/datetime_mod.mod"
43 | "${CMAKE_BINARY_DIR}/timedelta_mod.mod"
44 | DESTINATION include/fortran_datetime
45 | )
46 |
47 | include(CMakePackageConfigHelpers)
48 | write_basic_package_version_file (
49 | "${CMAKE_CURRENT_BINARY_DIR}/FortranDatetime/FortranDatetimeConfigVersion.cmake"
50 | VERSION ${version}
51 | COMPATIBILITY AnyNewerVersion
52 | )
53 |
54 | export(EXPORT FortranDatetimeTargets
55 | FILE "${CMAKE_CURRENT_BINARY_DIR}/FortranDatetime/FortranDatetimeTargets.cmake"
56 | )
57 | configure_file(cmake/FortranDatetimeConfig.cmake
58 | "${CMAKE_CURRENT_BINARY_DIR}/FortranDatetime/FortranDatetimeConfig.cmake"
59 | )
60 |
61 | set(ConfigPackageLocation lib/cmake/FortranDatetime)
62 | install(EXPORT FortranDatetimeTargets
63 | FILE FortranDatetimeTargets.cmake
64 | DESTINATION ${ConfigPackageLocation}
65 | )
66 | install(
67 | FILES
68 | "${CMAKE_CURRENT_BINARY_DIR}/FortranDatetime/FortranDatetimeConfig.cmake"
69 | "${CMAKE_CURRENT_BINARY_DIR}/FortranDatetime/FortranDatetimeConfigVersion.cmake"
70 | DESTINATION
71 | ${ConfigPackageLocation}
72 | )
73 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 | # Fortran Date Time Library
3 |
4 | ## Content
5 |
6 | + [Overview](#overview)
7 |
8 | + [Installation](#installation)
9 |
10 | + [Example](#example)
11 |
12 | + [Compiler Support](#compiler-support)
13 |
14 | + [License](#license)
15 |
16 | ## Overview
17 | This is a Fortran datetime library for doing tedious datetime operations.
18 |
19 | Go to [Top](#top)
20 |
21 | ## Installation
22 | A CMake-Setup is provided.
23 |
24 | Go to [Top](#top)
25 |
26 | ## Example
27 |
28 | ```
29 | use datetime
30 |
31 | type(datetime_type) a, b
32 | type(timedelta_type) dt
33 |
34 | a = datetime(year=2017, month=10, day=6, hour=14)
35 |
36 | write(6, *) a%isoformat() ! => 2017-10-06T14:00:00Z
37 |
38 | dt = timedelta(minutes=6)
39 | b = a + dt
40 |
41 | write(6, *) a%isoformat() ! => 2017-10-06T14:06:00Z
42 |
43 | b = datetime(year=2018, month=4, day=16, hour=23, minute=51)
44 |
45 | dt = b - a
46 |
47 | write(6, *) dt%total_seconds() ! => 16624260.0
48 | write(6, *) dt%total_minutes() ! => 277071.0
49 | write(6, *) dt%total_hours() ! => 4617.85
50 | write(6, *) dt%total_days() ! => 192.4104166666667
51 |
52 | ```
53 |
54 | ## Compiler Support
55 |
56 | []()
57 | []()
58 | []()
59 | []()
60 | []()
61 | []()
62 |
63 | Go to [Top](#top)
64 |
65 | ## License
66 | []()
67 |
68 | Go to [Top](#top)
69 |
--------------------------------------------------------------------------------
/cmake/FortranDatetimeConfig.cmake:
--------------------------------------------------------------------------------
1 | include_directories ("${CMAKE_INSTALL_PREFIX}/include/fortran_datetime")
2 | link_directories ("${CMAKE_INSTALL_PREFIX}/lib")
3 |
--------------------------------------------------------------------------------
/src/datetime.F90:
--------------------------------------------------------------------------------
1 | module datetime
2 |
3 | use datetime_mod
4 | use timedelta_mod
5 |
6 | end module datetime
--------------------------------------------------------------------------------
/src/datetime_mod.F90:
--------------------------------------------------------------------------------
1 | module datetime_mod
2 |
3 | use timedelta_mod
4 |
5 | implicit none
6 |
7 | private
8 |
9 | public create_datetime
10 | public set_datetime
11 | public datetime_type
12 | public days_of_month
13 | public accum_days
14 | public days_of_year
15 | public is_leap_year
16 | public datetime_gregorian_calendar
17 | public datetime_noleap_calendar
18 |
19 | integer, parameter :: datetime_gregorian_calendar = 1
20 | integer, parameter :: datetime_noleap_calendar = 2
21 |
22 | type datetime_type
23 | integer :: calendar = datetime_gregorian_calendar
24 | integer :: year = 1
25 | integer :: month = 1
26 | integer :: day = 1
27 | integer :: hour = 0
28 | integer :: minute = 0
29 | integer :: second = 0
30 | real(8) :: millisecond = 0
31 | real(8) :: timezone = 0.0d0
32 | contains
33 | procedure :: init
34 | procedure :: isoformat
35 | procedure :: timestamp
36 | procedure :: format
37 | procedure :: add_months
38 | procedure :: add_days
39 | procedure :: add_hours
40 | procedure :: add_minutes
41 | procedure :: add_seconds
42 | procedure :: add_milliseconds
43 | procedure :: days_in_year
44 | procedure, private :: assign
45 | procedure, private :: add_timedelta
46 | procedure, private :: sub_datetime
47 | procedure, private :: sub_timedelta
48 | procedure, private :: eq
49 | procedure, private :: neq
50 | procedure, private :: gt
51 | procedure, private :: ge
52 | procedure, private :: lt
53 | procedure, private :: le
54 | generic :: assignment(=) => assign
55 | generic :: operator(+) => add_timedelta
56 | generic :: operator(-) => sub_datetime
57 | generic :: operator(-) => sub_timedelta
58 | generic :: operator(==) => eq
59 | generic :: operator(/=) => neq
60 | generic :: operator(>) => gt
61 | generic :: operator(>=) => ge
62 | generic :: operator(<) => lt
63 | generic :: operator(<=) => le
64 | end type datetime_type
65 |
66 | interface create_datetime
67 | module procedure datetime_1
68 | module procedure datetime_2
69 | end interface create_datetime
70 |
71 | interface set_datetime
72 | module procedure datetime_1
73 | module procedure datetime_2
74 | end interface set_datetime
75 |
76 | contains
77 |
78 | subroutine init(this)
79 |
80 | class(datetime_type), intent(inout) :: this
81 |
82 | integer values(8)
83 |
84 | call date_and_time(VALUES=values)
85 |
86 | this%year = values(1)
87 | this%month = values(2)
88 | this%day = values(3)
89 | this%hour = values(5)
90 | this%minute = values(6)
91 | this%second = values(7)
92 | this%millisecond = values(8)
93 |
94 | end subroutine init
95 |
96 | pure type(datetime_type) function datetime_1( &
97 | year, month, day, hour, minute, second, millisecond, &
98 | julday, days, hours, minutes, seconds, &
99 | timestamp, &
100 | timezone, calendar) result(res)
101 |
102 | integer, intent(in), optional :: year
103 | integer, intent(in), optional :: month
104 | integer, intent(in), optional :: day
105 | integer, intent(in), optional :: hour
106 | integer, intent(in), optional :: minute
107 | integer, intent(in), optional :: second
108 | integer, intent(in), optional :: millisecond
109 | integer, intent(in), optional :: julday
110 | integer, intent(in), optional :: days
111 | integer, intent(in), optional :: hours
112 | integer, intent(in), optional :: minutes
113 | integer, intent(in), optional :: seconds
114 | class(*), intent(in), optional :: timestamp
115 | class(*), intent(in), optional :: timezone
116 | integer, intent(in), optional :: calendar
117 |
118 | real(8) residue_seconds
119 | integer mon
120 |
121 | if (present(calendar)) res%calendar = calendar
122 |
123 | if (present(timestamp)) then
124 | ! Assume the start date time is UTC 1970-01-01 00:00:00.
125 | res%year = 1970
126 | res%month = 1
127 | res%day = 1
128 | res%hour = 0
129 | res%minute = 0
130 | res%second = 0
131 | res%millisecond = 0
132 | select type (timestamp)
133 | type is (integer)
134 | residue_seconds = timestamp
135 | type is (real(4))
136 | residue_seconds = timestamp
137 | type is (real(8))
138 | residue_seconds = timestamp
139 | end select
140 | call res%add_days(int(residue_seconds / 86400.0))
141 | residue_seconds = mod(residue_seconds, 86400.0)
142 | call res%add_hours(int(residue_seconds / 3600.0))
143 | residue_seconds = mod(residue_seconds, 3600.0)
144 | call res%add_minutes(int(residue_seconds / 60.0))
145 | residue_seconds = mod(residue_seconds, 60.0)
146 | call res%add_seconds(int(residue_seconds))
147 | call res%add_milliseconds((residue_seconds - int(residue_seconds)) * 1000)
148 | else
149 | if (present(year)) res%year = year
150 | if (present(julday)) then
151 | res%day = 0
152 | do mon = 1, 12
153 | res%day = res%day + days_of_month(year, mon, res%calendar)
154 | if (res%day > julday) exit
155 | end do
156 | res%month = min(mon, 12)
157 | res%day = julday - accum_days(year, res%month, 0, res%calendar)
158 | else
159 | if (present(month)) res%month = month
160 | if (present(day )) res%day = day
161 | end if
162 | if (present(hour )) res%hour = hour
163 | if (present(minute )) res%minute = minute
164 | if (present(second )) res%second = second
165 | if (present(millisecond)) res%millisecond = millisecond
166 | if (present(days )) call res%add_days(days)
167 | if (present(hours )) call res%add_hours(hours)
168 | if (present(minutes )) call res%add_minutes(minutes)
169 | if (present(seconds )) call res%add_seconds(seconds)
170 | if (res%second == 60) then
171 | call res%add_minutes(1)
172 | res%second = 0
173 | end if
174 | if (res%minute == 60) then
175 | call res%add_hours(1)
176 | res%minute = 0
177 | end if
178 | if (res%hour == 24) then
179 | call res%add_days(1)
180 | res%hour = 0
181 | end if
182 | end if
183 | if (present(timezone)) then
184 | select type (timezone)
185 | type is (integer)
186 | res%timezone = timezone
187 | type is (real(4))
188 | res%timezone = timezone
189 | type is (real(8))
190 | res%timezone = timezone
191 | end select
192 | end if
193 |
194 | end function datetime_1
195 |
196 | type(datetime_type) function datetime_2(datetime_str, format_str, timezone, calendar) result(res)
197 |
198 | character(*), intent(in) :: datetime_str
199 | character(*), intent(in), optional :: format_str
200 | class(*), intent(in), optional :: timezone
201 | integer, intent(in), optional :: calendar
202 |
203 | integer i, j, ierr, num_spec
204 | character(1), allocatable :: specs(:) ! Date time element specifiers (e.g. 'Y', 'm', 'd')
205 |
206 | if (present(format_str)) then
207 | num_spec = 0
208 | i = 1
209 | do while (i <= len_trim(format_str))
210 | if (format_str(i:i) == '%') then
211 | ! % character consumes 1 character specifier.
212 | num_spec = num_spec + 1
213 | i = i + 2
214 | else
215 | i = i + 1
216 | end if
217 | end do
218 |
219 | allocate(specs(num_spec))
220 |
221 | i = 1
222 | j = 1
223 | do while (i <= len_trim(format_str))
224 | if (format_str(i:i) == '%') then
225 | i = i + 1
226 | select case (format_str(i:i))
227 | case ('Y')
228 | read(datetime_str(j:j+3), '(I4)') res%year
229 | j = j + 4
230 | case ('m')
231 | read(datetime_str(j:j+1), '(I2)') res%month
232 | j = j + 2
233 | case ('d')
234 | read(datetime_str(j:j+1), '(I2)') res%day
235 | j = j + 2
236 | case ('H')
237 | read(datetime_str(j:j+1), '(I2)') res%hour
238 | j = j + 2
239 | case ('M')
240 | read(datetime_str(j:j+1), '(I2)') res%minute
241 | j = j + 2
242 | case ('S')
243 | read(datetime_str(j:j+1), '(I2)') res%second
244 | j = j + 2
245 | case ('Z')
246 | ! +08:00
247 | read(datetime_str(j:j+2), '(I3)') res%timezone
248 | j = j + 6
249 | case default
250 | j = j + 1
251 | end select
252 | else
253 | j = j + 1
254 | end if
255 | i = i + 1
256 | end do
257 | else
258 | ! TODO: I assume UTC time for the time being.
259 | read(datetime_str(1:4), '(I4)', iostat=ierr) res%year
260 | if (ierr /= 0) then
261 | write(*, *) '[Error]: datetime: Invalid argument ' // trim(datetime_str) // '!'
262 | stop 1
263 | end if
264 | read(datetime_str(6:7), '(I2)', iostat=ierr) res%month
265 | if (ierr /= 0) then
266 | write(*, *) '[Error]: datetime: Invalid argument ' // trim(datetime_str) // '!'
267 | stop 1
268 | end if
269 | read(datetime_str(9:10), '(I2)', iostat=ierr) res%day
270 | if (ierr /= 0) then
271 | write(*, *) '[Error]: datetime: Invalid argument ' // trim(datetime_str) // '!'
272 | stop 1
273 | end if
274 | read(datetime_str(12:13), '(I2)', iostat=ierr) res%hour
275 | if (ierr /= 0) then
276 | write(*, *) '[Error]: datetime: Invalid argument ' // trim(datetime_str) // '!'
277 | stop 1
278 | end if
279 | read(datetime_str(15:16), '(I2)', iostat=ierr) res%minute
280 | if (ierr /= 0) then
281 | write(*, *) '[Error]: datetime: Invalid argument ' // trim(datetime_str) // '!'
282 | stop 1
283 | end if
284 | read(datetime_str(18:19), '(I2)', iostat=ierr) res%second
285 | if (ierr /= 0) then
286 | write(*, *) '[Error]: datetime: Invalid argument ' // trim(datetime_str) // '!'
287 | stop 1
288 | end if
289 | end if
290 |
291 | if (present(timezone)) then
292 | select type (timezone)
293 | type is (integer)
294 | res%timezone = timezone
295 | type is (real(4))
296 | res%timezone = timezone
297 | type is (real(8))
298 | res%timezone = timezone
299 | class default
300 | write(*, *) '[Error]: datetime: Invalid timezone argument type! Only integer and real are supported.'
301 | stop 1
302 | end select
303 | end if
304 |
305 | if (present(calendar)) res%calendar = calendar
306 |
307 | end function datetime_2
308 |
309 | function isoformat(this) result(res)
310 |
311 | class(datetime_type), intent(in) :: this
312 | character(:), allocatable :: res
313 |
314 | character(30) tmp
315 |
316 | if (this%timezone == 0) then
317 | write(tmp, "(I4.4, '-', I2.2, '-', I2.2, 'T', I2.2, ':', I2.2, ':', I2.2, 'Z')") &
318 | this%year, this%month, this%day, this%hour, this%minute, this%second
319 | else
320 | write(tmp, "(I4.4, '-', I2.2, '-', I2.2, 'T', I2.2, ':', I2.2, ':', I2.2, SP, I3.2, ':00')") &
321 | this%year, this%month, this%day, this%hour, this%minute, this%second, int(this%timezone)
322 | end if
323 |
324 | res = trim(tmp)
325 |
326 | end function isoformat
327 |
328 | function timestamp(this, timezone)
329 |
330 | class(datetime_type), intent(in) :: this
331 | class(*), intent(in), optional :: timezone
332 | real(8) timestamp
333 |
334 | type(timedelta_type) dt
335 |
336 | dt = this - create_datetime(1970)
337 | timestamp = dt%total_seconds()
338 | if (present(timezone)) then
339 | select type (timezone)
340 | type is (integer)
341 | timestamp = timestamp - (this%timezone - timezone) * 3600
342 | type is (real(4))
343 | timestamp = timestamp - (this%timezone - timezone) * 3600
344 | type is (real(8))
345 | timestamp = timestamp - (this%timezone - timezone) * 3600
346 | end select
347 | end if
348 |
349 | end function timestamp
350 |
351 | function format(this, format_str) result(res)
352 |
353 | class(datetime_type), intent(in) :: this
354 | character(*), intent(in) :: format_str
355 | character(:), allocatable :: res
356 |
357 | character(100) tmp
358 | integer i, j
359 |
360 | tmp = ''
361 | i = 1
362 | j = 1
363 | do while (i <= len_trim(format_str))
364 | if (format_str(i:i) == '%') then
365 | i = i + 1
366 | select case (format_str(i:i))
367 | case ('Y')
368 | write(tmp(j:j+3), '(I4.4)') this%year
369 | j = j + 4
370 | case ('y')
371 | write(tmp(j:j+1), '(I2.2)') mod(this%year, 100)
372 | j = j + 2
373 | case ('j')
374 | write(tmp(j:j+2), '(I3.3)') this%days_in_year()
375 | j = j + 3
376 | case ('m')
377 | write(tmp(j:j+1), '(I2.2)') this%month
378 | j = j + 2
379 | case ('d')
380 | write(tmp(j:j+1), '(I2.2)') this%day
381 | j = j + 2
382 | case ('H')
383 | write(tmp(j:j+1), '(I2.2)') this%hour
384 | j = j + 2
385 | case ('M')
386 | write(tmp(j:j+1), '(I2.2)') this%minute
387 | j = j + 2
388 | case ('S')
389 | write(tmp(j:j+1), '(I2.2)') this%second
390 | j = j + 2
391 | case ('s')
392 | write(tmp(j:j+4), '(I5.5)') this%hour * 3600 + this%minute * 60 + this%second
393 | end select
394 | else
395 | write(tmp(j:j), '(A1)') format_str(i:i)
396 | j = j + 1
397 | end if
398 | i = i + 1
399 | end do
400 | res = trim(tmp)
401 |
402 | end function format
403 |
404 | pure subroutine add_months(this, months)
405 |
406 | class(datetime_type), intent(inout) :: this
407 | integer, intent(in) :: months
408 |
409 | this%month = this%month + months
410 |
411 | if (this%month > 12) then
412 | this%year = this%year + this%month / 12
413 | this%month = mod(this%month, 12)
414 | else if (this%month < 1) then
415 | this%year = this%year + this%month / 12 - 1
416 | this%month = 12 + mod(this%month, 12)
417 | end if
418 |
419 | end subroutine add_months
420 |
421 | pure subroutine add_days(this, days)
422 |
423 | class(datetime_type), intent(inout) :: this
424 | class(*), intent(in) :: days
425 |
426 | real(8) residue_days
427 | integer month_days
428 |
429 | select type (days)
430 | type is (integer)
431 | residue_days = 0
432 | this%day = this%day + days
433 | type is (real(4))
434 | residue_days = days - int(days)
435 | this%day = this%day + days
436 | type is (real(8))
437 | residue_days = days - int(days)
438 | this%day = this%day + days
439 | end select
440 |
441 | if (residue_days /= 0) then
442 | call this%add_hours(residue_days * 24)
443 | end if
444 |
445 | do
446 | if (this%day < 1) then
447 | call this%add_months(-1)
448 | month_days = days_of_month(this%year, this%month, this%calendar)
449 | this%day = this%day + month_days
450 | else
451 | month_days = days_of_month(this%year, this%month, this%calendar)
452 | if (this%day > month_days) then
453 | call this%add_months(1)
454 | this%day = this%day - month_days
455 | else
456 | exit
457 | end if
458 | end if
459 | end do
460 |
461 | end subroutine add_days
462 |
463 | pure subroutine add_hours(this, hours)
464 |
465 | class(datetime_type), intent(inout) :: this
466 | class(*), intent(in) :: hours
467 |
468 | real(8) residue_hours
469 |
470 | select type (hours)
471 | type is (integer)
472 | residue_hours = 0
473 | this%hour = this%hour + hours
474 | type is (real(4))
475 | residue_hours = hours - int(hours)
476 | this%hour = this%hour + hours
477 | type is (real(8))
478 | residue_hours = hours - int(hours)
479 | this%hour = this%hour + hours
480 | end select
481 |
482 | if (residue_hours /= 0) then
483 | call this%add_minutes(residue_hours * 60)
484 | end if
485 |
486 | if (this%hour >= 24) then
487 | call this%add_days(this%hour / 24)
488 | this%hour = mod(this%hour, 24)
489 | else if (this%hour < 0) then
490 | if (mod(this%hour, 24) == 0) then
491 | call this%add_days(this%hour / 24)
492 | this%hour = 0
493 | else
494 | call this%add_days(this%hour / 24 - 1)
495 | this%hour = mod(this%hour, 24) + 24
496 | end if
497 | end if
498 |
499 | end subroutine add_hours
500 |
501 | pure subroutine add_minutes(this, minutes)
502 |
503 | class(datetime_type), intent(inout) :: this
504 | class(*), intent(in) :: minutes
505 |
506 | real(8) residue_minutes
507 |
508 | select type (minutes)
509 | type is (integer)
510 | residue_minutes = 0
511 | this%minute = this%minute + minutes
512 | type is (real(4))
513 | residue_minutes = minutes - int(minutes)
514 | this%minute = this%minute + minutes
515 | type is (real(8))
516 | residue_minutes = minutes - int(minutes)
517 | this%minute = this%minute + minutes
518 | end select
519 |
520 | if (residue_minutes /= 0) then
521 | call this%add_seconds(residue_minutes * 60)
522 | end if
523 |
524 | if (this%minute >= 60) then
525 | call this%add_hours(this%minute / 60)
526 | this%minute = mod(this%minute, 60)
527 | else if (this%minute < 0) then
528 | if (mod(this%minute, 60) == 0) then
529 | call this%add_hours(this%minute / 60)
530 | this%minute = 0
531 | else
532 | call this%add_hours(this%minute / 60 - 1)
533 | this%minute = mod(this%minute, 60) + 60
534 | end if
535 | end if
536 |
537 | end subroutine add_minutes
538 |
539 | pure subroutine add_seconds(this, seconds)
540 |
541 | class(datetime_type), intent(inout) :: this
542 | class(*), intent(in) :: seconds
543 |
544 | real(8) residue_seconds
545 |
546 | select type (seconds)
547 | type is (integer)
548 | residue_seconds = 0
549 | this%second = this%second + seconds
550 | type is (real(4))
551 | residue_seconds = seconds - int(seconds)
552 | this%second = this%second + seconds
553 | type is (real(8))
554 | residue_seconds = seconds - int(seconds)
555 | this%second = this%second + seconds
556 | end select
557 |
558 | if (residue_seconds /= 0) then
559 | call this%add_milliseconds(residue_seconds * 1000)
560 | end if
561 |
562 | if (this%second >= 60) then
563 | call this%add_minutes(this%second / 60)
564 | this%second = mod(this%second, 60)
565 | else if (this%second < 0) then
566 | if (mod(this%second, 60) == 0) then
567 | call this%add_minutes(this%second / 60)
568 | this%second = 0
569 | else
570 | call this%add_minutes(this%second / 60 - 1)
571 | this%second = mod(this%second, 60) + 60
572 | end if
573 | end if
574 |
575 | end subroutine add_seconds
576 |
577 | pure subroutine add_milliseconds(this, milliseconds)
578 |
579 | class(datetime_type), intent(inout) :: this
580 | class(*), intent(in) :: milliseconds
581 |
582 | select type (milliseconds)
583 | type is (integer)
584 | this%millisecond = this%millisecond + milliseconds
585 | type is (real(4))
586 | this%millisecond = this%millisecond + milliseconds
587 | type is (real(8))
588 | this%millisecond = this%millisecond + milliseconds
589 | end select
590 |
591 | if (this%millisecond >= 1000) then
592 | call this%add_seconds(int(this%millisecond / 1000))
593 | this%millisecond = mod(this%millisecond, 1000.0)
594 | else if (this%millisecond < 0) then
595 | if (mod(this%millisecond, 1000.0) == 0) then
596 | call this%add_seconds(int(this%millisecond / 1000))
597 | this%millisecond = 0
598 | else
599 | call this%add_seconds(int(this%millisecond / 1000) - 1)
600 | this%millisecond = mod(this%millisecond, 1000.0d0) + 1000
601 | end if
602 | end if
603 |
604 | end subroutine add_milliseconds
605 |
606 | pure integer function days_in_year(this) result(res)
607 |
608 | class(datetime_type), intent(in) :: this
609 |
610 | integer month
611 |
612 | res = 0
613 | do month = 1, this%month - 1
614 | res = res + days_of_month(this%year, month, this%calendar)
615 | end do
616 | res = res + this%day
617 |
618 | end function days_in_year
619 |
620 | pure elemental subroutine assign(this, other)
621 |
622 | class(datetime_type), intent(inout) :: this
623 | class(datetime_type), intent(in) :: other
624 |
625 | this%calendar = other%calendar
626 | this%year = other%year
627 | this%month = other%month
628 | this%day = other%day
629 | this%hour = other%hour
630 | this%minute = other%minute
631 | this%second = other%second
632 | this%millisecond = other%millisecond
633 | this%timezone = other%timezone
634 |
635 | end subroutine assign
636 |
637 | elemental type(datetime_type) function add_timedelta(this, td) result(res)
638 |
639 | class(datetime_type), intent(in) :: this
640 | type(timedelta_type), intent(in) :: td
641 |
642 | res = this
643 | call res%add_milliseconds(td%milliseconds)
644 | call res%add_seconds(td%seconds)
645 | call res%add_minutes(td%minutes)
646 | call res%add_hours(td%hours)
647 | call res%add_days(td%days)
648 | call res%add_months(td%months)
649 |
650 | end function add_timedelta
651 |
652 | pure elemental type(datetime_type) function sub_timedelta(this, td) result(res)
653 |
654 | class(datetime_type), intent(in) :: this
655 | type(timedelta_type), intent(in) :: td
656 |
657 | res = this
658 | call res%add_milliseconds(-td%milliseconds)
659 | call res%add_seconds(-td%seconds)
660 | call res%add_minutes(-td%minutes)
661 | call res%add_hours(-td%hours)
662 | call res%add_days(-td%days)
663 | call res%add_months(-td%months)
664 |
665 | end function sub_timedelta
666 |
667 | type(timedelta_type) recursive function sub_datetime(this, other) result(res)
668 |
669 | class(datetime_type), intent(in) :: this
670 | class(datetime_type), intent(in) :: other
671 |
672 | integer year, month, days, hours, minutes, seconds
673 | real(8) milliseconds
674 |
675 | days = 0
676 | hours = 0
677 | minutes = 0
678 | seconds = 0
679 | milliseconds = 0
680 |
681 | if (this >= other) then
682 | if (this%year == other%year) then
683 | if (this%month == other%month) then
684 | if (this%day == other%day) then
685 | if (this%hour == other%hour) then
686 | if (this%minute == other%minute) then
687 | if (this%second == other%second) then
688 | milliseconds = milliseconds + this%millisecond - other%millisecond
689 | else
690 | seconds = seconds + this%second - other%second - 1
691 | milliseconds = milliseconds + 1000 - other%millisecond
692 | milliseconds = milliseconds + this%millisecond
693 | end if
694 | else
695 | minutes = minutes + this%minute - other%minute - 1
696 | seconds = seconds + 60 - other%second - 1
697 | seconds = seconds + this%second
698 | milliseconds = milliseconds + 1000 - other%millisecond
699 | milliseconds = milliseconds + this%millisecond
700 | end if
701 | else
702 | hours = hours + this%hour - other%hour - 1
703 | minutes = minutes + 60 - other%minute - 1
704 | minutes = minutes + this%minute
705 | seconds = seconds + 60 - other%second - 1
706 | seconds = seconds + this%second
707 | milliseconds = milliseconds + 1000 - other%millisecond
708 | milliseconds = milliseconds + this%millisecond
709 | end if
710 | else
711 | days = days + this%day - other%day - 1
712 | hours = hours + 24 - other%hour - 1
713 | hours = hours + this%hour
714 | minutes = minutes + 60 - other%minute - 1
715 | minutes = minutes + this%minute
716 | seconds = seconds + 60 - other%second - 1
717 | seconds = seconds + this%second
718 | milliseconds = milliseconds + 1000 - other%millisecond
719 | milliseconds = milliseconds + this%millisecond
720 | end if
721 | else
722 | do month = other%month + 1, this%month - 1
723 | days = days + days_of_month(this%year, month, this%calendar)
724 | end do
725 | days = days + days_of_month(other%year, other%month, other%calendar) - other%day - 1
726 | days = days + this%day
727 | hours = hours + 24 - other%hour - 1
728 | hours = hours + this%hour
729 | minutes = minutes + 60 - other%minute - 1
730 | minutes = minutes + this%minute
731 | seconds = seconds + 60 - other%second - 1
732 | seconds = seconds + this%second
733 | milliseconds = milliseconds + 1000 - other%millisecond
734 | milliseconds = milliseconds + this%millisecond
735 | end if
736 | else
737 | do year = other%year + 1, this%year - 1
738 | if (this%calendar == datetime_gregorian_calendar) then
739 | days = days + 365 + merge(1, 0, is_leap_year(year))
740 | else
741 | days = days + 365
742 | end if
743 | end do
744 | do month = other%month + 1, 12
745 | days = days + days_of_month(other%year, month, other%calendar)
746 | end do
747 | do month = 1, this%month - 1
748 | days = days + days_of_month(this%year, month, this%calendar)
749 | end do
750 | days = days + days_of_month(other%year, other%month, other%calendar) - other%day - 1
751 | days = days + this%day
752 | hours = hours + 24 - other%hour - 1
753 | hours = hours + this%hour
754 | minutes = minutes + 60 - other%minute - 1
755 | minutes = minutes + this%minute
756 | seconds = seconds + 60 - other%second - 1
757 | seconds = seconds + this%second
758 | milliseconds = milliseconds + 1000 - other%millisecond
759 | milliseconds = milliseconds + this%millisecond
760 | end if
761 | ! Carry over.
762 | if (milliseconds >= 1000) then
763 | milliseconds = milliseconds - 1000
764 | seconds = seconds + 1
765 | end if
766 | if (seconds >= 60) then
767 | seconds = seconds - 60
768 | minutes = minutes + 1
769 | end if
770 | if (minutes >= 60) then
771 | minutes = minutes - 60
772 | hours = hours + 1
773 | end if
774 | if (hours >= 24) then
775 | hours = hours - 24
776 | days = days + 1
777 | end if
778 | res = create_timedelta(days=days, hours=hours, minutes=minutes, seconds=seconds, milliseconds=milliseconds)
779 | else
780 | res = sub_datetime(other, this)
781 | res = res%negate()
782 | end if
783 |
784 | end function sub_datetime
785 |
786 | pure elemental logical function eq(this, other)
787 |
788 | class(datetime_type), intent(in) :: this
789 | class(datetime_type), intent(in) :: other
790 |
791 | eq = this%year == other%year .and. &
792 | this%month == other%month .and. &
793 | this%day == other%day .and. &
794 | this%hour == other%hour .and. &
795 | this%minute == other%minute .and. &
796 | this%second == other%second .and. &
797 | this%millisecond == other%millisecond
798 |
799 | end function eq
800 |
801 | pure elemental logical function neq(this, other)
802 |
803 | class(datetime_type), intent(in) :: this
804 | class(datetime_type), intent(in) :: other
805 |
806 | neq = .not. this == other
807 |
808 | end function neq
809 |
810 | pure elemental logical function gt(this, other)
811 |
812 | class(datetime_type), intent(in) :: this
813 | class(datetime_type), intent(in) :: other
814 |
815 | if (this%year < other%year) then
816 | gt = .false.
817 | return
818 | else if (this%year > other%year) then
819 | gt = .true.
820 | return
821 | end if
822 |
823 | if (this%month < other%month) then
824 | gt = .false.
825 | return
826 | else if (this%month > other%month) then
827 | gt = .true.
828 | return
829 | end if
830 |
831 | if (this%day < other%day) then
832 | gt = .false.
833 | return
834 | else if (this%day > other%day) then
835 | gt = .true.
836 | return
837 | end if
838 |
839 | if (this%hour < other%hour) then
840 | gt = .false.
841 | return
842 | else if (this%hour > other%hour) then
843 | gt = .true.
844 | return
845 | end if
846 |
847 | if (this%minute < other%minute) then
848 | gt = .false.
849 | return
850 | else if (this%minute > other%minute) then
851 | gt = .true.
852 | return
853 | end if
854 |
855 | if (this%second < other%second) then
856 | gt = .false.
857 | return
858 | else if (this%second > other%second) then
859 | gt = .true.
860 | return
861 | end if
862 |
863 | if (this%millisecond < other%millisecond) then
864 | gt = .false.
865 | return
866 | else if (this%millisecond < other%millisecond) then
867 | gt = .true.
868 | return
869 | end if
870 |
871 | gt = this /= other
872 |
873 | end function gt
874 |
875 | pure elemental logical function ge(this, other)
876 |
877 | class(datetime_type), intent(in) :: this
878 | class(datetime_type), intent(in) :: other
879 |
880 | ge = this > other .or. this == other
881 |
882 | end function ge
883 |
884 | pure elemental logical function lt(this, other)
885 |
886 | class(datetime_type), intent(in) :: this
887 | class(datetime_type), intent(in) :: other
888 |
889 | lt = other > this
890 |
891 | end function lt
892 |
893 | pure elemental logical function le(this, other)
894 |
895 | class(datetime_type), intent(in) :: this
896 | class(datetime_type), intent(in) :: other
897 |
898 | le = other > this .or. this == other
899 |
900 | end function le
901 |
902 | pure integer function days_of_month(year, month, calendar) result(res)
903 |
904 | integer, intent(in) :: year
905 | integer, intent(in) :: month
906 | integer, intent(in) :: calendar
907 |
908 | integer, parameter :: days(12) = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
909 |
910 | if (month == 2 .and. is_leap_year(year) .and. calendar == datetime_gregorian_calendar) then
911 | res = 29
912 | else
913 | res = days(month)
914 | end if
915 |
916 | end function days_of_month
917 |
918 | pure integer function accum_days(year, month, day, calendar) result(res)
919 |
920 | integer, intent(in) :: year
921 | integer, intent(in) :: month
922 | integer, intent(in) :: day
923 | integer, intent(in) :: calendar
924 |
925 | integer mon
926 |
927 | res = day
928 | do mon = 1, month - 1
929 | res = res + days_of_month(year, mon, calendar)
930 | end do
931 |
932 | end function accum_days
933 |
934 | pure integer function days_of_year(year, calendar) result(res)
935 |
936 | integer, intent(in) :: year
937 | integer, intent(in) :: calendar
938 |
939 | select case (calendar)
940 | case (datetime_gregorian_calendar)
941 | if (is_leap_year(year)) then
942 | res = 366
943 | else
944 | res = 365
945 | end if
946 | case (datetime_noleap_calendar)
947 | res = 365
948 | end select
949 |
950 | end function days_of_year
951 |
952 | pure logical function is_leap_year(year) result(res)
953 |
954 | integer, intent(in) :: year
955 |
956 | res = (mod(year, 4) == 0 .and. .not. mod(year, 100) == 0) .or. (mod(year, 400) == 0)
957 |
958 | end function is_leap_year
959 |
960 | end module datetime_mod
961 |
--------------------------------------------------------------------------------
/src/datetime_test.F90:
--------------------------------------------------------------------------------
1 | program datetime_test
2 |
3 | use unit_test
4 | use datetime
5 |
6 | implicit none
7 |
8 | type(datetime_type) a, b
9 | type(timedelta_type) dt
10 |
11 | call test_suite_init('Test datetime')
12 |
13 | call test_basic_functions()
14 |
15 | call test_constructors()
16 |
17 | call test_operators()
18 |
19 | call test_suite_report()
20 |
21 | call test_suite_final()
22 |
23 | contains
24 |
25 | subroutine test_basic_functions()
26 |
27 | call test_case_create('Test basic functions')
28 |
29 | ! Test leap year judgement.
30 | call assert_false(is_leap_year(2017), __FILE__, __LINE__)
31 | call assert_true(is_leap_year(2000), __FILE__, __LINE__)
32 | call assert_true(is_leap_year(2004), __FILE__, __LINE__)
33 | call assert_true(is_leap_year(2008), __FILE__, __LINE__)
34 | call assert_true(is_leap_year(2012), __FILE__, __LINE__)
35 | call assert_true(is_leap_year(2016), __FILE__, __LINE__)
36 |
37 | ! Test days_of_month.
38 | call assert_equal(days_of_month(2019, 1, datetime_gregorian_calendar), 31, __FILE__, __LINE__)
39 | call assert_equal(days_of_month(2019, 2, datetime_gregorian_calendar), 28, __FILE__, __LINE__)
40 | call assert_equal(days_of_month(2019, 3, datetime_gregorian_calendar), 31, __FILE__, __LINE__)
41 | call assert_equal(days_of_month(2019, 4, datetime_gregorian_calendar), 30, __FILE__, __LINE__)
42 | call assert_equal(days_of_month(2019, 5, datetime_gregorian_calendar), 31, __FILE__, __LINE__)
43 | call assert_equal(days_of_month(2019, 6, datetime_gregorian_calendar), 30, __FILE__, __LINE__)
44 | call assert_equal(days_of_month(2019, 7, datetime_gregorian_calendar), 31, __FILE__, __LINE__)
45 | call assert_equal(days_of_month(2019, 8, datetime_gregorian_calendar), 31, __FILE__, __LINE__)
46 | call assert_equal(days_of_month(2019, 9, datetime_gregorian_calendar), 30, __FILE__, __LINE__)
47 | call assert_equal(days_of_month(2019, 10, datetime_gregorian_calendar), 31, __FILE__, __LINE__)
48 | call assert_equal(days_of_month(2019, 11, datetime_gregorian_calendar), 30, __FILE__, __LINE__)
49 | call assert_equal(days_of_month(2019, 12, datetime_gregorian_calendar), 31, __FILE__, __LINE__)
50 | call assert_equal(days_of_month(1984, 2, datetime_gregorian_calendar), 29, __FILE__, __LINE__)
51 |
52 | ! Test accum_days.
53 | call assert_equal(accum_days(2019, 11, 0, datetime_gregorian_calendar), 304, __FILE__, __LINE__)
54 | call assert_equal(accum_days(2019, 11, 1, datetime_gregorian_calendar), 305, __FILE__, __LINE__)
55 | call assert_equal(accum_days(2019, 12, 31, datetime_gregorian_calendar), 365, __FILE__, __LINE__)
56 |
57 | ! Test days_of_year.
58 | call assert_equal(days_of_year(2017, datetime_gregorian_calendar), 365, __FILE__, __LINE__)
59 |
60 | end subroutine test_basic_functions
61 |
62 | subroutine test_constructors()
63 |
64 | type(datetime_type) a
65 |
66 | call test_case_create('Test constructors')
67 |
68 | a = create_datetime(2017, 10, 6, 12, 31, 23)
69 | call assert_equal(a%year, 2017, __FILE__, __LINE__)
70 | call assert_equal(a%month, 10, __FILE__, __LINE__)
71 | call assert_equal(a%day, 6, __FILE__, __LINE__)
72 | call assert_equal(a%hour, 12, __FILE__, __LINE__)
73 | call assert_equal(a%minute, 31, __FILE__, __LINE__)
74 | call assert_equal(a%second, 23, __FILE__, __LINE__)
75 | call assert_equal(a%millisecond, 0.0d0, __FILE__, __LINE__)
76 | call assert_equal(a%timezone, 0.0d0, __FILE__, __LINE__)
77 | call assert_equal(a%isoformat(), '2017-10-06T12:31:23Z', __FILE__, __LINE__)
78 |
79 | a = create_datetime(year=2019, julday=365, hour=24)
80 | call assert_equal(a%year, 2020, __FILE__, __LINE__)
81 | call assert_equal(a%month, 1, __FILE__, __LINE__)
82 | call assert_equal(a%day, 1, __FILE__, __LINE__)
83 | call assert_equal(a%hour, 0, __FILE__, __LINE__)
84 | call assert_equal(a%minute, 0, __FILE__, __LINE__)
85 | call assert_equal(a%second, 0, __FILE__, __LINE__)
86 |
87 | a = create_datetime(timestamp=1532755828.266736d0)
88 | call assert_approximate(a%timestamp(), 1532755828.266736d0, __FILE__, __LINE__)
89 |
90 | a = create_datetime('2018041401', '%Y%m%d%H')
91 | call assert_equal(a%isoformat(), '2018-04-14T01:00:00Z', __FILE__, __LINE__)
92 | call assert_equal(trim(a%format('%Y')), '2018', __FILE__, __LINE__)
93 | call assert_equal(a%format('%y%j%H%M'), '181040100', __FILE__, __LINE__)
94 |
95 | a = create_datetime('2018-01-18T11:51:10Z')
96 | call assert_equal(a%year, 2018, __FILE__, __LINE__)
97 | call assert_equal(a%month, 1, __FILE__, __LINE__)
98 | call assert_equal(a%day, 18, __FILE__, __LINE__)
99 | call assert_equal(a%hour, 11, __FILE__, __LINE__)
100 | call assert_equal(a%minute, 51, __FILE__, __LINE__)
101 | call assert_equal(a%second, 10, __FILE__, __LINE__)
102 | call assert_equal(a%millisecond, 0.0d0, __FILE__, __LINE__)
103 | call assert_equal(a%timezone, 0.0d0, __FILE__, __LINE__)
104 |
105 | a = create_datetime(days=120)
106 | call assert_equal(a%year, 1, __FILE__, __LINE__)
107 | call assert_equal(a%month, 5, __FILE__, __LINE__)
108 | call assert_equal(a%day, 1, __FILE__, __LINE__)
109 | call assert_equal(a%hour, 0, __FILE__, __LINE__)
110 | call assert_equal(a%minute, 0, __FILE__, __LINE__)
111 |
112 | end subroutine test_constructors
113 |
114 | subroutine test_operators()
115 |
116 | type(datetime_type) a, b
117 | type(timedelta_type) dt
118 |
119 | call test_case_create('Test operators')
120 |
121 | a = create_datetime('2018-01-18T11:51:10Z')
122 |
123 | b = a
124 | call assert_true(a == b, __FILE__, __LINE__)
125 |
126 | dt = create_timedelta(minutes=5)
127 |
128 | b = a + dt
129 | call assert_true(b > a, __FILE__, __LINE__)
130 | call assert_true(b >= a, __FILE__, __LINE__)
131 | call assert_true(a < b, __FILE__, __LINE__)
132 | call assert_true(a <= b, __FILE__, __LINE__)
133 | call assert_true(a /= b, __FILE__, __LINE__)
134 | call assert_equal(a%minute + 5, b%minute, __FILE__, __LINE__)
135 |
136 | b = a - dt
137 | call assert_true(b < a, __FILE__, __LINE__)
138 | call assert_true(b <= a, __FILE__, __LINE__)
139 | call assert_true(a > b, __FILE__, __LINE__)
140 | call assert_true(a >= b, __FILE__, __LINE__)
141 | call assert_true(a /= b, __FILE__, __LINE__)
142 | call assert_equal(a%minute - 5, b%minute, __FILE__, __LINE__)
143 |
144 | a = create_datetime(2018, 1, 18, 13, 14, 12)
145 | b = create_datetime(2018, 1, 13, 12, 45, 13)
146 | call assert_true(a > b, __FILE__, __LINE__)
147 |
148 | ! Test add_* subroutines.
149 | a = create_datetime(2017, 2, 1)
150 | call a%add_months(-6)
151 | call assert_equal(a%year, 2016, __FILE__, __LINE__)
152 | call assert_equal(a%month, 8, __FILE__, __LINE__)
153 | call assert_equal(a%day, 1, __FILE__, __LINE__)
154 |
155 | a = create_datetime(minute=6)
156 | b = create_datetime(hour=1)
157 | call assert_false(a > b, __FILE__, __LINE__)
158 |
159 | a = create_datetime(minute=56)
160 |
161 | b = a + dt
162 | call assert_equal(b%hour, 1, __FILE__, __LINE__)
163 | call assert_equal(b%minute, 1, __FILE__, __LINE__)
164 |
165 | a = create_datetime(second=45)
166 | dt = create_timedelta(seconds=30)
167 | b = a + dt
168 | call assert_equal(b%minute, 1, __FILE__, __LINE__)
169 | call assert_equal(b%second, 15, __FILE__, __LINE__)
170 |
171 | dt = create_timedelta(days=31)
172 | a = create_datetime()
173 | b = a - dt
174 | call assert_equal(b%year, 0, __FILE__, __LINE__)
175 | call assert_equal(b%month, 12, __FILE__, __LINE__)
176 | call assert_equal(b%day, 1, __FILE__, __LINE__)
177 | call assert_equal(b%hour, 0, __FILE__, __LINE__)
178 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
179 | call assert_equal(b%second, 0, __FILE__, __LINE__)
180 | call assert_equal(b%millisecond, 0.0d0, __FILE__, __LINE__)
181 |
182 | dt = create_timedelta(days=37)
183 | a = create_datetime()
184 | b = a - dt
185 | call assert_equal(b%year, 0, __FILE__, __LINE__)
186 | call assert_equal(b%month, 11, __FILE__, __LINE__)
187 | call assert_equal(b%day, 25, __FILE__, __LINE__)
188 | call assert_equal(b%hour, 0, __FILE__, __LINE__)
189 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
190 | call assert_equal(b%second, 0, __FILE__, __LINE__)
191 | call assert_equal(b%millisecond, 0.0d0, __FILE__, __LINE__)
192 |
193 | dt = create_timedelta(hours=25)
194 | a = create_datetime()
195 | b = a - dt
196 | call assert_equal(b%year, 0, __FILE__, __LINE__)
197 | call assert_equal(b%month, 12, __FILE__, __LINE__)
198 | call assert_equal(b%day, 30, __FILE__, __LINE__)
199 | call assert_equal(b%hour, 23, __FILE__, __LINE__)
200 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
201 | call assert_equal(b%second, 0, __FILE__, __LINE__)
202 | call assert_equal(b%millisecond, 0.0d0, __FILE__, __LINE__)
203 |
204 | dt = create_timedelta(hours=24)
205 | a = create_datetime()
206 | b = a - dt
207 | call assert_equal(b%year, 0, __FILE__, __LINE__)
208 | call assert_equal(b%month, 12, __FILE__, __LINE__)
209 | call assert_equal(b%day, 31, __FILE__, __LINE__)
210 | call assert_equal(b%hour, 0, __FILE__, __LINE__)
211 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
212 | call assert_equal(b%second, 0, __FILE__, __LINE__)
213 | call assert_equal(b%millisecond, 0.0d0, __FILE__, __LINE__)
214 |
215 | dt = create_timedelta(minutes=60)
216 | a = create_datetime()
217 | b = a - dt
218 | call assert_equal(b%year, 0, __FILE__, __LINE__)
219 | call assert_equal(b%month, 12, __FILE__, __LINE__)
220 | call assert_equal(b%day, 31, __FILE__, __LINE__)
221 | call assert_equal(b%hour, 23, __FILE__, __LINE__)
222 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
223 | call assert_equal(b%second, 0, __FILE__, __LINE__)
224 | call assert_equal(b%millisecond, 0.0d0, __FILE__, __LINE__)
225 |
226 | dt = create_timedelta(seconds=21600)
227 | a = create_datetime()
228 | b = a - dt
229 | call assert_equal(b%year, 0, __FILE__, __LINE__)
230 | call assert_equal(b%month, 12, __FILE__, __LINE__)
231 | call assert_equal(b%day, 31, __FILE__, __LINE__)
232 | call assert_equal(b%hour, 18, __FILE__, __LINE__)
233 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
234 | call assert_equal(b%second, 0, __FILE__, __LINE__)
235 | call assert_equal(b%millisecond, 0.0d0, __FILE__, __LINE__)
236 |
237 | dt = create_timedelta(milliseconds=2200)
238 | a = create_datetime(millisecond=300)
239 | b = a + dt
240 | call assert_equal(b%year, 1, __FILE__, __LINE__)
241 | call assert_equal(b%month, 1, __FILE__, __LINE__)
242 | call assert_equal(b%day, 1, __FILE__, __LINE__)
243 | call assert_equal(b%hour, 0, __FILE__, __LINE__)
244 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
245 | call assert_equal(b%second, 2, __FILE__, __LINE__)
246 | call assert_equal(b%millisecond, 500.0d0, __FILE__, __LINE__)
247 |
248 | dt = create_timedelta(milliseconds=1000)
249 | a = create_datetime()
250 | b = a - dt
251 | call assert_equal(b%year, 0, __FILE__, __LINE__)
252 | call assert_equal(b%month, 12, __FILE__, __LINE__)
253 | call assert_equal(b%day, 31, __FILE__, __LINE__)
254 | call assert_equal(b%hour, 23, __FILE__, __LINE__)
255 | call assert_equal(b%minute, 59, __FILE__, __LINE__)
256 | call assert_equal(b%second, 59, __FILE__, __LINE__)
257 | call assert_equal(b%millisecond, 0.0d0, __FILE__, __LINE__)
258 |
259 | a = create_datetime(2018, 1, 1, 0, 0, 0)
260 | b = create_datetime(2018, 1, 1, 0, 0, 0)
261 | dt = a - b
262 | call assert_equal(dt%days, 0.0d0, __FILE__, __LINE__)
263 | call assert_equal(dt%hours, 0.0d0, __FILE__, __LINE__)
264 | call assert_equal(dt%minutes, 0.0d0, __FILE__, __LINE__)
265 | call assert_equal(dt%seconds, 0.0d0, __FILE__, __LINE__)
266 | call assert_equal(dt%milliseconds, 0.0d0, __FILE__, __LINE__)
267 |
268 | a = create_datetime(2018, 1, 18, 13, 14, 12)
269 | b = create_datetime(2018, 1, 13, 12, 45, 13)
270 | dt = a - b
271 | call assert_equal(dt%milliseconds, 0.0d0, __FILE__, __LINE__)
272 | call assert_equal(dt%seconds, 59.0d0, __FILE__, __LINE__)
273 | call assert_equal(dt%minutes, 28.0d0, __FILE__, __LINE__)
274 | call assert_equal(dt%hours, 0.0d0, __FILE__, __LINE__)
275 | call assert_equal(dt%days, 5.0d0, __FILE__, __LINE__)
276 |
277 | a = create_datetime(2018, 1, 18, 0, 0, 0)
278 | b = create_datetime(2018, 1, 13, 0, 0, 0)
279 | dt = a - b
280 | call assert_equal(dt%milliseconds, 0.0d0, __FILE__, __LINE__)
281 | call assert_equal(dt%seconds, 0.0d0, __FILE__, __LINE__)
282 | call assert_equal(dt%minutes, 0.0d0, __FILE__, __LINE__)
283 | call assert_equal(dt%hours, 0.0d0, __FILE__, __LINE__)
284 | call assert_equal(dt%days, 5.0d0, __FILE__, __LINE__)
285 |
286 | a = create_datetime(2017, 2, 18, 13, 37, 20)
287 | b = create_datetime(2018, 1, 13, 0, 0, 0)
288 | dt = a - b
289 | call assert_equal(dt%milliseconds, 0.0d0, __FILE__, __LINE__)
290 | call assert_equal(dt%seconds, -40.0d0, __FILE__, __LINE__)
291 | call assert_equal(dt%minutes, -22.0d0, __FILE__, __LINE__)
292 | call assert_equal(dt%hours, -10.0d0, __FILE__, __LINE__)
293 | call assert_equal(dt%days, -328.0d0, __FILE__, __LINE__)
294 |
295 | a = create_datetime(2018, 4, 18, 13, 37, 20)
296 | b = create_datetime(2018, 4, 18, 13, 37, 10)
297 | dt = a - b
298 | call assert_equal(dt%milliseconds, 0.0d0, __FILE__, __LINE__)
299 | call assert_equal(dt%seconds, 10.0d0, __FILE__, __LINE__)
300 | call assert_equal(dt%minutes, 0.0d0, __FILE__, __LINE__)
301 | call assert_equal(dt%hours, 0.0d0, __FILE__, __LINE__)
302 | call assert_equal(dt%days, 0.0d0, __FILE__, __LINE__)
303 |
304 | a = create_datetime(2018, 4, 18, 13, 37, 0)
305 | b = create_datetime(2018, 4, 18, 13, 34, 0)
306 | dt = a - b
307 | call assert_equal(dt%milliseconds, 0.0d0, __FILE__, __LINE__)
308 | call assert_equal(dt%seconds, 0.0d0, __FILE__, __LINE__)
309 | call assert_equal(dt%minutes, 3.0d0, __FILE__, __LINE__)
310 | call assert_equal(dt%hours, 0.0d0, __FILE__, __LINE__)
311 | call assert_equal(dt%days, 0.0d0, __FILE__, __LINE__)
312 |
313 | a = create_datetime(2018, 4, 18, 13, 0, 0)
314 | b = create_datetime(2018, 4, 18, 12, 0, 0)
315 | dt = a - b
316 | call assert_equal(dt%milliseconds, 0.0d0, __FILE__, __LINE__)
317 | call assert_equal(dt%seconds, 0.0d0, __FILE__, __LINE__)
318 | call assert_equal(dt%minutes, 0.0d0, __FILE__, __LINE__)
319 | call assert_equal(dt%hours, 1.0d0, __FILE__, __LINE__)
320 | call assert_equal(dt%days, 0.0d0, __FILE__, __LINE__)
321 |
322 | a = create_datetime(year=2017, month=10, day=6, hour=14)
323 | b = create_datetime(year=2018, month=4, day=16, hour=23, minute=51)
324 | dt = b - a
325 | call assert_equal(dt%total_seconds(), 16624260.0d0, __FILE__, __LINE__)
326 | call assert_equal(dt%total_minutes(), 16624260.0d0 / 60.0d0, __FILE__, __LINE__)
327 | call assert_equal(dt%total_hours(), 16624260 / 3600.0d0, __FILE__, __LINE__)
328 | call assert_equal(dt%total_days(), 16624260 / 86400.0d0, __FILE__, __LINE__)
329 |
330 | a = create_datetime(year=2015, month=8, day=5, hour=21)
331 | b = create_datetime(year=2015, month=8, day=5, hour=19, minute=31)
332 | dt = b - a
333 | call assert_equal(dt%days, 0.0d0, __FILE__, __LINE__)
334 | call assert_equal(dt%hours, -1.0d0, __FILE__, __LINE__)
335 | call assert_equal(dt%minutes, -29.0d0, __FILE__, __LINE__)
336 |
337 | dt = create_timedelta(hours=0.5)
338 | a = create_datetime(2018, 9, 4, 14, 30)
339 | b = a + dt
340 | call assert_equal(b%year, 2018, __FILE__, __LINE__)
341 | call assert_equal(b%month, 9, __FILE__, __LINE__)
342 | call assert_equal(b%day, 4, __FILE__, __LINE__)
343 | call assert_equal(b%hour, 15, __FILE__, __LINE__)
344 | call assert_equal(b%minute, 0, __FILE__, __LINE__)
345 |
346 | end subroutine test_operators
347 |
348 | end program datetime_test
349 |
--------------------------------------------------------------------------------
/src/timedelta_mod.F90:
--------------------------------------------------------------------------------
1 | module timedelta_mod
2 |
3 | implicit none
4 |
5 | private
6 |
7 | public timedelta_type
8 | public create_timedelta
9 |
10 | type timedelta_type
11 | integer :: months = 0.0d0
12 | real(8) :: days = 0.0d0
13 | real(8) :: hours = 0.0d0
14 | real(8) :: minutes = 0.0d0
15 | real(8) :: seconds = 0.0d0
16 | real(8) :: milliseconds = 0.0d0
17 | contains
18 | procedure :: total_seconds
19 | procedure :: total_minutes
20 | procedure :: total_hours
21 | procedure :: total_days
22 | procedure :: negate
23 | procedure :: eq
24 | procedure :: neq
25 | procedure :: gt
26 | procedure :: ge
27 | procedure :: lt
28 | procedure :: le
29 | generic :: operator(==) => eq
30 | generic :: operator(/=) => neq
31 | generic :: operator(>) => gt
32 | generic :: operator(>=) => ge
33 | generic :: operator(<) => lt
34 | generic :: operator(<=) => le
35 | end type timedelta_type
36 |
37 | contains
38 |
39 | pure type(timedelta_type) function create_timedelta(months, days, hours, minutes, seconds, milliseconds) result(res)
40 |
41 | class(*), intent(in), optional :: months
42 | class(*), intent(in), optional :: days
43 | class(*), intent(in), optional :: hours
44 | class(*), intent(in), optional :: minutes
45 | class(*), intent(in), optional :: seconds
46 | class(*), intent(in), optional :: milliseconds
47 |
48 | real(8) remainder
49 |
50 | remainder = 0.0d0
51 |
52 | if (present(months)) then
53 | select type (months)
54 | type is (integer)
55 | res%months = months
56 | type is (real(4))
57 | res%months = months
58 | type is (real(8))
59 | res%months = months
60 | end select
61 | end if
62 |
63 | if (present(days)) then
64 | select type (days)
65 | type is (integer)
66 | res%days = days
67 | type is (real(4))
68 | res%days = days
69 | type is (real(8))
70 | res%days = days
71 | end select
72 | end if
73 |
74 | if (present(hours)) then
75 | select type (hours)
76 | type is (integer)
77 | res%hours = hours
78 | type is (real(4))
79 | res%hours = hours
80 | type is (real(8))
81 | res%hours = hours
82 | end select
83 | end if
84 |
85 | if (present(minutes)) then
86 | select type (minutes)
87 | type is (integer)
88 | res%minutes = minutes
89 | type is (real(4))
90 | res%minutes = minutes
91 | type is (real(8))
92 | res%minutes = minutes
93 | end select
94 | end if
95 |
96 | if (present(seconds)) then
97 | select type (seconds)
98 | type is (integer)
99 | res%seconds = seconds
100 | type is (real(4))
101 | res%seconds = seconds
102 | type is (real(8))
103 | res%seconds = seconds
104 | end select
105 | end if
106 |
107 | if (present(milliseconds)) then
108 | select type (milliseconds)
109 | type is (integer)
110 | res%milliseconds = milliseconds
111 | type is (real(4))
112 | res%milliseconds = milliseconds
113 | type is (real(8))
114 | res%milliseconds = milliseconds
115 | end select
116 | end if
117 |
118 | end function create_timedelta
119 |
120 | pure real(8) function total_seconds(this)
121 |
122 | class(timedelta_type), intent(in) :: this
123 |
124 | if (this%months == 0.0d0) then
125 | total_seconds = this%days * 86400 + this%hours * 3600 + this%minutes * 60 + this%seconds + this%milliseconds * 1.0d-3
126 | else
127 | total_seconds = -1
128 | end if
129 |
130 | end function total_seconds
131 |
132 | pure real(8) function total_minutes(this)
133 |
134 | class(timedelta_type), intent(in) :: this
135 |
136 | if (this%months == 0.0d0) then
137 | total_minutes = this%days * 1440 + this%hours * 60 + this%minutes + (this%seconds + this%milliseconds * 1.0d-3) / 60.0d0
138 | else
139 | total_minutes = -1
140 | end if
141 |
142 | end function total_minutes
143 |
144 | pure real(8) function total_hours(this)
145 |
146 | class(timedelta_type), intent(in) :: this
147 |
148 | if (this%months == 0.0d0) then
149 | total_hours = this%days * 24 + this%hours + (this%minutes + (this%seconds + this%milliseconds * 1.0d-3) / 60.0d0) / 60.0d0
150 | else
151 | total_hours = -1
152 | end if
153 |
154 | end function total_hours
155 |
156 | pure real(8) function total_days(this)
157 |
158 | class(timedelta_type), intent(in) :: this
159 |
160 | if (this%months == 0.0d0) then
161 | total_days = this%days + (this%hours + (this%minutes + (this%seconds + this%milliseconds * 1.0d-3) / 60.0d0) / 60.0d0) / 24.0d0
162 | else
163 | total_days = -1
164 | end if
165 |
166 | end function total_days
167 |
168 | pure elemental type(timedelta_type) function negate(this) result(res)
169 |
170 | class(timedelta_type), intent(in) :: this
171 |
172 | res%days = - this%days
173 | res%hours = - this%hours
174 | res%minutes = - this%minutes
175 | res%seconds = - this%seconds
176 | res%milliseconds = - this%milliseconds
177 |
178 | end function negate
179 |
180 | pure elemental logical function eq(this, other)
181 |
182 | class(timedelta_type), intent(in) :: this
183 | class(timedelta_type), intent(in) :: other
184 |
185 | eq = this%total_seconds() == other%total_seconds()
186 |
187 | end function eq
188 |
189 | pure elemental logical function neq(this, other)
190 |
191 | class(timedelta_type), intent(in) :: this
192 | class(timedelta_type), intent(in) :: other
193 |
194 | neq = this%total_seconds() /= other%total_seconds()
195 |
196 | end function neq
197 |
198 | pure elemental logical function gt(this, other)
199 |
200 | class(timedelta_type), intent(in) :: this
201 | class(timedelta_type), intent(in) :: other
202 |
203 | gt = this%total_seconds() > other%total_seconds()
204 |
205 | end function gt
206 |
207 | pure elemental logical function ge(this, other)
208 |
209 | class(timedelta_type), intent(in) :: this
210 | class(timedelta_type), intent(in) :: other
211 |
212 | ge = this%total_seconds() >= other%total_seconds()
213 |
214 | end function ge
215 |
216 | pure elemental logical function lt(this, other)
217 |
218 | class(timedelta_type), intent(in) :: this
219 | class(timedelta_type), intent(in) :: other
220 |
221 | lt = this%total_seconds() < other%total_seconds()
222 |
223 | end function lt
224 |
225 | pure elemental logical function le(this, other)
226 |
227 | class(timedelta_type), intent(in) :: this
228 | class(timedelta_type), intent(in) :: other
229 |
230 | le = this%total_seconds() <= other%total_seconds()
231 |
232 | end function le
233 |
234 | end module timedelta_mod
235 |
--------------------------------------------------------------------------------
/src/timedelta_test.F90:
--------------------------------------------------------------------------------
1 | program timedelta_test
2 |
3 | use unit_test
4 | use datetime
5 |
6 | implicit none
7 |
8 | type(timedelta_type) dt1, dt2
9 |
10 | call test_suite_init('Test timedelta')
11 |
12 | call test_case_create('Test timedelta type')
13 |
14 | dt1 = create_timedelta(days=2)
15 |
16 | call assert_equal(dt1%total_seconds(), 2.0d0 * 86400.0d0, file_name=__FILE__, line_number=__LINE__)
17 | call assert_equal(dt1%total_minutes(), 2.0d0 * 1440.0d0, file_name=__FILE__, line_number=__LINE__)
18 | call assert_equal(dt1%total_hours(), 2.0d0 * 24.0d0, file_name=__FILE__, line_number=__LINE__)
19 | call assert_equal(dt1%total_days(), 2.0d0, file_name=__FILE__, line_number=__LINE__)
20 |
21 | dt1 = create_timedelta(hours=3, minutes=30)
22 |
23 | call assert_equal(dt1%total_seconds(), 3.5 * 3600.0d0, file_name=__FILE__, line_number=__LINE__)
24 | call assert_equal(dt1%total_minutes(), 3.5 * 60.0d0, file_name=__FILE__, line_number=__LINE__)
25 | call assert_equal(dt1%total_hours(), 3.5d0, file_name=__FILE__, line_number=__LINE__)
26 | call assert_equal(dt1%total_days(), 3.5 / 24.0d0, file_name=__FILE__, line_number=__LINE__)
27 |
28 | dt1 = create_timedelta(minutes=6)
29 |
30 | call assert_equal(dt1%total_seconds(), 360.0d0, file_name=__FILE__, line_number=__LINE__)
31 | call assert_equal(dt1%total_minutes(), 6.0d0, file_name=__FILE__, line_number=__LINE__)
32 | call assert_equal(dt1%total_hours(), 6.0d0 / 60.0d0, file_name=__FILE__, line_number=__LINE__)
33 | call assert_equal(dt1%total_days(), 6.0d0 / 1440.0d0, file_name=__FILE__, line_number=__LINE__)
34 |
35 | dt1 = create_timedelta(seconds=60, milliseconds=103)
36 |
37 | call assert_equal(dt1%total_seconds(), 60.103d0, file_name=__FILE__, line_number=__LINE__)
38 | call assert_equal(dt1%total_minutes(), 60.103d0 / 60.0d0, file_name=__FILE__, line_number=__LINE__)
39 | call assert_equal(dt1%total_hours(), 60.103d0 / 3600.0d0, file_name=__FILE__, line_number=__LINE__)
40 | call assert_equal(dt1%total_days(), 60.103d0 / 86400.0d0, file_name=__FILE__, line_number=__LINE__)
41 |
42 | dt1 = create_timedelta(seconds=33.1d0)
43 |
44 | call assert_approximate(dt1%seconds, 33.1d0, eps=1.0d-10, file_name=__FILE__, line_number=__LINE__)
45 | call assert_approximate(dt1%total_seconds(), 33.1d0, eps=1.0d-10, file_name=__FILE__, line_number=__LINE__)
46 |
47 | dt1 = create_timedelta(minutes=3.24d0)
48 |
49 | call assert_equal(dt1%minutes, 3.24d0, file_name=__FILE__, line_number=__LINE__)
50 | call assert_equal(dt1%total_seconds(), 194.4d0, file_name=__FILE__, line_number=__LINE__)
51 |
52 | dt1 = create_timedelta(hours=1.43d0, seconds=13d0)
53 |
54 | call assert_equal(dt1%hours, 1.43d0, file_name=__FILE__, line_number=__LINE__)
55 | call assert_equal(dt1%seconds, 13.0d0, file_name=__FILE__, line_number=__LINE__)
56 | call assert_approximate(dt1%total_seconds(), 5161.0d0, eps=0.1d0, file_name=__FILE__, line_number=__LINE__)
57 |
58 | dt2 = dt1
59 |
60 | call assert_equal(dt2%hours, 1.43d0, file_name=__FILE__, line_number=__LINE__)
61 | call assert_equal(dt2%seconds, 13.0d0, file_name=__FILE__, line_number=__LINE__)
62 | call assert_approximate(dt2%total_seconds(), 5161.0d0, eps=0.1d0, file_name=__FILE__, line_number=__LINE__)
63 |
64 | call test_case_report('Test timedelta type')
65 |
66 | call test_suite_final()
67 |
68 | end program timedelta_test
69 |
--------------------------------------------------------------------------------