Soil Water Balance (SWB2)
Loading...
Searching...
No Matches
datetime.F90
Go to the documentation of this file.
1!> @file
2!! Contains Fortran module @ref datetime, which
3!! @ref DATETIME_T class and associated time and date-related routines.
4
5!> This module contains the @ref DATETIME_T class and associated
6!! time and date-related routines, along with the @ref MONTH_T class which
7!! defines month names and three-letter abbreviations.
8
9module datetime
10
11 use iso_c_binding, only : c_short, c_int, c_long, c_float, c_double, c_bool
12 use fstring
13 use logfiles, only : logs, log_all
14 use exceptions
15 use constants_and_conversions
16
17 implicit none
18 private
19
20 public :: gregorian_date, julian_day, isleap, day_of_year, mmdd2doy, &
21 count_leap_days_between_dates
22
23 public :: assignment(=)
24 interface assignment(=)
25 module procedure :: assign_value_to_sub
26 end interface assignment(=)
27
28 public :: operator(>)
29 interface operator(>)
30 module procedure :: is_date_greater_than
31 end interface operator(>)
32
33 public :: operator(<)
34 interface operator(<)
35 module procedure :: is_date_less_than
36 end interface operator(<)
37
38 type, public :: datetime_t
39
40 integer (c_short) :: imonth = 0
41 integer (c_short) :: iday = 0
42 integer (c_int) :: iyear = 0
43 integer (c_short) :: ihour = 0
44 integer (c_short) :: iminute = 0
45 integer (c_short) :: isecond = 0
46 integer (c_int) :: iwateryearhigh = 0
47 integer (c_int) :: iwateryearlow = 0
48 integer (c_long) :: ijulianday = 0
49 real (c_double) :: djuliandate = 0.0_c_double
50
51 contains
52
53 procedure :: calcjulianday => calc_julian_day_sub
54 procedure :: dayspermonth => get_days_in_month_fn
55 procedure :: daysperyear => get_days_in_year_fn
56 procedure :: calcgregoriandate => calc_gregorian_date_sub
57 procedure :: calcwateryear => calc_water_year_sub
58 procedure :: parsedate => parse_text_to_date_sub
59 procedure :: parsetime => parse_text_to_time_sub
60 procedure :: isleapyear => is_leap_year_fn
61
62 procedure :: settimeformat => set_time_format_indices
63 procedure :: setdateformat => set_date_format_indices
64
65 procedure :: is_date_less_than
66 !> "<" operator for comparing two date objects
67 generic :: operator( < ) => is_date_less_than
68
69 procedure :: is_date_gt_or_equal_to
70 !> ">=" operator for comparing two date objects
71 generic :: operator( >= ) => is_date_gt_or_equal_to
72
73 procedure :: is_date_lt_or_equal_to
74 !> "<=" operator for comparing two date objects
75 generic :: operator( <= ) => is_date_lt_or_equal_to
76
77 procedure :: is_date_equal_to
78 !> "==" operator for comparing two date objects
79 generic :: operator( == ) => is_date_equal_to
80
81 procedure :: date_minus_date_fn
82 procedure :: date_minus_float_fn
83 procedure :: date_minus_int_fn
84 !> "-" operator for subtracting two date objects
85 generic :: operator( - ) => date_minus_date_fn, &
86 date_minus_float_fn, &
87 date_minus_int_fn
88
89 procedure :: date_plus_float_fn
90 generic :: operator( + ) => date_plus_float_fn
91
92 procedure :: setday => date_set_day_sub
93 procedure :: setmonth => date_set_month_sub
94 procedure :: setyear => date_set_year_sub
95 procedure :: addday => date_plus_day_sub
96 procedure :: advancelastdayofmonth => date_advance_to_last_day_of_month_sub
97 procedure :: subtractday => date_minus_day_sub
98 procedure :: addyear => date_plus_year_sub
99 procedure :: subtractyear => date_minus_year_sub
100 procedure :: prettydate => write_pretty_date_fn
101 procedure :: prettydatetime => write_pretty_datetime_fn
102 procedure :: listdatetime => write_list_datetime_fn
103 procedure :: listdate => write_list_date_fn
104 procedure :: listtime => write_list_time_fn
105 procedure :: systime => system_time_to_date_sub
106 procedure :: getdayofyear => get_day_of_year_fn
107 procedure :: getjulianday => get_julian_day_fn
108 procedure :: setjuliandate => set_julian_date_sub
109 procedure :: getfractionofday => get_fraction_of_day_fn
110
111 end type datetime_t
112
113
114 ! the following values are determined by the date format string; defaults to MM/DD/YYYY
115 character (len=14), private :: sdate_format = "MM/DD/YYYY"
116 character (len=14), public :: sdefault_date_format = "MM/DD/YYYY"
117 integer (c_int), private :: iscanmm1 = 1
118 integer (c_int), private :: iscanmm2 = 2
119 integer (c_int), private :: iscandelim1 = 3
120 integer (c_int), private :: iscandd1 = 4
121 integer (c_int), private :: iscandd2 = 5
122 integer (c_int), private :: iscandelim2 = 6
123 integer (c_int), private :: iscanyyyy1 = 7
124 integer (c_int), private :: iscanyyyy2 = 10
125
126 character (len=14), private :: stime_format = "HH:MM:SS"
127 character (len=14), public :: sdefault_time_format = "HH:MM:SS"
128 integer (c_int), private :: iscanhour1 = 1
129 integer (c_int), private :: iscanhour2 = 2
130 integer (c_int), private :: iscanmin1 = 4
131 integer (c_int), private :: iscanmin2 = 5
132 integer (c_int), private :: iscansec1 = 7
133 integer (c_int), private :: iscansec2 = 8
134
135 !> Container for month name and length information
136
137 type month_t
138 character (len=3) :: sname ! Abbreviated name
139 character (len=9) :: sfullname ! Full month name
140 integer (c_int) :: istart ! Starting (Julian) date
141 integer (c_int) :: iend ! Ending (Julian) date
142 integer (c_int) :: imonth ! Month number (1-12)
143 integer (c_int) :: inumdays ! Max number of days in month
144 end type month_t
145
146 !> Month information
147
148 type ( month_t ), public, target :: months(12) = &
149 [ month_t( 'Jan','January ', 1, 31, 1, 31), &
150 month_t( 'Feb','February ', 32, 59, 2, 29), &
151 month_t( 'Mar','March ', 60, 90, 3, 31), &
152 month_t( 'Apr','April ', 91, 120, 4, 30), &
153 month_t( 'May','May ', 121, 151, 5, 31), &
154 month_t( 'Jun','June ', 152, 181, 6, 30), &
155 month_t( 'Jul','July ', 182, 212, 7, 31), &
156 month_t( 'Aug','August ', 213, 243, 8, 31), &
157 month_t( 'Sep','September', 244, 273, 9, 30), &
158 month_t( 'Oct','October ', 274, 304, 10, 31), &
159 month_t( 'Nov','November ', 305, 334, 11, 30), &
160 month_t( 'Dec','December ', 335, 365, 12, 31) ]
161
162contains
163
164!------------------------------------------------------------------------------
165
166subroutine set_default_date_format(sDateFormat)
167
168 character (len=*), intent(in) :: sDateFormat
169
170 sdefault_date_format = sdateformat
171
172end subroutine set_default_date_format
173
174!------------------------------------------------------------------------------
175
176subroutine set_default_time_format(sTimeFormat)
177
178 character (len=*), intent(in) :: sTimeFormat
179
180 sdefault_time_format = stimeformat
181
182end subroutine set_default_time_format
183
184!------------------------------------------------------------------------------
185
186subroutine set_date_format_indices(this, sDateFormat)
187
188 class(datetime_t), intent(inout) :: this
189 character (len=*), intent(in), optional :: sDateFormat
190
191 ! [ LOCALS ]
192 character (len=14) :: sDateFmt
193 character (len=6), parameter :: DELIMITERS = "/-_\. "
194
195 if(present(sdateformat) ) then
196 sdatefmt = sdateformat
197 sdate_format = sdateformat
198 else
199 sdatefmt = sdefault_date_format
200 sdate_format = sdefault_date_format
201 endif
202
203 iscanmm1 = scan(string=sdatefmt,set="Mm")
204 iscanmm2 = scan(string=sdatefmt,set="Mm", back=true )
205 iscandd1 = scan(string=sdatefmt,set="Dd")
206 iscandd2 = scan(string=sdatefmt,set="Dd", back=true )
207 iscanyyyy1 = scan(string=sdatefmt,set="Yy")
208 iscanyyyy2 = scan(string=sdatefmt,set="Yy", back=true )
209 iscandelim1 = scan(string=trim(sdatefmt), set=delimiters)
210 iscandelim2 = scan(string=trim(sdatefmt), set=delimiters, back=true)
211
212 call assert(iscanmm1 > 0 .and. iscanmm2 > 0 &
213 .and. iscandd1 > 0 .and. iscandd2 > 0 &
214 .and. iscanyyyy1 > 0 .and. iscanyyyy2 > 0, &
215 "Failed to properly parse the date format string "//dquote(sdateformat), &
216 __file__, __line__)
217 ! perhaps there are no delimiters? if not, these values CAN be zero
218! call assert(iScanDelim1 > 0 .and. iScanDelim2 > 0, &
219! "Failed to properly parse the delimiters in the date format string "//dquote(sDateFormat), &
220! __FILE__, __LINE__)
221
222end subroutine set_date_format_indices
223
224!------------------------------------------------------------------------------
225
226subroutine set_time_format_indices(this, sTimeFormat)
227
228 class(datetime_t), intent(inout) :: this
229 character (len=*), intent(in), optional :: sTimeFormat
230
231 ! [ LOCALS ]
232 character (len=14) :: sTimeFmt
233
234 if(present(stimeformat) ) then
235 stimefmt = stimeformat
236 stime_format = stimeformat
237 else
238 stimefmt = stime_format ! if no arg supplied, default to module variable
239 endif
240
241 iscanhour1 = scan(string=stimefmt,set="H")
242 iscanhour2 = scan(string=stimefmt,set="H", back=true )
243 iscanmin1 = scan(string=stimefmt,set="M")
244 iscanmin2 = scan(string=stimefmt,set="M", back=true )
245 iscansec1 = scan(string=stimefmt,set="S")
246 iscansec2 = scan(string=stimefmt,set="S", back=true )
247
248 call assert(iscanhour1 > 0 .and. iscanhour2 > 0 &
249 .and. iscanmin1 > 0 .and. iscanmin2 > 0 &
250 .and. iscansec1 > 0 .and. iscansec2 > 0, &
251 "Failed to properly parse the time format string "//dquote(stimeformat), &
252 __file__, __line__)
253
254end subroutine set_time_format_indices
255
256!------------------------------------------------------------------------------
257
258subroutine parse_text_to_date_sub(this, sString, sFilename, iLinenumber )
259
260 class(datetime_t), intent(inout) :: this
261 character (len=*), intent(in) :: sString
262 character (len=*), intent(in), optional :: sFilename
263 integer (c_int), intent(in), optional :: iLinenumber
264
265 ! [ LOCALS ]
266 integer (c_int) :: iStat
267 integer (c_int) :: iMonth
268 integer (c_int) :: iDay
269 integer (c_int) :: iYear
270 integer (c_int) :: iMonthOffset, iDayOffset
271 character (len=256) :: sStr
272 character (len=256) :: sMonth, sDay, sYear, sBuf
273 character (len=256) :: sFilename_l
274 integer (c_int) :: iLinenumber_l
275
276 if ( present( sfilename) ) then
277 sfilename_l = sfilename
278 else
279 sfilename_l = "<unknown>"
280 endif
281
282 if ( present( ilinenumber ) ) then
283 ilinenumber_l = ilinenumber
284 else
285 ilinenumber_l = -9999
286 endif
287
288 ! these offset amounts have value of 1 if the program detects a single-digit date value
289 imonthoffset = 0; idayoffset = 0
290
291 sstr = trim(adjustl(sstring))
292
293 smonth = sstr(iscanmm1 : iscanmm2 )
294 sbuf = clean(smonth)
295 if(len_trim(sbuf) /= len_trim(smonth)) then ! we have a case where there is no leading zero
296 imonthoffset = 1
297 smonth = trim(sbuf)
298 endif
299 read(smonth,fmt=*, iostat = istat) imonth
300
301 if ( .not. (istat==0 .and. (imonth > 0 .and. imonth <= 12) ) ) then
302
303 call assert(false, &
304 "Error parsing month value. Parsed value: "//squote(smonth)//";"// &
305 " input date text: "//trim(sstr), __file__, __line__, sfilename_l, ilinenumber_l )
306
307 endif
308
309 sday = sstr( iscandd1 - imonthoffset : iscandd2 -imonthoffset )
310 sbuf = clean(sday)
311 if(len_trim(sbuf) /= len_trim(sday)) then ! we have a case where there is no leading zero
312 idayoffset = 1
313 sday = trim(sbuf)
314 endif
315 read(sday, fmt=*, iostat = istat) iday
316
317 if ( .not. (istat==0 .and. (iday > 0 .and. iday <= 31) ) ) then
318
319 call assert(false, &
320 "Error parsing day value. Parsed value: "//trim(sday)//";"// &
321 " input date text: "//trim(sstr),sfilename_l, ilinenumber_l, __file__, __line__ )
322
323 endif
324
325 syear = sstr( iscanyyyy1 - imonthoffset - idayoffset: iscanyyyy2 - imonthoffset - idayoffset)
326 read(syear,fmt=*, iostat = istat) iyear
327
328 if ( istat/=0 ) then
329
330 call assert(false, &
331 "Error parsing year value. Parsed value: "//trim(syear)//";"// &
332 " input date text: "//trim(sstr),sfilename_l, ilinenumber_l, __file__, __line__ )
333
334 endif
335
336 this%iMonth = imonth
337 this%iYear = iyear
338 this%iDay = iday
339
340 this%dJulianDate = julian_day( imonth=imonth, iday=iday, iyear=iyear )
341
342end subroutine parse_text_to_date_sub
343
344!------------------------------------------------------------------------------
345
346subroutine parse_text_to_time_sub(this, sString)
347
348 class(datetime_t), intent(inout) :: this
349 character (len=*), intent(in) :: sString
350
351
352 ! [ LOCALS ]
353 integer (c_int) :: iStat
354 integer (c_int) :: iHour
355 integer (c_int) :: iMinute
356 integer (c_int) :: iSecond
357 integer (c_int) :: iOffset
358
359 character (len=256) :: sHour, sMinute, sSecond
360
361
362 character (len=256) :: sTimeFmt
363 character (len=256) :: sStr
364 character (len=256) :: sBuf
365
366 ioffset = 0
367
368 sstr = trim(adjustl(sstring))
369
370 shour = sstr( iscanhour1 : iscanhour2 )
371
372 sbuf = clean(shour)
373 if(len_trim(sbuf) /= len_trim(shour)) then ! we have a case where there is no leading zero
374 ioffset = 1
375 shour = trim(sbuf)
376 endif
377 read(shour,fmt=*, iostat = istat) ihour
378 call assert(istat==0, "Error parsing hour value - got "//trim(shour)//";"// &
379 " time text: "//trim(sstr), __file__,__line__)
380
381 sminute = sstr(iscanmin1 - ioffset : iscanmin2 - ioffset )
382 read(sminute,fmt=*, iostat = istat) iminute
383 call assert(istat==0, "Error parsing minutes value - got "//trim(sminute)//";"// &
384 " time text: "//trim(sstr), __file__,__line__)
385
386 if(iscansec1 /= 0) then
387 ssecond = sstr(iscansec1 - ioffset : iscansec2 - ioffset )
388 read(ssecond,fmt=*, iostat = istat) isecond
389 call assert(istat==0, "Error parsing hour value - got "//trim(ssecond)//";"// &
390 " time text: "//trim(sstr), __file__,__line__)
391 else
392 isecond = 0
393 endif
394
395 this%iHour = ihour
396 this%iMinute = iminute
397 this%iSecond = isecond
398
399 this%dJulianDate = this%dJulianDate + real( ihour, c_double) / 24.0_c_double &
400 + real( iminute, c_double) / 1440.0_c_double &
401 + real( isecond, c_double) / 86400.0_c_double
402
403 this%iJulianDay = int(this%dJulianDate, c_long)
404
405end subroutine parse_text_to_time_sub
406
407!--------------------------------------------------------------------------
408
409subroutine calc_water_year_sub(this)
410
411 class(datetime_t) :: this
412
413 if(this%iMonth > 9) then
414 this%iWaterYearHigh = this%iYear + 1
415 else
416 this%iWaterYearHigh = &
417 this%iYear
418 end if
419
420 if(this%iMonth < 4) then
421 this%iWaterYearLow = this%iYear - 1
422 else
423 this%iWaterYearLow = this%iYear
424 endif
425
426end subroutine calc_water_year_sub
427
428!--------------------------------------------------------------------------
429
430! subroutine populate_julian_day_sub(this, iMonth, iDay, iYear, &
431! iHour, iMinute, iSecond)
432!
433! class (DATETIME_T) :: this
434! integer (c_int), intent(in) :: iMonth
435! integer (c_int), intent(in) :: iDay
436! integer (c_int), intent(in) :: iYear
437! integer (c_int), intent(in) :: iHour
438! integer (c_int), intent(in) :: iMinute
439! integer (c_int), intent(in) :: iSecond
440!
441! ! [LOCALS]
442! ! integer (c_int) :: iJulianDay
443! ! real (c_double) :: rFractionOfDay
444!
445! this%iMonth = iMonth
446! this%iDay = iDay
447! this%iYear = iYear
448! this%iHour = iHour
449! this%iMinute = iMinute
450! this%iSecond = iSecond
451!
452! ! this%iJulianDay = julian_day( this%iYear, this%iMonth, this%iDay)
453! this%iJulianDay = julian_day( int(this%iYear, c_int), &
454! int(this%iMonth, c_int), &
455! int(this%iDay, c_int))
456!
457! this%rFractionOfDay = real(this%iHour, c_double) / 24_c_double + &
458! real(this%iMinute, c_double) / 1440_c_double + &
459! real(this%iSecond, c_double) / 86400_c_double
460!
461! ! this%rJulianDay = real(iJulianDay, c_double) + rFractionOfDay !&
462! ! - 2400000.5_c_double
463!
464! ! 2400000.5 is subtracted to yield one definition of a "MODIFIED JUILAN DAY"
465!
466! end subroutine populate_julian_day_sub
467
468!--------------------------------------------------------------------------
469
470subroutine calc_julian_day_sub(this, iMonth, iDay, iYear, &
471 iHour, iMinute, iSecond)
472
473 class(datetime_t) :: this
474 integer (c_int), intent(in), optional :: iMonth
475 integer (c_int), intent(in), optional :: iDay
476 integer (c_int), intent(in), optional :: iYear
477 integer (c_int), intent(in), optional :: iHour
478 integer (c_int), intent(in), optional :: iMinute
479 integer (c_int), intent(in), optional :: iSecond
480
481 if(present(imonth) ) this%iMonth = imonth
482 if(present(iday) ) this%iDay = iday
483 if(present(iyear) ) this%iYear = iyear
484 if(present(ihour) ) this%iHour = ihour
485 if(present(iminute) ) this%iMinute = iminute
486 if(present(isecond) ) this%iSecond = isecond
487
488 this%dJulianDate = real( julian_day( int(this%iYear, c_int), &
489 int(this%iMonth, c_int), &
490 int(this%iDay, c_int) ), c_double) + &
491 real(this%iHour, c_double) / 24._c_double + &
492 real(this%iMinute, c_double) / 1440._c_double + &
493 real(this%iSecond, c_double) / 86400._c_double
494
495! this%rJulianDay = real(iJulianDay, c_double) + rFractionOfDay ! - 2400000.5_c_double
496
497 this%iJulianDay = int(this%dJulianDate, c_long)
498
499end subroutine calc_julian_day_sub
500
501!--------------------------------------------------------------------------
502
503 subroutine calc_gregorian_date_sub(this)
504
505 class(datetime_t), intent(inout) :: this
506
507 ! [ LOCALS ]
508 integer (c_int) :: iMonth
509 integer (c_int) :: iDay
510 integer (c_int) :: iYear
511 integer (c_int) :: iHour
512 integer (c_int) :: iMinute
513 integer (c_int) :: iSecond
514 integer (c_int) :: iJulianDay
515
516 real(c_double) :: rHour, rMinute, rSecond
517
518 ijulianday = this%getJulianDay()
519
520 call gregorian_date( ijulianday, iyear, imonth, iday )
521
522 this%iYear = iyear
523 this%iMonth = imonth
524 this%iDay = iday
525
526 rhour = this%getFractionOfDay() * 24._c_double
527 ihour = int(rhour, c_int)
528
529! rMinute = (rHour - real(iHour, c_float) ) * 1440_c_double
530 rminute = (rhour - real(ihour, c_double) ) * 60._c_double
531 iminute = int(rminute, c_int)
532
533! rSecond = ( rMinute - real(iMinute, c_float) ) * 86400_c_double
534 rsecond = ( rminute - real(iminute, c_double) ) * 60._c_double
535 isecond = int(rsecond, c_int)
536
537 this%iHour = ihour
538 this%iMinute = iminute
539 this%iHour = isecond
540
541end subroutine calc_gregorian_date_sub
542
543!!***
544
545!--------------------------------------------------------------------------
546!!****f* types/gregorian_date
547! NAME
548! gregorian_date - Convert from a Julian day number to a Gregorian date.
549!
550! SYNOPSIS
551! Conversion to a Gregorian calendar date from a Julian date.
552! Valid for any Gregorian calendar date producing a Julian day number
553! greater than zero.
554!
555! INPUTS
556! iJD integer number of days that have elapsed since noon
557! Greenwich Mean Time (UT or TT) Monday, January 1, 4713 BC
558! OUTPUTS
559! iYear 4-digit year
560! iMonth 2-digit month (1-12)
561! iDay 2-digit day (1-31)
562!
563! NOTES
564! Reference: Fliegel, H. F. and van Flandern, T. C. (1968).
565! Communications of the ACM, Vol. 11, No. 10 (October, 1968).
566! Modified from code found at:
567! http://aa.usno.navy.mil/faq/docs/JD_Formula.html
568!
569! SOURCE
570
571 subroutine gregorian_date(iJD, iYear, iMonth, iDay, iOrigin)
572
573!! COMPUTES THE GREGORIAN CALENDAR DATE (YEAR,MONTH,DAY)
574!! GIVEN THE JULIAN DATE (JD).
575
576 ! [ ARGUMENTS ]
577 integer (c_int), value :: ijd
578 integer (c_int), intent(inout) :: iyear, imonth, iday
579 integer (c_int), intent(in), optional :: iorigin
580 ! [ LOCALS ]
581 integer (c_int) ii,ij,ik,il,in
582 integer (c_int) :: ioffset
583
584 if(present(iorigin)) then
585 ioffset = iorigin
586 else
587 ioffset = 0
588 endif
589
590 ! allow for an alternate "origin" to be specified... technically,
591 ! this is no longer a "Julian" day, but alas... This modification
592 ! was required in order to process the "time" variables from global
593 ! climate models, which seem to be defined as something like this:
594 ! time:units = "days since 1960-01-01 00:00:00"
595 !
596 ! for the above example, JD = 2436935 on the first day; the NetCDF "time"
597 ! variable will be equal to 0. Thus, in order to get the conversion
598 ! right, we must add 0 + 2436935 to yield a true Julian Day.
599
600 ijd = ijd + ioffset
601
602 il= ijd + 68569_c_int
603 in= 4*il / 146097_c_int
604 il= il - (146097_c_int * in + 3_c_int)/4_c_int
605 ii= 4000_c_int * (il + 1_c_int) / 1461001_c_int
606 il= il - 1461_c_int * ii / 4_c_int + 31_c_int
607 ij= 80_c_int * il / 2447_c_int
608 ik= il - 2447_c_int * ij / 80_c_int
609 il= ij / 11_c_int
610 ij= ij + 2_c_int - 12_c_int * il
611 ii= 100_c_int * (in - 49_c_int) + ii + il
612
613 iyear = ii
614 imonth = ij
615 iday = ik
616
617end subroutine gregorian_date
618
619
620!--------------------------------------------------------------------------
621!!****f* types/julian_day
622! NAME
623! julian_day - Convert from a Gregorian calendar date to a Julian day number.
624!
625! SYNOPSIS
626! Conversion from a Gregorian calendar date to a Julian day number.
627! Valid for any Gregorian calendar date producing a Julian day
628! greater than zero.
629!
630! INPUTS
631! iYear 4-digit year
632! iMonth 2-digit month (1-12)
633! iDay 2-digit day (1-31)
634!
635! OUTPUTS
636! iJD integer number of days that have elapsed since noon
637! Greenwich Mean Time (UT or TT) Monday, January 1, 4713 BC
638!
639! SOURCE
640
641function julian_day ( iYear, iMonth, iDay, iOrigin, sInputItemName ) result(iJD)
642
643 ! [ ARGUMENTS ]
644 integer (c_int), intent(in) :: iyear, imonth, iday
645 integer (c_int), optional :: iorigin
646 character (len=*), optional :: sinputitemname
647
648
649 ! [ LOCALS ]
650 integer (c_int) i,j,k
651 integer (c_int) :: ioffset
652 character (len=256) :: sbuf
653 character (len=:), allocatable :: sinputitemname_
654 logical (c_bool) :: illegal_month, illegal_day
655
656 ! [ RETURN VALUE ]
657 integer (c_int) :: ijd
658 sbuf = ""
659
660 illegal_month = false
661 illegal_day = false
662
663 if (present(sinputitemname)) then
664 sinputitemname_ = trim(sinputitemname)
665 else
666 sinputitemname_ = "unspecified"
667 endif
668
669 i= iyear
670 j= imonth
671 k= iday
672
673 select case ( imonth )
674
675 case (1, 3, 5, 7, 8, 10, 12)
676
677 if ( iday < 1 .or. iday > 31 ) illegal_day = true
678
679 case (2)
680
681 if ( isleap( iyear) ) then
682 if ( iday < 1 .or. iday > 29 ) illegal_day = true
683 else
684 if ( iday < 1 .or. iday > 28 ) illegal_day = true
685 endif
686 case (4, 6, 9, 11)
687
688 if ( iday < 1 .or. iday > 31 ) illegal_day = true
689
690 case default
691
692 illegal_month = true
693
694 end select
695
696 if(present(iorigin)) then
697 ioffset = iorigin
698 else
699 ioffset = 0
700 endif
701
702 ijd= ( k-32075_c_int + 1461_c_int * (i + 4800_c_int + (j - 14_c_int) / 12_c_int) &
703 /4_c_int + 367_c_int * (j - 2_c_int - (j - 14_c_int)/ 12_c_int * 12_c_int) &
704 /12_c_int - 3_c_int *((i + 4900_c_int + (j - 14_c_int) &
705 /12_c_int)/100_c_int)/4_c_int ) - ioffset
706
707 if ( illegal_month .or. illegal_day ) then
708! call LOGS%write(" ** there was a problem converting month, day, year values to a Julian date **", &
709! iLinesBefore=2, iLogLevel=LOG_ALL, lEcho=TRUE, iTab=5)
710 call logs%write("month value: " + as_character(imonth), itab=16)
711 call logs%write("day value: " + as_character(iday), itab=18)
712 call logs%write("year value: " + as_character(iyear), itab=17)
713 call logs%write("input type: " + sinputitemname_, ilinesafter=1, itab=17)
714
715 sbuf = "there was a problem converting month, day, year values to a Julian date: "
716
717 if ( illegal_month) sbuf = adjustl(trim(sbuf) + " month value is illegal. ")
718 if ( illegal_day) sbuf = adjustl(trim(sbuf) + " day value is illegal.")
719
720 call assert( false, trim(sbuf), __file__, __line__)
721
722 ! will never get here normally, but for unit testing purposes, return some nonsensical value
723 ijd = itinyval
724
725 endif
726
727end function julian_day
728
729!------------------------------------------------------------------------------
730
731 function is_date_greater_than(date1, date2) result(lResult)
732
733 type(datetime_t), intent(in) :: date1
734 type(datetime_t), intent(in) :: date2
735
736 ! [ LOCALS ]
737 logical(c_bool ) :: lresult
738
739 lresult = false
740
741! if(date2%iJulianDay == date1%iJulianDay &
742! .and. date1%rFractionOfDay > date2%rFractionOfDay) then
743! lResult = TRUE
744! elseif(date1%iJulianDay > date2%iJulianDay) then
745! lResult = TRUE
746! endif
747
748 if( date1%dJulianDate > date2%dJulianDate ) lresult = true
749
750end function is_date_greater_than
751
752!------------------------------------------------------------------------------
753
754 function is_date_less_than(date1, date2) result(lResult)
755
756 class(datetime_t), intent(in) :: date1
757 class(datetime_t), intent(in) :: date2
758
759 ! [ LOCALS ]
760 logical(c_bool ) :: lresult
761
762 lresult = false
763
764! if(date1%iJulianDay == date2%iJulianDay &
765! .and. date1%rFractionOfDay < date2%rFractionOfDay) then
766! lResult = TRUE
767! elseif(date1%iJulianDay < date2%iJulianDay) then
768! lResult = TRUE
769! endif
770
771 if( date1%dJulianDate < date2%dJulianDate ) lresult = true
772
773end function is_date_less_than
774
775!------------------------------------------------------------------------------
776
777 function is_date_lt_or_equal_to(date1, date2) result(lResult)
778
779 class( datetime_t ), intent(in) :: date1
780 type ( datetime_t ), intent(in) :: date2
781
782 ! [ LOCALS ]
783 logical(c_bool ) :: lresult
784
785 lresult = false
786
787 if( date1%dJulianDate <= date2%dJulianDate ) lresult = true
788
789end function is_date_lt_or_equal_to
790
791!------------------------------------------------------------------------------
792
793 function is_date_gt_or_equal_to(date1, date2) result(lResult)
794
795 class( datetime_t), intent(in) :: date1
796 type ( datetime_t), intent(in) :: date2
797
798 ! [ LOCALS ]
799 logical(c_bool ) :: lresult
800
801 lresult = false
802
803 if( date1%dJulianDate >= date2%dJulianDate ) lresult = true
804
805end function is_date_gt_or_equal_to
806
807!------------------------------------------------------------------------------
808
809 function is_date_equal_to(date1, date2) result(lResult)
810
811 class(datetime_t), intent(in) :: date1
812 class(datetime_t), intent(in) :: date2
813
814 ! [ LOCALS ]
815 logical(c_bool ) :: lresult
816
817 lresult = false
818
819 if( date1%getJulianDay() == date2%getJulianDay() .and. &
820 date1%iHour == date2%iHour .and. &
821 date1%iMinute == date2%iMinute .and. &
822 date1%iSecond == date2%iSecond) then
823
824 lresult = true
825
826 endif
827
828end function is_date_equal_to
829
830!------------------------------------------------------------------------------
831
832function count_leap_days_between_dates(date_min, date_max) result(iCount)
833
834 class(datetime_t), intent(in) :: date_min
835 class(datetime_t), intent(in) :: date_max
836
837 integer (c_int) :: inumyears
838 integer (c_int) :: icount
839
840 ! [ LOCALS ]
841 integer (c_int) :: year_value
842
843 icount = 0
844
845 inumyears = date_max%iYear - date_min%iYear
846
847 if (inumyears == 0) then
848
849 if (( date_min%isLeapYear() .and. &
850 (date_min%iMonth <= 2 .and. date_min%iDay <= 28)) &
851 .and. ((date_max%iMonth == 2 .and. date_min%iDay > 28) .or. date_max%iMonth >=3)) &
852 icount = 1
853
854 elseif (inumyears > 0) then
855
856 if ( date_min%isLeapYear() .and. &
857 (date_min%iMonth == 1 .or. ( date_min%iMonth == 2 .and. date_min%iDay <= 28))) &
858 icount = 1
859
860 if ( date_max%isLeapYear() .and. &
861 (date_max%iMonth > 2 .or. ( date_max%iMonth == 2 .and. date_max%iDay > 28))) &
862 icount = icount + 1
863
864 endif
865
866 if (inumyears >=3) then
867
868 do year_value=date_min%iYear+1, date_max%iYear-1
869
870 if (isleap(year_value)) icount = icount + 1
871
872 enddo
873
874 endif
875
876end function count_leap_days_between_dates
877
878!------------------------------------------------------------------------------
879
880subroutine assign_value_to_sub( date2, date1 )
881
882 type(datetime_t), intent(out) :: date2
883 type(datetime_t), intent(in) :: date1
884
885 date2%iMonth = date1%iMonth
886 date2%iDay = date1%iDay
887 date2%iYear = date1%iYear
888 date2%iHour = date1%iHour
889 date2%iMinute = date1%iMinute
890 date2%iSecond = date1%iSecond
891 date2%iWaterYearHigh = date1%iWaterYearHigh
892 date2%iWaterYearLow = date1%iWaterYearLow
893 date2%dJulianDate = date1%dJulianDate
894 date2%iJulianDay = date1%iJulianDay
895
896end subroutine assign_value_to_sub
897
898!------------------------------------------------------------------------------
899
900 function date_minus_date_fn(date1, date2) result(rDelta)
901
902 class(datetime_t), intent(in) :: date1
903 class(datetime_t), intent(in) :: date2
904 real (c_double) :: rdelta
905
906 rdelta = date1%dJulianDate - date2%dJulianDate
907
908end function date_minus_date_fn
909
910!------------------------------------------------------------------------------
911
912 function date_plus_float_fn(date1, fValue) result(newdate)
913
914 class(datetime_t), intent(in) :: date1
915 real (c_float), intent(in) :: fvalue
916 type(datetime_t), allocatable :: newdate
917
918 allocate( newdate )
919 newdate%dJulianDate = date1%dJulianDate + real( fvalue, c_double)
920 newdate%iJulianDay = int(newdate%dJulianDate, c_long)
921 call newdate%calcGregorianDate()
922
923end function date_plus_float_fn
924
925!------------------------------------------------------------------------------
926
927 function date_minus_float_fn(date1, fValue) result(newdate)
928
929 class(datetime_t), intent(in) :: date1
930 real (c_float), intent(in) :: fvalue
931 type(datetime_t), allocatable :: newdate
932
933 allocate( newdate )
934 newdate%dJulianDate = date1%dJulianDate - real( fvalue, c_double)
935 newdate%iJulianDay = int(newdate%dJulianDate, c_long)
936 call newdate%calcGregorianDate()
937
938end function date_minus_float_fn
939
940!-------------------------------------------------------------------------------
941
942 function date_minus_int_fn(date1, iValue) result(newdate)
943
944 class(datetime_t), intent(in) :: date1
945 integer (c_int), intent(in) :: ivalue
946 type(datetime_t), allocatable :: newdate
947
948 allocate( newdate )
949 newdate%dJulianDate = date1%dJulianDate - real( ivalue, c_double)
950 newdate%iJulianDay = int(newdate%dJulianDate, c_long)
951 call newdate%calcGregorianDate()
952
953end function date_minus_int_fn
954
955!------------------------------------------------------------------------------
956
957function write_pretty_datetime_fn(this) result(sDateTimeText)
958
959 class(datetime_t) :: this
960 character (len=20) :: sdatetimetext
961
962 write(sdatetimetext, fmt="(a3,' ',i2.2,' ',i4.4, 1x, i2.2,':',i2.2,':',i2.2)") &
963 months(this%iMonth)%sName, this%iDay, this%iYear, this%iHour, this%iMinute, this%iSecond
964
965end function write_pretty_datetime_fn
966
967!------------------------------------------------------------------------------
968
969function write_pretty_date_fn(this) result(sDateText)
970
971 class(datetime_t) :: this
972 character (len=10) :: sdatetext
973
974 write(sdatetext, fmt="(i4.4,'-',i2.2,'-',i2.2)") &
975 this%iYear, this%iMonth, this%iDay
976
977end function write_pretty_date_fn
978
979!------------------------------------------------------------------------------
980
981function write_list_date_fn(this) result(sDateText)
982
983 class(datetime_t) :: this
984 character (len=10) :: sdatetext
985
986 ! [ LOCALS ]
987 integer (c_int), dimension(5) :: istat
988! sDateText = this%listdatetime()
989
990 write(sdatetext(iscanmm1:iscanmm2),fmt="(i2.2)", iostat=istat(1)) this%iMonth
991 write(sdatetext(iscandd1:iscandd2),fmt="(i2.2)", iostat=istat(2)) this%iDay
992 write(sdatetext(iscanyyyy1:iscanyyyy2),fmt="(i4.4)",iostat=istat(3)) this%iYear
993 if(iscandelim1 > 0) write(sdatetext(iscandelim1:iscandelim1), &
994 fmt="(a1)",iostat=istat(4)) &
995 sdate_format(iscandelim1:iscandelim1)
996 if(iscandelim2 > 0) write(sdatetext(iscandelim2:iscandelim2), &
997 fmt="(a1)",iostat=istat(5)) &
998 sdate_format(iscandelim2:iscandelim2)
999
1000 call assert(all(istat==0),"Problem parsing the date format '"// &
1001 trim(sdate_format)//"' for output", &
1002 __file__, __line__)
1003
1004end function write_list_date_fn
1005
1006!------------------------------------------------------------------------------
1007
1008function write_list_time_fn(this) result(sTimeText)
1009
1010 class(datetime_t) :: this
1011 character (len=8) :: stimetext
1012
1013 write(stimetext,fmt="(i2.2,':',i2.2':',i2.2)") this%iHour, this%iMinute, this%iSecond
1014
1015end function write_list_time_fn
1016
1017!------------------------------------------------------------------------------
1018
1019function write_list_datetime_fn(this) result(sDatetimeText)
1020
1021 class(datetime_t) :: this
1022! character(len=*), optional :: sDateFormat
1023! logical (c_bool), optional :: lDateOnly
1024 character (len=19) :: sdatetimetext
1025
1026 ! [ LOCALS ]
1027! character(len=25) sDateFmt
1028! integer (c_int) :: iScanMM1, iScanMM2
1029! integer (c_int) :: iScanDD1, iScanDD2
1030! integer (c_int) :: iScanYYYY1, iScanYYYY2
1031! integer (c_int) :: iScanDelim1, iScanDelim2
1032 character (len=32) :: sbuf
1033! character (len=6), parameter :: DELIMITERS = "/-_\. "
1034 integer (c_int), dimension(5) :: istat
1035! logical (c_bool) lListTime
1036
1037 sdatetimetext = ""
1038
1039! if(present(sDateFormat)) then
1040! sDateFmt = uppercase(trim(adjustl(sDateFormat)))
1041! else
1042! sDateFmt = "MM/DD/YYYY"
1043! endif
1044
1045! if(present(lDateOnly)) then
1046! lListTime = .not. lDateOnly
1047! else
1048! lListTime = TRUE
1049! endif
1050
1051! iScanMM1 = scan(string=sDateFmt,set="M")
1052! iScanMM2 = scan(string=sDateFmt,set="M", back=TRUE )
1053
1054! iScanDD1 = scan(string=sDateFmt,set="D")
1055! iScanDD2 = scan(string=sDateFmt,set="D", back=TRUE )
1056
1057! iScanYYYY1 = scan(string=sDateFmt,set="Y")
1058! iScanYYYY2 = scan(string=sDateFmt,set="Y", back=TRUE )
1059
1060! iScanDelim1 = scan(string=trim(sDateFmt), set=DELIMITERS)
1061! iScanDelim2 = scan(string=trim(sDateFmt), set=DELIMITERS, back=TRUE)
1062
1063 write(sdatetimetext(iscanmm1:iscanmm2),fmt="(i2.2)", iostat=istat(1)) this%iMonth
1064 write(sdatetimetext(iscandd1:iscandd2),fmt="(i2.2)", iostat=istat(2)) this%iDay
1065 write(sdatetimetext(iscanyyyy1:iscanyyyy2),fmt="(i4.4)",iostat=istat(3)) this%iYear
1066 if(iscandelim1 > 0) write(sdatetimetext(iscandelim1:iscandelim1), &
1067 fmt="(a1)",iostat=istat(4)) &
1068 sdate_format(iscandelim1:iscandelim1)
1069 if(iscandelim2 > 0) write(sdatetimetext(iscandelim2:iscandelim2), &
1070 fmt="(a1)",iostat=istat(5)) &
1071 sdate_format(iscandelim2:iscandelim2)
1072
1073 call assert(all(istat==0),"Problem parsing the date format '"// &
1074 trim(sdate_format)//"' for output", &
1075 __file__, __line__)
1076
1077 write(sbuf,fmt="(1x,i2.2,':',i2.2':',i2.2)") this%iHour, this%iMinute, this%iSecond
1078
1079! if(lListTime) then
1080 sdatetimetext = trim(sdatetimetext) // trim(sbuf)
1081! else
1082! sDateTimeText = trim(sDateTimeText)
1083! endif
1084
1085end function write_list_datetime_fn
1086
1087!------------------------------------------------------------------------------
1088
1089subroutine system_time_to_date_sub(this)
1090
1091 class(datetime_t) :: this
1092
1093 ! [ LOCALS ]
1094 character (len=16) :: sDateText
1095 character (len=16) :: sTimeText
1096 integer (c_int), dimension(8) :: iValues
1097
1098 call date_and_time(sdatetext, stimetext)
1099 call date_and_time(values = ivalues)
1100
1101 call this%setDateFormat("YYYYMMDD")
1102 call this%setTimeFormat("HHMMSS")
1103
1104 call this%parseDate(sdatetext)
1105 call this%parseTime(stimetext)
1106 call this%calcJulianDay()
1107 this%dJulianDate = this%dJulianDate + &
1108 (real(ivalues(8), c_double) / 86400_c_double / 1000_c_double) ! milliseconds
1109
1110 call this%setDateFormat()
1111 call this%setTimeFormat()
1112
1113end subroutine system_time_to_date_sub
1114
1115
1116!--------------------------------------------------------------------------
1117
1118!> \brief Return the number of days in the given year.
1119!!
1120!! This function simply returns the number of days given the current year.
1121!function day_of_year(iJulianDay) result(iDOY)
1122
1123! integer (c_int), intent(in) :: iJulianDay
1124
1125 ! [ LOCALS ]
1126! integer (c_int) :: iFirstDay, iCurrDay, iDOY
1127! integer (c_int) :: iYear, iMonth, iDay
1128
1129 ! first get the value for the current year
1130! call gregorian_date(iJulianDay, iYear, iMonth, iDay)
1131
1132 ! now calculate the Julian day for the first of the year
1133! iFirstDay = julian_day ( iYear, 1, 1 )
1134
1135 ! return the current day of the year
1136! iDOY = iJulianDay - iFirstDay + 1
1137
1138! return
1139
1140!end function day_of_year
1141
1142!--------------------------------------------------------------------------
1143!!****f* types/solstice
1144! NAME
1145! solstice - Returns 0 normally, or a value >0 during solstice or equinox.
1146!
1147! SYNOPSIS
1148! Returns the following:
1149! 0: non-solstice and non-equinox day
1150! 1: Vernal equinox
1151! 2: Summer Solstice
1152! 3: Autumnal equinox
1153! 4: Winter solstice
1154!
1155! INPUTS
1156! iJD Julian day value
1157!
1158! OUTPUTS
1159! iSol Code as described above
1160!
1161! SOURCE
1162
1163!function solstice (iJD) result (iSol)
1164
1165 ! [ ARGUMENTS ]
1166! integer (c_int), intent(in) :: iJD
1167
1168 ! [ LOCALS ]
1169! integer (c_int) iMonth, iDay, iYear
1170
1171
1172! ! [ RETURN VALUE ]
1173! integer (c_int) :: iSol
1174
1175! call gregorian_date(iJD, iYear, iMonth, iDay)
1176
1177! if(iMonth==3 .and. iDay == 20) then
1178! iSol = 1
1179! elseif(iMonth==6 .and. iDay == 21) then
1180! iSol = 2
1181! elseif(iMonth==9 .and. iDay == 22) then
1182! iSol = 3
1183! elseif(iMonth==12 .and. iDay == 21) then
1184! iSol = 4
1185! else
1186! iSol = 0
1187! endif
1188!
1189! return
1190!
1191!end function solstice
1192
1193!------------------------------------------------------------------------------
1194
1195 subroutine set_julian_date_sub(this, dValue)
1196
1197 class(datetime_t), intent(inout) :: this
1198 real (c_double), intent(in) :: dValue
1199
1200 this%dJulianDate = dvalue
1201 this%iJulianDay = int(dvalue, c_long)
1202
1203 call this%calcGregorianDate()
1204
1205end subroutine set_julian_date_sub
1206
1207!------------------------------------------------------------------------------
1208
1209 function get_julian_day_fn(this) result(iJulianDay)
1210
1211 class(datetime_t), intent(in) :: this
1212 integer (c_int) :: ijulianday
1213
1214 ijulianday = int(this%dJulianDate, c_int)
1215
1216end function get_julian_day_fn
1217
1218!------------------------------------------------------------------------------
1219
1220 function get_fraction_of_day_fn(this) result(dFractionOfDay)
1221
1222 class(datetime_t), intent(in) :: this
1223 real (c_double) :: dfractionofday
1224
1225 dfractionofday = this%dJulianDate - real( int(this%dJulianDate, c_long ), c_double)
1226
1227end function get_fraction_of_day_fn
1228
1229!------------------------------------------------------------------------------
1230
1231function get_days_in_month_fn(this) result(iDaysInMonth)
1232
1233 class(datetime_t) :: this
1234 integer (c_int) :: idaysinmonth
1235
1236 ! [ LOCALS ]
1237 integer (c_int), dimension(12), parameter :: inumberofdaysinmonth = &
1238 [31,28,31,30,31,30,31,31,30,31,30,31]
1239
1240 idaysinmonth = inumberofdaysinmonth(this%iMonth)
1241
1242 if (this%isLeapYear() ) then
1243 idaysinmonth = max(idaysinmonth, 29)
1244 endif
1245
1246end function get_days_in_month_fn
1247
1248!------------------------------------------------------------------------------
1249
1250function get_days_in_year_fn(this) result(iDaysInYear)
1251
1252 class(datetime_t) :: this
1253 integer (c_int) :: idaysinyear
1254
1255 if (this%isLeapYear() ) then
1256 idaysinyear = 366
1257 else
1258 idaysinyear = 365
1259 endif
1260
1261end function get_days_in_year_fn
1262
1263!------------------------------------------------------------------------------
1264
1265subroutine date_plus_year_sub(this)
1266
1267 class(datetime_t) :: this
1268
1269! this%iYear = this%iYear + 1_c_int
1270! call this%calcJulianDay()
1271
1272 this%dJulianDate = this%dJulianDate + 365.25_c_double
1273 this%iJulianDay = int(this%dJulianDate, c_long)
1274 call this%calcGregorianDate()
1275
1276end subroutine date_plus_year_sub
1277
1278!------------------------------------------------------------------------------
1279
1280subroutine date_set_day_sub(this, newday)
1281
1282 class(datetime_t) :: this
1283 integer (c_int), intent(in) :: newday
1284
1285 this%iDay = newday
1286 call this%calcJulianDay()
1287
1288end subroutine date_set_day_sub
1289
1290!------------------------------------------------------------------------------
1291
1292subroutine date_set_month_sub(this, newmonth)
1293
1294 class(datetime_t) :: this
1295 integer (c_int), intent(in) :: newmonth
1296
1297 this%iMonth = newmonth
1298 call this%calcJulianDay()
1299
1300end subroutine date_set_month_sub
1301
1302!------------------------------------------------------------------------------
1303
1304subroutine date_set_year_sub(this, newyear)
1305
1306 class(datetime_t) :: this
1307 integer (c_int), intent(in) :: newyear
1308
1309 this%iYear = newyear
1310 call this%calcJulianDay()
1311
1312end subroutine date_set_year_sub
1313
1314!------------------------------------------------------------------------------
1315
1316subroutine date_advance_to_last_day_of_month_sub(this)
1317
1318 class(datetime_t) :: this
1319
1320 this%iDay = 1_c_int
1321
1322 if (this%iMonth < 12) then
1323 this%iMonth = this%iMonth + 1
1324 else
1325 this%iMonth = 1
1326 this%iYear = this%iYear + 1
1327 endif
1328
1329 call this%calcJulianDay()
1330
1331 ! now step back a day to obtain the date for the last day of the month
1332 this%dJulianDate = this%dJulianDate - 1.0_c_double
1333 this%iJulianDay = int(this%dJulianDate, c_long)
1334 call this%calcGregorianDate()
1335
1336end subroutine date_advance_to_last_day_of_month_sub
1337
1338!------------------------------------------------------------------------------
1339
1340subroutine date_minus_year_sub(this)
1341
1342 class(datetime_t) :: this
1343
1344! this%iYear = this%iYear - 1_c_int
1345! call this%calcJulianDay()
1346
1347 this%dJulianDate = this%dJulianDate - 365.25_c_double
1348 this%iJulianDay = int(this%dJulianDate, c_long)
1349 call this%calcGregorianDate()
1350
1351end subroutine date_minus_year_sub
1352
1353!------------------------------------------------------------------------------
1354
1355subroutine date_plus_day_sub(this)
1356
1357 class(datetime_t) :: this
1358
1359 this%dJulianDate = this%dJulianDate + 1._c_double
1360 this%iJulianDay = int(this%dJulianDate, c_long)
1361 call this%calcGregorianDate()
1362
1363end subroutine date_plus_day_sub
1364
1365!------------------------------------------------------------------------------
1366
1367subroutine date_minus_day_sub(this)
1368
1369 class(datetime_t) :: this
1370
1371 this%dJulianDate = this%dJulianDate - 1._c_double
1372 this%iJulianDay = int(this%dJulianDate, c_long)
1373 call this%calcGregorianDate()
1374
1375end subroutine date_minus_day_sub
1376
1377!------------------------------------------------------------------------------
1378
1379function is_leap_year_fn(this) result(lIsLeapYear)
1380
1381 class(datetime_t) :: this
1382 logical (c_bool) :: lisleapyear
1383
1384 lisleapyear = ( mod(this%iYear, 4) == 0 .and. mod(this%iYear, 100) /= 0 ) .or. &
1385 ( mod(this%iYear, 400) == 0 .and. this%iYear /= 0 )
1386
1387end function is_leap_year_fn
1388
1389!------------------------------------------------------------------------------
1390
1391function mmddyyyy2julian(sMMDDYYYY) result(iJD)
1392
1393 character (len=*) :: smmddyyyy
1394 integer (c_int) :: ijd
1395
1396 ! [ LOCALS ]
1397 integer (c_int) :: imonth
1398 integer (c_int) :: iday
1399 integer (c_int) :: iyear
1400 character (len=256) :: sitem, sbuf
1401 integer (c_int) :: istat
1402
1403 sitem = smmddyyyy
1404
1405 ! parse month value
1406 call chomp(sitem, sbuf, "/-")
1407 read(sbuf,*,iostat = istat) imonth
1408 call assert(istat==0, "Problem reading month value from string "//trim(smmddyyyy), &
1409 __file__,__line__)
1410
1411 ! parse day value
1412 call chomp(sitem, sbuf, "/-")
1413 read(sbuf,*,iostat=istat) iday
1414 call assert(istat==0, "Problem reading day value from string "//trim(smmddyyyy), &
1415 __file__,__line__)
1416
1417 ! parse year value
1418 call chomp(sitem, sbuf, "/-")
1419 read(sbuf,*,iostat=istat) iyear
1420 call assert(istat==0, "Problem reading year value from string "//trim(smmddyyyy), &
1421 __file__,__line__)
1422
1423 ijd = julian_day( iyear, imonth, iday)
1424
1425end function mmddyyyy2julian
1426
1427!------------------------------------------------------------------------------
1428
1429function mmdd2doy(sMMDD, sInputItemName ) result(iDOY)
1430
1431 character (len=*) :: smmdd
1432 character (len=*), optional :: sinputitemname
1433
1434 integer (c_int) :: idoy
1435
1436 ! [ LOCALS ]
1437 integer (c_int) :: imonth
1438 integer (c_int) :: iday
1439 integer (c_int) :: iyear
1440 character (len=256) :: sitem, sbuf
1441 integer (c_int) :: istat
1442 integer (c_int) :: ijd
1443 integer (c_int) :: istartingjd
1444 character (len=256) :: sinputitemname_l
1445
1446 sitem = smmdd
1447
1448 if ( present( sinputitemname ) ) then
1449 sinputitemname_l = trim( sinputitemname )
1450 else
1451 sinputitemname_l = "unknown"
1452 endif
1453
1454 ! parse month value
1455 call chomp(sitem, sbuf, "/-")
1456 read(sbuf,*,iostat = istat) imonth
1457 call assert(istat==0, "Problem reading month value from string "//trim(smmdd), &
1458 __file__,__line__, &
1459 shints="The offending string was "//squote(smmdd)//", which was encountered " &
1460 //"while attempting to read in "//squote( sinputitemname_l ) )
1461
1462 ! parse day value
1463 call chomp(sitem, sbuf, "/-")
1464 read(sbuf,*,iostat=istat) iday
1465 call assert(istat==0, "Problem reading day value from string "//trim(smmdd), &
1466 __file__,__line__, &
1467 shints="The offending string was "//squote(smmdd)//", which was encountered " &
1468 //"while attempting to read in "//squote( sinputitemname_l ) )
1469
1470 ! we do not really care about the year value here; any year value could have been used
1471 istartingjd = julian_day( 1999, 1, 1)
1472 ijd = julian_day( 1999, imonth, iday)
1473
1474 idoy = ijd - istartingjd + 1
1475
1476end function mmdd2doy
1477
1478!------------------------------------------------------------------------------
1479
1480function mmddyyyy2doy(sMMDDYYYY) result(iDOY)
1481
1482 character (len=*) :: smmddyyyy
1483 integer (c_int) :: idoy
1484
1485 ! [ LOCALS ]
1486 integer (c_int) :: imonth
1487 integer (c_int) :: iday
1488 integer (c_int) :: iyear
1489 character (len=256) :: sitem, sbuf
1490 integer (c_int) :: istat
1491 integer (c_int) :: ijd
1492 integer (c_int) :: istartingjd
1493
1494 sitem = smmddyyyy
1495
1496 ! parse month value
1497 call chomp(sitem, sbuf, "/-")
1498 read(sbuf,*,iostat = istat) imonth
1499 call assert(istat==0, "Problem reading month value from string "//trim(smmddyyyy), &
1500 __file__,__line__)
1501
1502 ! parse day value
1503 call chomp(sitem, sbuf, "/-")
1504 read(sbuf,*,iostat=istat) iday
1505 call assert(istat==0, "Problem reading day value from string "//trim(smmddyyyy), &
1506 __file__,__line__)
1507
1508 ! parse year value
1509 call chomp(sitem, sbuf, "/-")
1510 read(sbuf,*,iostat=istat) iyear
1511 call assert(istat==0, "Problem reading year value from string "//trim(smmddyyyy), &
1512 __file__,__line__)
1513
1514 istartingjd = julian_day( iyear, 1, 1)
1515 ijd = julian_day( iyear, imonth, iday)
1516
1517 idoy = ijd - istartingjd + 1
1518
1519end function mmddyyyy2doy
1520
1521!--------------------------------------------------------------------------
1522
1523function get_day_of_year_fn(this) result(iDOY)
1524
1525 class(datetime_t) :: this
1526 integer (c_int) :: idoy
1527
1528 idoy = day_of_year( int( this%dJulianDate, c_int) )
1529
1530end function get_day_of_year_fn
1531
1532!--------------------------------------------------------------------------
1533
1534function day_of_year(iJD) result(iDOY)
1535
1536 integer (c_int), value :: ijd
1537
1538 ! [ LOCALS ]
1539 integer (c_int) :: ifirstday, ilastday, idoy
1540 integer (c_int) :: imonth, iday, iyear
1541
1542
1543 call gregorian_date(ijd, iyear, imonth, iday)
1544 ifirstday = julian_day( iyear, 1, 1 )
1545
1546 idoy = ijd - ifirstday + 1
1547
1548end function day_of_year
1549
1550!--------------------------------------------------------------------------
1551
1552function isleap(iYear) result(lResult)
1553
1554 integer (c_int), intent(in) :: iyear
1555 logical (c_bool) :: lresult
1556
1557 lresult = ( mod(iyear, 4) == 0 .and. mod(iyear, 100) /= 0 ) .or. &
1558 ( mod(iyear, 400) == 0 .and. iyear /= 0 )
1559
1560end function isleap
1561
1562!--------------------------------------------------------------------------
1563
1564end module datetime
fstring::as_character
Definition fstring.F90:55
constants_and_conversions
This module contains physical constants and convenience functions aimed at performing unit conversion...
Definition constants_and_conversions.F90:8
constants_and_conversions::true
logical(c_bool), parameter, public true
Definition constants_and_conversions.F90:38
constants_and_conversions::false
logical(c_bool), parameter, public false
Definition constants_and_conversions.F90:39
constants_and_conversions::itinyval
integer(c_int), parameter, public itinyval
Definition constants_and_conversions.F90:47
datetime
This module contains the DATETIME_T class and associated time and date-related routines,...
Definition datetime.F90:9
datetime::write_list_date_fn
character(len=10) function write_list_date_fn(this)
Definition datetime.F90:982
datetime::system_time_to_date_sub
subroutine system_time_to_date_sub(this)
Definition datetime.F90:1090
datetime::iscanmin2
integer(c_int), private iscanmin2
Definition datetime.F90:131
datetime::day_of_year
integer(c_int) function, public day_of_year(ijd)
Definition datetime.F90:1535
datetime::sdefault_time_format
character(len=14), public sdefault_time_format
Definition datetime.F90:127
datetime::is_date_lt_or_equal_to
logical(c_bool) function is_date_lt_or_equal_to(date1, date2)
Definition datetime.F90:778
datetime::iscandelim1
integer(c_int), private iscandelim1
Definition datetime.F90:119
datetime::stime_format
character(len=14), private stime_format
Definition datetime.F90:126
datetime::write_list_time_fn
character(len=8) function write_list_time_fn(this)
Definition datetime.F90:1009
datetime::get_fraction_of_day_fn
real(c_double) function get_fraction_of_day_fn(this)
Definition datetime.F90:1221
datetime::iscandd2
integer(c_int), private iscandd2
Definition datetime.F90:121
datetime::date_minus_float_fn
type(datetime_t) function, allocatable date_minus_float_fn(date1, fvalue)
Definition datetime.F90:928
datetime::set_julian_date_sub
subroutine set_julian_date_sub(this, dvalue)
Return the number of days in the given year.
Definition datetime.F90:1196
datetime::date_plus_day_sub
subroutine date_plus_day_sub(this)
Definition datetime.F90:1356
datetime::is_date_less_than
logical(c_bool) function is_date_less_than(date1, date2)
Definition datetime.F90:755
datetime::is_date_equal_to
logical(c_bool) function is_date_equal_to(date1, date2)
Definition datetime.F90:810
datetime::mmdd2doy
integer(c_int) function, public mmdd2doy(smmdd, sinputitemname)
Definition datetime.F90:1430
datetime::date_set_day_sub
subroutine date_set_day_sub(this, newday)
Definition datetime.F90:1281
datetime::calc_gregorian_date_sub
subroutine calc_gregorian_date_sub(this)
Definition datetime.F90:504
datetime::iscanyyyy2
integer(c_int), private iscanyyyy2
Definition datetime.F90:124
datetime::iscanhour1
integer(c_int), private iscanhour1
Definition datetime.F90:128
datetime::is_leap_year_fn
logical(c_bool) function is_leap_year_fn(this)
Definition datetime.F90:1380
datetime::assign_value_to_sub
subroutine assign_value_to_sub(date2, date1)
Definition datetime.F90:881
datetime::date_minus_int_fn
type(datetime_t) function, allocatable date_minus_int_fn(date1, ivalue)
Definition datetime.F90:943
datetime::write_list_datetime_fn
character(len=19) function write_list_datetime_fn(this)
Definition datetime.F90:1020
datetime::set_default_date_format
subroutine set_default_date_format(sdateformat)
Definition datetime.F90:167
datetime::calc_water_year_sub
subroutine calc_water_year_sub(this)
Definition datetime.F90:410
datetime::date_minus_year_sub
subroutine date_minus_year_sub(this)
Definition datetime.F90:1341
datetime::iscandd1
integer(c_int), private iscandd1
Definition datetime.F90:120
datetime::mmddyyyy2julian
integer(c_int) function mmddyyyy2julian(smmddyyyy)
Definition datetime.F90:1392
datetime::set_default_time_format
subroutine set_default_time_format(stimeformat)
Definition datetime.F90:177
datetime::iscanyyyy1
integer(c_int), private iscanyyyy1
Definition datetime.F90:123
datetime::iscanmin1
integer(c_int), private iscanmin1
Definition datetime.F90:130
datetime::write_pretty_date_fn
character(len=10) function write_pretty_date_fn(this)
Definition datetime.F90:970
datetime::sdate_format
character(len=14), private sdate_format
Definition datetime.F90:115
datetime::iscansec1
integer(c_int), private iscansec1
Definition datetime.F90:132
datetime::months
type(month_t), dimension(12), target, public months
Month information.
Definition datetime.F90:148
datetime::is_date_gt_or_equal_to
logical(c_bool) function is_date_gt_or_equal_to(date1, date2)
Definition datetime.F90:794
datetime::gregorian_date
subroutine, public gregorian_date(ijd, iyear, imonth, iday, iorigin)
Definition datetime.F90:572
datetime::get_days_in_month_fn
integer(c_int) function get_days_in_month_fn(this)
Definition datetime.F90:1232
datetime::iscandelim2
integer(c_int), private iscandelim2
Definition datetime.F90:122
datetime::set_time_format_indices
subroutine set_time_format_indices(this, stimeformat)
Definition datetime.F90:227
datetime::date_set_year_sub
subroutine date_set_year_sub(this, newyear)
Definition datetime.F90:1305
datetime::iscanmm2
integer(c_int), private iscanmm2
Definition datetime.F90:118
datetime::parse_text_to_time_sub
subroutine parse_text_to_time_sub(this, sstring)
Definition datetime.F90:347
datetime::sdefault_date_format
character(len=14), public sdefault_date_format
Definition datetime.F90:116
datetime::date_plus_float_fn
type(datetime_t) function, allocatable date_plus_float_fn(date1, fvalue)
Definition datetime.F90:913
datetime::iscanmm1
integer(c_int), private iscanmm1
Definition datetime.F90:117
datetime::set_date_format_indices
subroutine set_date_format_indices(this, sdateformat)
Definition datetime.F90:187
datetime::get_julian_day_fn
integer(c_int) function get_julian_day_fn(this)
Definition datetime.F90:1210
datetime::iscanhour2
integer(c_int), private iscanhour2
Definition datetime.F90:129
datetime::date_minus_day_sub
subroutine date_minus_day_sub(this)
Definition datetime.F90:1368
datetime::parse_text_to_date_sub
subroutine parse_text_to_date_sub(this, sstring, sfilename, ilinenumber)
Definition datetime.F90:259
datetime::count_leap_days_between_dates
integer(c_int) function, public count_leap_days_between_dates(date_min, date_max)
Definition datetime.F90:833
datetime::isleap
logical(c_bool) function, public isleap(iyear)
Definition datetime.F90:1553
datetime::write_pretty_datetime_fn
character(len=20) function write_pretty_datetime_fn(this)
Definition datetime.F90:958
datetime::get_day_of_year_fn
integer(c_int) function get_day_of_year_fn(this)
Definition datetime.F90:1524
datetime::date_set_month_sub
subroutine date_set_month_sub(this, newmonth)
Definition datetime.F90:1293
datetime::julian_day
integer(c_int) function, public julian_day(iyear, imonth, iday, iorigin, sinputitemname)
Definition datetime.F90:642
datetime::iscansec2
integer(c_int), private iscansec2
Definition datetime.F90:133
datetime::mmddyyyy2doy
integer(c_int) function mmddyyyy2doy(smmddyyyy)
Definition datetime.F90:1481
datetime::get_days_in_year_fn
integer(c_int) function get_days_in_year_fn(this)
Definition datetime.F90:1251
datetime::date_advance_to_last_day_of_month_sub
subroutine date_advance_to_last_day_of_month_sub(this)
Definition datetime.F90:1317
datetime::is_date_greater_than
logical(c_bool) function is_date_greater_than(date1, date2)
Definition datetime.F90:732
datetime::date_minus_date_fn
real(c_double) function date_minus_date_fn(date1, date2)
Definition datetime.F90:901
datetime::calc_julian_day_sub
subroutine calc_julian_day_sub(this, imonth, iday, iyear, ihour, iminute, isecond)
Definition datetime.F90:472
datetime::date_plus_year_sub
subroutine date_plus_year_sub(this)
Definition datetime.F90:1266
logfiles::logs
type(logfile_t), public logs
Definition logfiles.F90:62
datetime::datetime_t
Definition datetime.F90:38
datetime::month_t
Container for month name and length information.
Definition datetime.F90:137