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 = int(imonth, c_short)
337 this%iYear = iyear
338 this%iDay = int(iday, c_short)
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) :: sStr
363 character (len=256) :: sBuf
364
365 ioffset = 0
366
367 sstr = trim(adjustl(sstring))
368
369 shour = sstr( iscanhour1 : iscanhour2 )
370
371 sbuf = clean(shour)
372 if(len_trim(sbuf) /= len_trim(shour)) then ! we have a case where there is no leading zero
373 ioffset = 1
374 shour = trim(sbuf)
375 endif
376 read(shour,fmt=*, iostat = istat) ihour
377 call assert(istat==0, "Error parsing hour value - got "//trim(shour)//";"// &
378 " time text: "//trim(sstr), __file__,__line__)
379
380 sminute = sstr(iscanmin1 - ioffset : iscanmin2 - ioffset )
381 read(sminute,fmt=*, iostat = istat) iminute
382 call assert(istat==0, "Error parsing minutes value - got "//trim(sminute)//";"// &
383 " time text: "//trim(sstr), __file__,__line__)
384
385 if(iscansec1 /= 0) then
386 ssecond = sstr(iscansec1 - ioffset : iscansec2 - ioffset )
387 read(ssecond,fmt=*, iostat = istat) isecond
388 call assert(istat==0, "Error parsing hour value - got "//trim(ssecond)//";"// &
389 " time text: "//trim(sstr), __file__,__line__)
390 else
391 isecond = 0
392 endif
393
394 this%iHour = int(ihour, c_short)
395 this%iMinute = int(iminute, c_short)
396 this%iSecond = int(isecond, c_short)
397
398 this%dJulianDate = this%dJulianDate + real( ihour, c_double) / 24.0_c_double &
399 + real( iminute, c_double) / 1440.0_c_double &
400 + real( isecond, c_double) / 86400.0_c_double
401
402 this%iJulianDay = int(this%dJulianDate, c_long)
403
404end subroutine parse_text_to_time_sub
405
406!--------------------------------------------------------------------------
407
408subroutine calc_water_year_sub(this)
409
410 class(datetime_t) :: this
411
412 if(this%iMonth > 9) then
413 this%iWaterYearHigh = this%iYear + 1
414 else
415 this%iWaterYearHigh = &
416 this%iYear
417 end if
418
419 if(this%iMonth < 4) then
420 this%iWaterYearLow = this%iYear - 1
421 else
422 this%iWaterYearLow = this%iYear
423 endif
424
425end subroutine calc_water_year_sub
426
427!--------------------------------------------------------------------------
428
429! subroutine populate_julian_day_sub(this, iMonth, iDay, iYear, &
430! iHour, iMinute, iSecond)
431!
432! class (DATETIME_T) :: this
433! integer (c_int), intent(in) :: iMonth
434! integer (c_int), intent(in) :: iDay
435! integer (c_int), intent(in) :: iYear
436! integer (c_int), intent(in) :: iHour
437! integer (c_int), intent(in) :: iMinute
438! integer (c_int), intent(in) :: iSecond
439!
440! ! [LOCALS]
441! ! integer (c_int) :: iJulianDay
442! ! real (c_double) :: rFractionOfDay
443!
444! this%iMonth = iMonth
445! this%iDay = iDay
446! this%iYear = iYear
447! this%iHour = iHour
448! this%iMinute = iMinute
449! this%iSecond = iSecond
450!
451! ! this%iJulianDay = julian_day( this%iYear, this%iMonth, this%iDay)
452! this%iJulianDay = julian_day( int(this%iYear, c_int), &
453! int(this%iMonth, c_int), &
454! int(this%iDay, c_int))
455!
456! this%rFractionOfDay = real(this%iHour, c_double) / 24_c_double + &
457! real(this%iMinute, c_double) / 1440_c_double + &
458! real(this%iSecond, c_double) / 86400_c_double
459!
460! ! this%rJulianDay = real(iJulianDay, c_double) + rFractionOfDay !&
461! ! - 2400000.5_c_double
462!
463! ! 2400000.5 is subtracted to yield one definition of a "MODIFIED JUILAN DAY"
464!
465! end subroutine populate_julian_day_sub
466
467!--------------------------------------------------------------------------
468
469subroutine calc_julian_day_sub(this, iMonth, iDay, iYear, &
470 iHour, iMinute, iSecond)
471
472 class(datetime_t) :: this
473 integer (c_int), intent(in), optional :: iMonth
474 integer (c_int), intent(in), optional :: iDay
475 integer (c_int), intent(in), optional :: iYear
476 integer (c_int), intent(in), optional :: iHour
477 integer (c_int), intent(in), optional :: iMinute
478 integer (c_int), intent(in), optional :: iSecond
479
480 if(present(imonth) ) this%iMonth = int(imonth, c_short)
481 if(present(iday) ) this%iDay = int(iday, c_short)
482 if(present(iyear) ) this%iYear = iyear
483 if(present(ihour) ) this%iHour = int(ihour, c_short)
484 if(present(iminute) ) this%iMinute = int(iminute, c_short)
485 if(present(isecond) ) this%iSecond = int(isecond, c_short)
486
487 this%dJulianDate = real( julian_day( int(this%iYear, c_int), &
488 int(this%iMonth, c_int), &
489 int(this%iDay, c_int) ), c_double) + &
490 real(this%iHour, c_double) / 24._c_double + &
491 real(this%iMinute, c_double) / 1440._c_double + &
492 real(this%iSecond, c_double) / 86400._c_double
493
494! this%rJulianDay = real(iJulianDay, c_double) + rFractionOfDay ! - 2400000.5_c_double
495
496 this%iJulianDay = int(this%dJulianDate, c_long)
497
498end subroutine calc_julian_day_sub
499
500!--------------------------------------------------------------------------
501
502 subroutine calc_gregorian_date_sub(this)
503
504 class(datetime_t), intent(inout) :: this
505
506 ! [ LOCALS ]
507 integer (c_int) :: iMonth
508 integer (c_int) :: iDay
509 integer (c_int) :: iYear
510 integer (c_int) :: iHour
511 integer (c_int) :: iMinute
512 integer (c_int) :: iSecond
513 integer (c_int) :: iJulianDay
514
515 real(c_double) :: rHour, rMinute, rSecond
516
517 ijulianday = this%getJulianDay()
518
519 call gregorian_date( ijulianday, iyear, imonth, iday )
520
521 this%iYear = iyear
522 this%iMonth = int(imonth, c_short)
523 this%iDay = int(iday, c_short)
524
525 rhour = this%getFractionOfDay() * 24._c_double
526 ihour = int(rhour, c_int)
527
528! rMinute = (rHour - real(iHour, c_float) ) * 1440_c_double
529 rminute = (rhour - real(ihour, c_double) ) * 60._c_double
530 iminute = int(rminute, c_int)
531
532! rSecond = ( rMinute - real(iMinute, c_float) ) * 86400_c_double
533 rsecond = ( rminute - real(iminute, c_double) ) * 60._c_double
534 isecond = int(rsecond, c_int)
535
536 this%iHour = int(ihour, c_short)
537 this%iMinute = int(iminute, c_short)
538 this%iHour = int(isecond, c_short)
539
540end subroutine calc_gregorian_date_sub
541
542!!***
543
544!--------------------------------------------------------------------------
545!!****f* types/gregorian_date
546! NAME
547! gregorian_date - Convert from a Julian day number to a Gregorian date.
548!
549! SYNOPSIS
550! Conversion to a Gregorian calendar date from a Julian date.
551! Valid for any Gregorian calendar date producing a Julian day number
552! greater than zero.
553!
554! INPUTS
555! iJD integer number of days that have elapsed since noon
556! Greenwich Mean Time (UT or TT) Monday, January 1, 4713 BC
557! OUTPUTS
558! iYear 4-digit year
559! iMonth 2-digit month (1-12)
560! iDay 2-digit day (1-31)
561!
562! NOTES
563! Reference: Fliegel, H. F. and van Flandern, T. C. (1968).
564! Communications of the ACM, Vol. 11, No. 10 (October, 1968).
565! Modified from code found at:
566! http://aa.usno.navy.mil/faq/docs/JD_Formula.html
567!
568! SOURCE
569
570 subroutine gregorian_date(iJD, iYear, iMonth, iDay, iOrigin)
571
572!! COMPUTES THE GREGORIAN CALENDAR DATE (YEAR,MONTH,DAY)
573!! GIVEN THE JULIAN DATE (JD).
574
575 ! [ ARGUMENTS ]
576 integer (c_int), value :: ijd
577 integer (c_int), intent(inout) :: iyear, imonth, iday
578 integer (c_int), intent(in), optional :: iorigin
579 ! [ LOCALS ]
580 integer (c_int) ii,ij,ik,il,in
581 integer (c_int) :: ioffset
582
583 if(present(iorigin)) then
584 ioffset = iorigin
585 else
586 ioffset = 0
587 endif
588
589 ! allow for an alternate "origin" to be specified... technically,
590 ! this is no longer a "Julian" day, but alas... This modification
591 ! was required in order to process the "time" variables from global
592 ! climate models, which seem to be defined as something like this:
593 ! time:units = "days since 1960-01-01 00:00:00"
594 !
595 ! for the above example, JD = 2436935 on the first day; the NetCDF "time"
596 ! variable will be equal to 0. Thus, in order to get the conversion
597 ! right, we must add 0 + 2436935 to yield a true Julian Day.
598
599 ijd = ijd + ioffset
600
601 il= ijd + 68569_c_int
602 in= 4*il / 146097_c_int
603 il= il - (146097_c_int * in + 3_c_int)/4_c_int
604 ii= 4000_c_int * (il + 1_c_int) / 1461001_c_int
605 il= il - 1461_c_int * ii / 4_c_int + 31_c_int
606 ij= 80_c_int * il / 2447_c_int
607 ik= il - 2447_c_int * ij / 80_c_int
608 il= ij / 11_c_int
609 ij= ij + 2_c_int - 12_c_int * il
610 ii= 100_c_int * (in - 49_c_int) + ii + il
611
612 iyear = ii
613 imonth = ij
614 iday = ik
615
616end subroutine gregorian_date
617
618
619!--------------------------------------------------------------------------
620!!****f* types/julian_day
621! NAME
622! julian_day - Convert from a Gregorian calendar date to a Julian day number.
623!
624! SYNOPSIS
625! Conversion from a Gregorian calendar date to a Julian day number.
626! Valid for any Gregorian calendar date producing a Julian day
627! greater than zero.
628!
629! INPUTS
630! iYear 4-digit year
631! iMonth 2-digit month (1-12)
632! iDay 2-digit day (1-31)
633!
634! OUTPUTS
635! iJD integer number of days that have elapsed since noon
636! Greenwich Mean Time (UT or TT) Monday, January 1, 4713 BC
637!
638! SOURCE
639
640function julian_day ( iYear, iMonth, iDay, iOrigin, sInputItemName ) result(iJD)
641
642 ! [ ARGUMENTS ]
643 integer (c_int), intent(in) :: iyear, imonth, iday
644 integer (c_int), optional :: iorigin
645 character (len=*), optional :: sinputitemname
646
647
648 ! [ LOCALS ]
649 integer (c_int) i,j,k
650 integer (c_int) :: ioffset
651 character (len=256) :: sbuf
652 character (len=:), allocatable :: sinputitemname_
653 logical (c_bool) :: illegal_month, illegal_day
654
655 ! [ RETURN VALUE ]
656 integer (c_int) :: ijd
657 sbuf = ""
658
659 illegal_month = false
660 illegal_day = false
661
662 if (present(sinputitemname)) then
663 sinputitemname_ = trim(sinputitemname)
664 else
665 sinputitemname_ = "unspecified"
666 endif
667
668 i= iyear
669 j= imonth
670 k= iday
671
672 select case ( imonth )
673
674 case (1, 3, 5, 7, 8, 10, 12)
675
676 if ( iday < 1 .or. iday > 31 ) illegal_day = true
677
678 case (2)
679
680 if ( isleap( iyear) ) then
681 if ( iday < 1 .or. iday > 29 ) illegal_day = true
682 else
683 if ( iday < 1 .or. iday > 28 ) illegal_day = true
684 endif
685 case (4, 6, 9, 11)
686
687 if ( iday < 1 .or. iday > 31 ) illegal_day = true
688
689 case default
690
691 illegal_month = true
692
693 end select
694
695 if(present(iorigin)) then
696 ioffset = iorigin
697 else
698 ioffset = 0
699 endif
700
701 ijd= ( k-32075_c_int + 1461_c_int * (i + 4800_c_int + (j - 14_c_int) / 12_c_int) &
702 /4_c_int + 367_c_int * (j - 2_c_int - (j - 14_c_int)/ 12_c_int * 12_c_int) &
703 /12_c_int - 3_c_int *((i + 4900_c_int + (j - 14_c_int) &
704 /12_c_int)/100_c_int)/4_c_int ) - ioffset
705
706 if ( illegal_month .or. illegal_day ) then
707! call LOGS%write(" ** there was a problem converting month, day, year values to a Julian date **", &
708! iLinesBefore=2, iLogLevel=LOG_ALL, lEcho=TRUE, iTab=5)
709 call logs%write("month value: " + as_character(imonth), itab=16)
710 call logs%write("day value: " + as_character(iday), itab=18)
711 call logs%write("year value: " + as_character(iyear), itab=17)
712 call logs%write("input type: " + sinputitemname_, ilinesafter=1, itab=17)
713
714 sbuf = "there was a problem converting month, day, year values to a Julian date: "
715
716 if ( illegal_month) sbuf = adjustl(trim(sbuf) + " month value is illegal. ")
717 if ( illegal_day) sbuf = adjustl(trim(sbuf) + " day value is illegal.")
718
719 call assert( false, trim(sbuf), __file__, __line__)
720
721 ! will never get here normally, but for unit testing purposes, return some nonsensical value
722 ijd = itinyval
723
724 endif
725
726end function julian_day
727
728!------------------------------------------------------------------------------
729
730 function is_date_greater_than(date1, date2) result(lResult)
731
732 type(datetime_t), intent(in) :: date1
733 type(datetime_t), intent(in) :: date2
734
735 ! [ LOCALS ]
736 logical(c_bool ) :: lresult
737
738 lresult = false
739
740! if(date2%iJulianDay == date1%iJulianDay &
741! .and. date1%rFractionOfDay > date2%rFractionOfDay) then
742! lResult = TRUE
743! elseif(date1%iJulianDay > date2%iJulianDay) then
744! lResult = TRUE
745! endif
746
747 if( date1%dJulianDate > date2%dJulianDate ) lresult = true
748
749end function is_date_greater_than
750
751!------------------------------------------------------------------------------
752
753 function is_date_less_than(date1, date2) result(lResult)
754
755 class(datetime_t), intent(in) :: date1
756 class(datetime_t), intent(in) :: date2
757
758 ! [ LOCALS ]
759 logical(c_bool ) :: lresult
760
761 lresult = false
762
763! if(date1%iJulianDay == date2%iJulianDay &
764! .and. date1%rFractionOfDay < date2%rFractionOfDay) then
765! lResult = TRUE
766! elseif(date1%iJulianDay < date2%iJulianDay) then
767! lResult = TRUE
768! endif
769
770 if( date1%dJulianDate < date2%dJulianDate ) lresult = true
771
772end function is_date_less_than
773
774!------------------------------------------------------------------------------
775
776 function is_date_lt_or_equal_to(date1, date2) result(lResult)
777
778 class( datetime_t ), intent(in) :: date1
779 type ( datetime_t ), intent(in) :: date2
780
781 ! [ LOCALS ]
782 logical(c_bool ) :: lresult
783
784 lresult = false
785
786 if( date1%dJulianDate <= date2%dJulianDate ) lresult = true
787
788end function is_date_lt_or_equal_to
789
790!------------------------------------------------------------------------------
791
792 function is_date_gt_or_equal_to(date1, date2) result(lResult)
793
794 class( datetime_t), intent(in) :: date1
795 type ( datetime_t), intent(in) :: date2
796
797 ! [ LOCALS ]
798 logical(c_bool ) :: lresult
799
800 lresult = false
801
802 if( date1%dJulianDate >= date2%dJulianDate ) lresult = true
803
804end function is_date_gt_or_equal_to
805
806!------------------------------------------------------------------------------
807
808 function is_date_equal_to(date1, date2) result(lResult)
809
810 class(datetime_t), intent(in) :: date1
811 class(datetime_t), intent(in) :: date2
812
813 ! [ LOCALS ]
814 logical(c_bool ) :: lresult
815
816 lresult = false
817
818 if( date1%getJulianDay() == date2%getJulianDay() .and. &
819 date1%iHour == date2%iHour .and. &
820 date1%iMinute == date2%iMinute .and. &
821 date1%iSecond == date2%iSecond) then
822
823 lresult = true
824
825 endif
826
827end function is_date_equal_to
828
829!------------------------------------------------------------------------------
830
831function count_leap_days_between_dates(date_min, date_max) result(iCount)
832
833 class(datetime_t), intent(in) :: date_min
834 class(datetime_t), intent(in) :: date_max
835
836 integer (c_int) :: inumyears
837 integer (c_int) :: icount
838
839 ! [ LOCALS ]
840 integer (c_int) :: year_value
841
842 icount = 0
843
844 inumyears = date_max%iYear - date_min%iYear
845
846 if (inumyears == 0) then
847
848 if (( date_min%isLeapYear() .and. &
849 (date_min%iMonth <= 2 .and. date_min%iDay <= 28)) &
850 .and. ((date_max%iMonth == 2 .and. date_min%iDay > 28) .or. date_max%iMonth >=3)) &
851 icount = 1
852
853 elseif (inumyears > 0) then
854
855 if ( date_min%isLeapYear() .and. &
856 (date_min%iMonth == 1 .or. ( date_min%iMonth == 2 .and. date_min%iDay <= 28))) &
857 icount = 1
858
859 if ( date_max%isLeapYear() .and. &
860 (date_max%iMonth > 2 .or. ( date_max%iMonth == 2 .and. date_max%iDay > 28))) &
861 icount = icount + 1
862
863 endif
864
865 if (inumyears >=3) then
866
867 do year_value=date_min%iYear+1, date_max%iYear-1
868
869 if (isleap(year_value)) icount = icount + 1
870
871 enddo
872
873 endif
874
875end function count_leap_days_between_dates
876
877!------------------------------------------------------------------------------
878
879subroutine assign_value_to_sub( date2, date1 )
880
881 type(datetime_t), intent(out) :: date2
882 type(datetime_t), intent(in) :: date1
883
884 date2%iMonth = date1%iMonth
885 date2%iDay = date1%iDay
886 date2%iYear = date1%iYear
887 date2%iHour = date1%iHour
888 date2%iMinute = date1%iMinute
889 date2%iSecond = date1%iSecond
890 date2%iWaterYearHigh = date1%iWaterYearHigh
891 date2%iWaterYearLow = date1%iWaterYearLow
892 date2%dJulianDate = date1%dJulianDate
893 date2%iJulianDay = date1%iJulianDay
894
895end subroutine assign_value_to_sub
896
897!------------------------------------------------------------------------------
898
899 function date_minus_date_fn(date1, date2) result(rDelta)
900
901 class(datetime_t), intent(in) :: date1
902 class(datetime_t), intent(in) :: date2
903 real (c_double) :: rdelta
904
905 rdelta = date1%dJulianDate - date2%dJulianDate
906
907end function date_minus_date_fn
908
909!------------------------------------------------------------------------------
910
911 function date_plus_float_fn(date1, fValue) result(newdate)
912
913 class(datetime_t), intent(in) :: date1
914 real (c_float), intent(in) :: fvalue
915 type(datetime_t), allocatable :: newdate
916
917 allocate( newdate )
918 newdate%dJulianDate = date1%dJulianDate + real( fvalue, c_double)
919 newdate%iJulianDay = int(newdate%dJulianDate, c_long)
920 call newdate%calcGregorianDate()
921
922end function date_plus_float_fn
923
924!------------------------------------------------------------------------------
925
926 function date_minus_float_fn(date1, fValue) result(newdate)
927
928 class(datetime_t), intent(in) :: date1
929 real (c_float), intent(in) :: fvalue
930 type(datetime_t), allocatable :: newdate
931
932 allocate( newdate )
933 newdate%dJulianDate = date1%dJulianDate - real( fvalue, c_double)
934 newdate%iJulianDay = int(newdate%dJulianDate, c_long)
935 call newdate%calcGregorianDate()
936
937end function date_minus_float_fn
938
939!-------------------------------------------------------------------------------
940
941 function date_minus_int_fn(date1, iValue) result(newdate)
942
943 class(datetime_t), intent(in) :: date1
944 integer (c_int), intent(in) :: ivalue
945 type(datetime_t), allocatable :: newdate
946
947 allocate( newdate )
948 newdate%dJulianDate = date1%dJulianDate - real( ivalue, c_double)
949 newdate%iJulianDay = int(newdate%dJulianDate, c_long)
950 call newdate%calcGregorianDate()
951
952end function date_minus_int_fn
953
954!------------------------------------------------------------------------------
955
956function write_pretty_datetime_fn(this) result(sDateTimeText)
957
958 class(datetime_t) :: this
959 character (len=20) :: sdatetimetext
960
961 write(sdatetimetext, fmt="(a3,' ',i2.2,' ',i4.4, 1x, i2.2,':',i2.2,':',i2.2)") &
962 months(this%iMonth)%sName, this%iDay, this%iYear, this%iHour, this%iMinute, this%iSecond
963
964end function write_pretty_datetime_fn
965
966!------------------------------------------------------------------------------
967
968function write_pretty_date_fn(this) result(sDateText)
969
970 class(datetime_t) :: this
971 character (len=10) :: sdatetext
972
973 write(sdatetext, fmt="(i4.4,'-',i2.2,'-',i2.2)") &
974 this%iYear, this%iMonth, this%iDay
975
976end function write_pretty_date_fn
977
978!------------------------------------------------------------------------------
979
980function write_list_date_fn(this) result(sDateText)
981
982 class(datetime_t) :: this
983 character (len=10) :: sdatetext
984
985 ! [ LOCALS ]
986 integer (c_int), dimension(5) :: istat
987! sDateText = this%listdatetime()
988
989 write(sdatetext(iscanmm1:iscanmm2),fmt="(i2.2)", iostat=istat(1)) this%iMonth
990 write(sdatetext(iscandd1:iscandd2),fmt="(i2.2)", iostat=istat(2)) this%iDay
991 write(sdatetext(iscanyyyy1:iscanyyyy2),fmt="(i4.4)",iostat=istat(3)) this%iYear
992 if(iscandelim1 > 0) write(sdatetext(iscandelim1:iscandelim1), &
993 fmt="(a1)",iostat=istat(4)) &
994 sdate_format(iscandelim1:iscandelim1)
995 if(iscandelim2 > 0) write(sdatetext(iscandelim2:iscandelim2), &
996 fmt="(a1)",iostat=istat(5)) &
997 sdate_format(iscandelim2:iscandelim2)
998
999 call assert(all(istat==0),"Problem parsing the date format '"// &
1000 trim(sdate_format)//"' for output", &
1001 __file__, __line__)
1002
1003end function write_list_date_fn
1004
1005!------------------------------------------------------------------------------
1006
1007function write_list_time_fn(this) result(sTimeText)
1008
1009 class(datetime_t) :: this
1010 character (len=8) :: stimetext
1011
1012 write(stimetext,fmt="(i2.2,':',i2.2,':',i2.2)") this%iHour, this%iMinute, this%iSecond
1013
1014end function write_list_time_fn
1015
1016!------------------------------------------------------------------------------
1017
1018function write_list_datetime_fn(this) result(sDatetimeText)
1019
1020 class(datetime_t) :: this
1021! character(len=*), optional :: sDateFormat
1022! logical (c_bool), optional :: lDateOnly
1023 character (len=19) :: sdatetimetext
1024
1025 ! [ LOCALS ]
1026! character(len=25) sDateFmt
1027! integer (c_int) :: iScanMM1, iScanMM2
1028! integer (c_int) :: iScanDD1, iScanDD2
1029! integer (c_int) :: iScanYYYY1, iScanYYYY2
1030! integer (c_int) :: iScanDelim1, iScanDelim2
1031 character (len=32) :: sbuf
1032! character (len=6), parameter :: DELIMITERS = "/-_\. "
1033 integer (c_int), dimension(5) :: istat
1034! logical (c_bool) lListTime
1035
1036 sdatetimetext = ""
1037
1038! if(present(sDateFormat)) then
1039! sDateFmt = uppercase(trim(adjustl(sDateFormat)))
1040! else
1041! sDateFmt = "MM/DD/YYYY"
1042! endif
1043
1044! if(present(lDateOnly)) then
1045! lListTime = .not. lDateOnly
1046! else
1047! lListTime = TRUE
1048! endif
1049
1050! iScanMM1 = scan(string=sDateFmt,set="M")
1051! iScanMM2 = scan(string=sDateFmt,set="M", back=TRUE )
1052
1053! iScanDD1 = scan(string=sDateFmt,set="D")
1054! iScanDD2 = scan(string=sDateFmt,set="D", back=TRUE )
1055
1056! iScanYYYY1 = scan(string=sDateFmt,set="Y")
1057! iScanYYYY2 = scan(string=sDateFmt,set="Y", back=TRUE )
1058
1059! iScanDelim1 = scan(string=trim(sDateFmt), set=DELIMITERS)
1060! iScanDelim2 = scan(string=trim(sDateFmt), set=DELIMITERS, back=TRUE)
1061
1062 write(sdatetimetext(iscanmm1:iscanmm2),fmt="(i2.2)", iostat=istat(1)) this%iMonth
1063 write(sdatetimetext(iscandd1:iscandd2),fmt="(i2.2)", iostat=istat(2)) this%iDay
1064 write(sdatetimetext(iscanyyyy1:iscanyyyy2),fmt="(i4.4)",iostat=istat(3)) this%iYear
1065 if(iscandelim1 > 0) write(sdatetimetext(iscandelim1:iscandelim1), &
1066 fmt="(a1)",iostat=istat(4)) &
1067 sdate_format(iscandelim1:iscandelim1)
1068 if(iscandelim2 > 0) write(sdatetimetext(iscandelim2:iscandelim2), &
1069 fmt="(a1)",iostat=istat(5)) &
1070 sdate_format(iscandelim2:iscandelim2)
1071
1072 call assert(all(istat==0),"Problem parsing the date format '"// &
1073 trim(sdate_format)//"' for output", &
1074 __file__, __line__)
1075
1076 write(sbuf,fmt="(1x,i2.2,':',i2.2,':',i2.2)") this%iHour, this%iMinute, this%iSecond
1077
1078! if(lListTime) then
1079 sdatetimetext = trim(sdatetimetext) // trim(sbuf)
1080! else
1081! sDateTimeText = trim(sDateTimeText)
1082! endif
1083
1084end function write_list_datetime_fn
1085
1086!------------------------------------------------------------------------------
1087
1088subroutine system_time_to_date_sub(this)
1089
1090 class(datetime_t) :: this
1091
1092 ! [ LOCALS ]
1093 character (len=16) :: sDateText
1094 character (len=16) :: sTimeText
1095 integer (c_int), dimension(8) :: iValues
1096
1097 call date_and_time(sdatetext, stimetext)
1098 call date_and_time(values = ivalues)
1099
1100 call this%setDateFormat("YYYYMMDD")
1101 call this%setTimeFormat("HHMMSS")
1102
1103 call this%parseDate(sdatetext)
1104 call this%parseTime(stimetext)
1105 call this%calcJulianDay()
1106 this%dJulianDate = this%dJulianDate + &
1107 (real(ivalues(8), c_double) / 86400_c_double / 1000_c_double) ! milliseconds
1108
1109 call this%setDateFormat()
1110 call this%setTimeFormat()
1111
1112end subroutine system_time_to_date_sub
1113
1114
1115!--------------------------------------------------------------------------
1116
1117!> \brief Return the number of days in the given year.
1118!!
1119!! This function simply returns the number of days given the current year.
1120!function day_of_year(iJulianDay) result(iDOY)
1121
1122! integer (c_int), intent(in) :: iJulianDay
1123
1124 ! [ LOCALS ]
1125! integer (c_int) :: iFirstDay, iCurrDay, iDOY
1126! integer (c_int) :: iYear, iMonth, iDay
1127
1128 ! first get the value for the current year
1129! call gregorian_date(iJulianDay, iYear, iMonth, iDay)
1130
1131 ! now calculate the Julian day for the first of the year
1132! iFirstDay = julian_day ( iYear, 1, 1 )
1133
1134 ! return the current day of the year
1135! iDOY = iJulianDay - iFirstDay + 1
1136
1137! return
1138
1139!end function day_of_year
1140
1141!--------------------------------------------------------------------------
1142!!****f* types/solstice
1143! NAME
1144! solstice - Returns 0 normally, or a value >0 during solstice or equinox.
1145!
1146! SYNOPSIS
1147! Returns the following:
1148! 0: non-solstice and non-equinox day
1149! 1: Vernal equinox
1150! 2: Summer Solstice
1151! 3: Autumnal equinox
1152! 4: Winter solstice
1153!
1154! INPUTS
1155! iJD Julian day value
1156!
1157! OUTPUTS
1158! iSol Code as described above
1159!
1160! SOURCE
1161
1162!function solstice (iJD) result (iSol)
1163
1164 ! [ ARGUMENTS ]
1165! integer (c_int), intent(in) :: iJD
1166
1167 ! [ LOCALS ]
1168! integer (c_int) iMonth, iDay, iYear
1169
1170
1171! ! [ RETURN VALUE ]
1172! integer (c_int) :: iSol
1173
1174! call gregorian_date(iJD, iYear, iMonth, iDay)
1175
1176! if(iMonth==3 .and. iDay == 20) then
1177! iSol = 1
1178! elseif(iMonth==6 .and. iDay == 21) then
1179! iSol = 2
1180! elseif(iMonth==9 .and. iDay == 22) then
1181! iSol = 3
1182! elseif(iMonth==12 .and. iDay == 21) then
1183! iSol = 4
1184! else
1185! iSol = 0
1186! endif
1187!
1188! return
1189!
1190!end function solstice
1191
1192!------------------------------------------------------------------------------
1193
1194 subroutine set_julian_date_sub(this, dValue)
1195
1196 class(datetime_t), intent(inout) :: this
1197 real (c_double), intent(in) :: dValue
1198
1199 this%dJulianDate = dvalue
1200 this%iJulianDay = int(dvalue, c_long)
1201
1202 call this%calcGregorianDate()
1203
1204end subroutine set_julian_date_sub
1205
1206!------------------------------------------------------------------------------
1207
1208 function get_julian_day_fn(this) result(iJulianDay)
1209
1210 class(datetime_t), intent(in) :: this
1211 integer (c_int) :: ijulianday
1212
1213 ijulianday = int(this%dJulianDate, c_int)
1214
1215end function get_julian_day_fn
1216
1217!------------------------------------------------------------------------------
1218
1219 function get_fraction_of_day_fn(this) result(dFractionOfDay)
1220
1221 class(datetime_t), intent(in) :: this
1222 real (c_double) :: dfractionofday
1223
1224 dfractionofday = this%dJulianDate - real( int(this%dJulianDate, c_long ), c_double)
1225
1226end function get_fraction_of_day_fn
1227
1228!------------------------------------------------------------------------------
1229
1230function get_days_in_month_fn(this) result(iDaysInMonth)
1231
1232 class(datetime_t) :: this
1233 integer (c_int) :: idaysinmonth
1234
1235 ! [ LOCALS ]
1236 integer (c_int), dimension(12), parameter :: inumberofdaysinmonth = &
1237 [31,28,31,30,31,30,31,31,30,31,30,31]
1238
1239 idaysinmonth = inumberofdaysinmonth(this%iMonth)
1240
1241 if (this%isLeapYear() ) then
1242 idaysinmonth = max(idaysinmonth, 29)
1243 endif
1244
1245end function get_days_in_month_fn
1246
1247!------------------------------------------------------------------------------
1248
1249function get_days_in_year_fn(this) result(iDaysInYear)
1250
1251 class(datetime_t) :: this
1252 integer (c_int) :: idaysinyear
1253
1254 if (this%isLeapYear() ) then
1255 idaysinyear = 366
1256 else
1257 idaysinyear = 365
1258 endif
1259
1260end function get_days_in_year_fn
1261
1262!------------------------------------------------------------------------------
1263
1264subroutine date_plus_year_sub(this)
1265
1266 class(datetime_t) :: this
1267
1268! this%iYear = this%iYear + 1_c_int
1269! call this%calcJulianDay()
1270
1271 this%dJulianDate = this%dJulianDate + 365.25_c_double
1272 this%iJulianDay = int(this%dJulianDate, c_long)
1273 call this%calcGregorianDate()
1274
1275end subroutine date_plus_year_sub
1276
1277!------------------------------------------------------------------------------
1278
1279subroutine date_set_day_sub(this, newday)
1280
1281 class(datetime_t) :: this
1282 integer (c_int), intent(in) :: newday
1283
1284 this%iDay = int(newday, c_short)
1285 call this%calcJulianDay()
1286
1287end subroutine date_set_day_sub
1288
1289!------------------------------------------------------------------------------
1290
1291subroutine date_set_month_sub(this, newmonth)
1292
1293 class(datetime_t) :: this
1294 integer (c_int), intent(in) :: newmonth
1295
1296 this%iMonth = int(newmonth, c_short)
1297 call this%calcJulianDay()
1298
1299end subroutine date_set_month_sub
1300
1301!------------------------------------------------------------------------------
1302
1303subroutine date_set_year_sub(this, newyear)
1304
1305 class(datetime_t) :: this
1306 integer (c_int), intent(in) :: newyear
1307
1308 this%iYear = newyear
1309 call this%calcJulianDay()
1310
1311end subroutine date_set_year_sub
1312
1313!------------------------------------------------------------------------------
1314
1315subroutine date_advance_to_last_day_of_month_sub(this)
1316
1317 class(datetime_t) :: this
1318
1319 this%iDay = 1_c_int
1320
1321 if (this%iMonth < 12) then
1322 this%iMonth = int(this%iMonth + 1, c_short)
1323 else
1324 this%iMonth = 1
1325 this%iYear = this%iYear + 1
1326 endif
1327
1328 call this%calcJulianDay()
1329
1330 ! now step back a day to obtain the date for the last day of the month
1331 this%dJulianDate = this%dJulianDate - 1.0_c_double
1332 this%iJulianDay = int(this%dJulianDate, c_long)
1333 call this%calcGregorianDate()
1334
1335end subroutine date_advance_to_last_day_of_month_sub
1336
1337!------------------------------------------------------------------------------
1338
1339subroutine date_minus_year_sub(this)
1340
1341 class(datetime_t) :: this
1342
1343! this%iYear = this%iYear - 1_c_int
1344! call this%calcJulianDay()
1345
1346 this%dJulianDate = this%dJulianDate - 365.25_c_double
1347 this%iJulianDay = int(this%dJulianDate, c_long)
1348 call this%calcGregorianDate()
1349
1350end subroutine date_minus_year_sub
1351
1352!------------------------------------------------------------------------------
1353
1354subroutine date_plus_day_sub(this)
1355
1356 class(datetime_t) :: this
1357
1358 this%dJulianDate = this%dJulianDate + 1._c_double
1359 this%iJulianDay = int(this%dJulianDate, c_long)
1360 call this%calcGregorianDate()
1361
1362end subroutine date_plus_day_sub
1363
1364!------------------------------------------------------------------------------
1365
1366subroutine date_minus_day_sub(this)
1367
1368 class(datetime_t) :: this
1369
1370 this%dJulianDate = this%dJulianDate - 1._c_double
1371 this%iJulianDay = int(this%dJulianDate, c_long)
1372 call this%calcGregorianDate()
1373
1374end subroutine date_minus_day_sub
1375
1376!------------------------------------------------------------------------------
1377
1378function is_leap_year_fn(this) result(lIsLeapYear)
1379
1380 class(datetime_t) :: this
1381 logical (c_bool) :: lisleapyear
1382
1383 lisleapyear = ( mod(this%iYear, 4) == 0 .and. mod(this%iYear, 100) /= 0 ) .or. &
1384 ( mod(this%iYear, 400) == 0 .and. this%iYear /= 0 )
1385
1386end function is_leap_year_fn
1387
1388
1389
1390!------------------------------------------------------------------------------
1391
1392function mmdd2doy(sMMDD, sInputItemName ) result(iDOY)
1393
1394 character (len=*) :: smmdd
1395 character (len=*), optional :: sinputitemname
1396
1397 integer (c_int) :: idoy
1398
1399 ! [ LOCALS ]
1400 integer (c_int) :: imonth
1401 integer (c_int) :: iday
1402 character (len=256) :: sitem, sbuf
1403 integer (c_int) :: istat
1404 integer (c_int) :: ijd
1405 integer (c_int) :: istartingjd
1406 character (len=256) :: sinputitemname_l
1407
1408 sitem = smmdd
1409
1410 if ( present( sinputitemname ) ) then
1411 sinputitemname_l = trim( sinputitemname )
1412 else
1413 sinputitemname_l = "unknown"
1414 endif
1415
1416 ! parse month value
1417 call chomp(sitem, sbuf, "/-")
1418 read(sbuf,*,iostat = istat) imonth
1419 call assert(istat==0, "Problem reading month value from string "//trim(smmdd), &
1420 __file__,__line__, &
1421 shints="The offending string was "//squote(smmdd)//", which was encountered " &
1422 //"while attempting to read in "//squote( sinputitemname_l ) )
1423
1424 ! parse day value
1425 call chomp(sitem, sbuf, "/-")
1426 read(sbuf,*,iostat=istat) iday
1427 call assert(istat==0, "Problem reading day value from string "//trim(smmdd), &
1428 __file__,__line__, &
1429 shints="The offending string was "//squote(smmdd)//", which was encountered " &
1430 //"while attempting to read in "//squote( sinputitemname_l ) )
1431
1432 ! we do not really care about the year value here; any year value could have been used
1433 istartingjd = julian_day( 1999, 1, 1)
1434 ijd = julian_day( 1999, imonth, iday)
1435
1436 idoy = ijd - istartingjd + 1
1437
1438end function mmdd2doy
1439
1440!------------------------------------------------------------------------------
1441
1442
1443
1444!--------------------------------------------------------------------------
1445
1446function get_day_of_year_fn(this) result(iDOY)
1447
1448 class(datetime_t) :: this
1449 integer (c_int) :: idoy
1450
1451 idoy = day_of_year( int( this%dJulianDate, c_int) )
1452
1453end function get_day_of_year_fn
1454
1455!--------------------------------------------------------------------------
1456
1457function day_of_year(iJD) result(iDOY)
1458
1459 integer (c_int), value :: ijd
1460
1461 ! [ LOCALS ]
1462 integer (c_int) :: ifirstday, idoy
1463 integer (c_int) :: imonth, iday, iyear
1464
1465
1466 call gregorian_date(ijd, iyear, imonth, iday)
1467 ifirstday = julian_day( iyear, 1, 1 )
1468
1469 idoy = ijd - ifirstday + 1
1470
1471end function day_of_year
1472
1473!--------------------------------------------------------------------------
1474
1475function isleap(iYear) result(lResult)
1476
1477 integer (c_int), intent(in) :: iyear
1478 logical (c_bool) :: lresult
1479
1480 lresult = ( mod(iyear, 4) == 0 .and. mod(iyear, 100) /= 0 ) .or. &
1481 ( mod(iyear, 400) == 0 .and. iyear /= 0 )
1482
1483end function isleap
1484
1485!--------------------------------------------------------------------------
1486
1487end module datetime
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:48
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:981
datetime::system_time_to_date_sub
subroutine system_time_to_date_sub(this)
Definition datetime.F90:1089
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:1458
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:777
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:1008
datetime::get_fraction_of_day_fn
real(c_double) function get_fraction_of_day_fn(this)
Definition datetime.F90:1220
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:927
datetime::set_julian_date_sub
subroutine set_julian_date_sub(this, dvalue)
Return the number of days in the given year.
Definition datetime.F90:1195
datetime::date_plus_day_sub
subroutine date_plus_day_sub(this)
Definition datetime.F90:1355
datetime::is_date_less_than
logical(c_bool) function is_date_less_than(date1, date2)
Definition datetime.F90:754
datetime::is_date_equal_to
logical(c_bool) function is_date_equal_to(date1, date2)
Definition datetime.F90:809
datetime::mmdd2doy
integer(c_int) function, public mmdd2doy(smmdd, sinputitemname)
Definition datetime.F90:1393
datetime::date_set_day_sub
subroutine date_set_day_sub(this, newday)
Definition datetime.F90:1280
datetime::calc_gregorian_date_sub
subroutine calc_gregorian_date_sub(this)
Definition datetime.F90:503
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:1379
datetime::assign_value_to_sub
subroutine assign_value_to_sub(date2, date1)
Definition datetime.F90:880
datetime::date_minus_int_fn
type(datetime_t) function, allocatable date_minus_int_fn(date1, ivalue)
Definition datetime.F90:942
datetime::write_list_datetime_fn
character(len=19) function write_list_datetime_fn(this)
Definition datetime.F90:1019
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:409
datetime::date_minus_year_sub
subroutine date_minus_year_sub(this)
Definition datetime.F90:1340
datetime::iscandd1
integer(c_int), private iscandd1
Definition datetime.F90:120
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:969
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:793
datetime::gregorian_date
subroutine, public gregorian_date(ijd, iyear, imonth, iday, iorigin)
Definition datetime.F90:571
datetime::get_days_in_month_fn
integer(c_int) function get_days_in_month_fn(this)
Definition datetime.F90:1231
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:1304
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:912
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:1209
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:1367
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:832
datetime::isleap
logical(c_bool) function, public isleap(iyear)
Definition datetime.F90:1476
datetime::write_pretty_datetime_fn
character(len=20) function write_pretty_datetime_fn(this)
Definition datetime.F90:957
datetime::get_day_of_year_fn
integer(c_int) function get_day_of_year_fn(this)
Definition datetime.F90:1447
datetime::date_set_month_sub
subroutine date_set_month_sub(this, newmonth)
Definition datetime.F90:1292
datetime::julian_day
integer(c_int) function, public julian_day(iyear, imonth, iday, iorigin, sinputitemname)
Definition datetime.F90:641
datetime::iscansec2
integer(c_int), private iscansec2
Definition datetime.F90:133
datetime::get_days_in_year_fn
integer(c_int) function get_days_in_year_fn(this)
Definition datetime.F90:1250
datetime::date_advance_to_last_day_of_month_sub
subroutine date_advance_to_last_day_of_month_sub(this)
Definition datetime.F90:1316
datetime::is_date_greater_than
logical(c_bool) function is_date_greater_than(date1, date2)
Definition datetime.F90:731
datetime::date_minus_date_fn
real(c_double) function date_minus_date_fn(date1, date2)
Definition datetime.F90:900
datetime::calc_julian_day_sub
subroutine calc_julian_day_sub(this, imonth, iday, iyear, ihour, iminute, isecond)
Definition datetime.F90:471
datetime::date_plus_year_sub
subroutine date_plus_year_sub(this)
Definition datetime.F90:1265
logfiles::logs
type(logfile_t), public logs
Definition logfiles.F90:62
datetime::month_t
Container for month name and length information.
Definition datetime.F90:137