61 module time_manager_mod
64 use platform_mod,
only: r8_kind, r4_kind
65 use constants_mod,
only: rseconds_per_day=>seconds_per_day
75 public operator(+),
operator(-),
operator(*),
operator(/), &
76 operator(>),
operator(>=),
operator(==),
operator(/=), &
77 operator(<),
operator(<=),
operator(//),
assignment(=)
85 public thirty_day_months, julian, gregorian, noleap, no_calendar, invalid_calendar
115 public :: set_date_julian, set_date_no_leap, get_date_julian, get_date_no_leap
122 integer,
parameter :: THIRTY_DAY_MONTHS = 1, julian = 2, &
123 gregorian = 3, noleap = 4, &
124 no_calendar = 0, invalid_calendar =-1
125 integer,
private :: calendar_type = no_calendar
126 integer,
parameter :: max_type = 4
129 integer,
private :: days_per_month(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
130 integer,
parameter :: seconds_per_day = rseconds_per_day
132 integer,
parameter :: do_floor = 0
133 integer,
parameter :: do_nearest = 1
149 interface operator (+); module
procedure time_plus; end interface
152 interface operator (-); module
procedure time_minus; end interface
155 interface operator (*); module
procedure time_scalar_mult
159 interface operator (/); module
procedure time_scalar_divide
163 interface operator (>); module
procedure time_gt; end interface
166 interface operator (>=); module
procedure time_ge; end interface
169 interface operator (<); module
procedure time_lt; end interface
172 interface operator (<=); module
procedure time_le; end interface
175 interface operator (==); module
procedure time_eq; end interface
178 interface operator (/=); module
procedure time_ne; end interface
181 interface operator (//); module
procedure time_real_divide; end interface
184 interface assignment(=); module
procedure time_assignment; end interface
264 #include<file_version.h>
265 logical :: module_is_initialized = .false.
272 integer :: ticks_per_second = 1
302 integer,
intent(in) :: seconds, days, ticks
304 character(len=*),
intent(out) :: err_msg
305 integer :: seconds_new, days_new, ticks_new
307 seconds_new = seconds + floor(real(ticks, r8_kind)/real(ticks_per_second, r8_kind))
308 ticks_new = modulo(ticks,ticks_per_second)
309 days_new = days + floor(real(seconds_new, r8_kind)/real(seconds_per_day, r8_kind))
310 seconds_new = modulo(seconds_new,seconds_per_day)
312 if ( seconds_new < 0 .or. ticks_new < 0)
then
313 call error_mesg(
'function set_time_i',
'Bad result for time. Contact those responsible for maintaining time_manager'&
317 if(days_new < 0)
then
318 write(err_msg,
'(a,i6,a,i6,a,i6)')
'time is negative. days=',days_new,
' seconds=',seconds_new,
' ticks=',ticks_new
321 time_out%days = days_new
322 time_out%seconds = seconds_new
323 time_out%ticks = ticks_new
333 integer,
intent(in) :: seconds
334 integer,
intent(in),
optional :: days
335 integer,
intent(in),
optional :: ticks
336 character(len=*),
intent(out),
optional :: err_msg
342 character(len=128) :: err_msg_local
343 integer :: odays, oticks
347 odays = 0;
if(
present(days)) odays = days
348 oticks = 0;
if(
present(ticks)) oticks = ticks
349 if(
present(err_msg)) err_msg =
''
352 if(error_handler(
'function set_time_i', trim(err_msg_local), err_msg))
return
362 character(len=*),
intent(in) :: string
365 character(len=*),
intent(out),
optional :: err_msg
371 logical,
intent(in),
optional :: allow_rounding
375 character(len=4) :: formt=
'(i )'
376 integer :: i1, i2, i3, day, second, tick, nsps
377 character(len=32) :: string_sifted_left
378 character(len=128) :: err_msg_local
379 logical :: allow_rounding_local
382 if(
present(err_msg)) err_msg =
''
383 allow_rounding_local=.true.;
if(
present(allow_rounding)) allow_rounding_local=allow_rounding
385 err_msg_local =
'Form of character time stamp is incorrect. The character time stamp is: '//trim(string)
387 string_sifted_left = adjustl(string)
388 i1 = index(trim(string_sifted_left),
' ')
390 if(error_handler(
'function set_time_c', err_msg_local, err_msg))
return
392 if(index(string,
'-') /= 0 .or. index(string,
':') /= 0)
then
393 if(error_handler(
'function set_time_c', err_msg_local, err_msg))
return
396 i2 = index(trim(string_sifted_left),
'.')
397 i3 = len_trim(cut0(string_sifted_left))
402 if(error_handler(
'function set_time_c', err_msg_local, err_msg))
return
405 write(formt(3:3),
'(i1)') i1-1
406 read(string_sifted_left(1:i1-1),formt) day
409 write(formt(3:3),
'(i1)') i3-i1
410 read(string_sifted_left(i1+1:i3),formt) second
418 write(formt(3:3),
'(i1)') nsps
419 read(string_sifted_left(i1+1:i2-1),formt) second
422 if(.not.get_tick_from_string(string_sifted_left(i2:i3), err_msg_local, allow_rounding_local, tick))
then
423 if(error_handler(
'function set_time_c', err_msg_local, err_msg))
return
426 if(tick == ticks_per_second)
then
433 if(error_handler(
'function set_time_c', err_msg_local, err_msg))
return
439 function get_tick_from_string(string, err_msg, allow_rounding, tick)
441 logical :: get_tick_from_string
442 character(len=*),
intent(in) :: string
443 character(len=*),
intent(out) :: err_msg
444 logical,
intent(in) :: allow_rounding
445 integer,
intent(out) :: tick
447 character(len=4) :: formt=
'(i )'
448 integer :: i3, nspf, fraction, magnitude, tpsfrac
451 get_tick_from_string = .true.
452 i3 = len_trim(string)
457 write(formt(3:3),
'(i1)') nspf
458 read(string(2:i3),formt) fraction
459 if(fraction == 0)
then
463 tpsfrac = ticks_per_second*fraction
464 if(allow_rounding)
then
465 tick = nint((real(tpsfrac, r8_kind)/real(magnitude, r8_kind)))
467 if(modulo(tpsfrac,magnitude) == 0)
then
468 tick = tpsfrac/magnitude
470 write(err_msg,
'(a,i6)')
'Second fraction cannot be exactly represented with ticks. '// &
471 'fraction='//trim(string)//
' ticks_per_second=',ticks_per_second
472 get_tick_from_string = .false.
478 end function get_tick_from_string
490 subroutine get_time(Time, seconds, days, ticks, err_msg)
495 integer,
intent(out) :: seconds
496 integer,
intent(out),
optional :: days, ticks
497 character(len=*),
intent(out),
optional :: err_msg
498 character(len=128) :: err_msg_local
501 if(
present(err_msg)) err_msg =
''
503 seconds = time%seconds
505 if(
present(ticks))
then
508 if(time%ticks /= 0)
then
509 err_msg_local =
'subroutine get_time: ticks must be present when time has a second fraction'
510 if(error_handler(
'subroutine get_time', err_msg_local, err_msg))
return
514 if (
present(days))
then
517 if (time%days > (huge(seconds) - seconds)/seconds_per_day)
then
518 err_msg_local =
'Integer overflow in seconds. Optional argument days must be present.'
519 if(error_handler(
'subroutine get_time', err_msg_local, err_msg))
return
521 seconds = seconds + time%days * seconds_per_day
535 integer,
intent(in) :: seconds
536 integer,
intent(in),
optional :: days, ticks
537 character(len=*),
intent(out),
optional :: err_msg
540 logical,
intent(in),
optional :: allow_neg_inc
542 integer :: odays, oticks
543 character(len=128) :: err_msg_local
544 logical :: allow_neg_inc_local
546 odays = 0;
if(
present(days)) odays = days
547 oticks = 0;
if(
present(ticks)) oticks = ticks
548 allow_neg_inc_local=.true.;
if(
present(allow_neg_inc)) allow_neg_inc_local=allow_neg_inc
550 if(.not.allow_neg_inc_local)
then
551 if(seconds < 0 .or. odays < 0 .or. oticks < 0)
then
552 write(err_msg_local,10) seconds, odays, oticks
553 10
format(
'One or more time increments are negative: seconds=',i6,
' days=',i6,
' ticks=',i6)
554 if(error_handler(
'function increment_time', err_msg_local, err_msg))
return
559 if(error_handler(
'function increment_time', err_msg_local, err_msg))
return
571 integer,
intent(in) :: seconds, days, ticks
573 character(len=*),
intent(out) :: err_msg
576 if(days >= huge(days) - time_in%days)
then
577 err_msg =
'Integer overflow in days in increment_time'
581 if(seconds >= huge(seconds) - time_in%seconds)
then
582 err_msg =
'Integer overflow in seconds in increment_time'
605 integer,
intent(in) :: seconds
606 integer,
intent(in),
optional :: days, ticks
607 character(len=*),
intent(out),
optional :: err_msg
609 logical,
intent(in),
optional :: allow_neg_inc
613 integer :: odays, oticks
614 character(len=128) :: err_msg_local
615 logical :: allow_neg_inc_local
617 odays = 0;
if (
present(days)) odays = days
618 oticks = 0;
if (
present(ticks)) oticks = ticks
619 allow_neg_inc_local=.true.;
if(
present(allow_neg_inc)) allow_neg_inc_local=allow_neg_inc
621 if(.not.allow_neg_inc_local)
then
622 if(seconds < 0 .or. odays < 0 .or. oticks < 0)
then
623 write(err_msg_local,10) seconds,odays,oticks
624 10
format(
'One or more time increments are negative: seconds=',i6,
' days=',i6,
' ticks=',i6)
625 if(error_handler(
'function decrement_time', err_msg_local, err_msg))
return
630 if(error_handler(
'function decrement_time', err_msg_local, err_msg))
return
638 function time_gt(time1, time2)
644 time_gt = (time1%days > time2%days)
645 if(time1%days == time2%days)
then
646 if(time1%seconds == time2%seconds)
then
647 time_gt = (time1%ticks > time2%ticks)
649 time_gt = (time1%seconds > time2%seconds)
658 function time_ge(time1, time2)
663 time_ge = (time_gt(time1, time2) .or. time_eq(time1, time2))
670 function time_lt(time1, time2)
675 time_lt = (time1%days < time2%days)
676 if(time1%days == time2%days)
then
677 if(time1%seconds == time2%seconds)
then
678 time_lt = (time1%ticks < time2%ticks)
680 time_lt = (time1%seconds < time2%seconds)
688 function time_le(time1, time2)
693 time_le = (time_lt(time1, time2) .or. time_eq(time1, time2))
700 function time_eq(time1, time2)
707 time_eq = (time1%seconds == time2%seconds .and. time1%days == time2%days &
708 .and. time1%ticks == time2%ticks)
715 function time_ne(time1, time2)
720 time_ne = (.not. time_eq(time1, time2))
727 function time_plus(time1, time2)
734 time_plus =
increment_time(time1, time2%seconds, time2%days, time2%ticks)
736 end function time_plus
742 function time_minus(time1, time2)
749 if(time1 > time2)
then
750 time_minus =
decrement_time(time1, time2%seconds, time2%days, time2%ticks)
752 time_minus =
decrement_time(time2, time1%seconds, time1%days, time1%ticks)
755 end function time_minus
763 integer,
intent(in) :: n
764 integer :: days, seconds, ticks, num_sec
765 real(r8_kind) :: sec_prod, tick_prod
774 tick_prod = real(time%ticks, r8_kind) * real(n, r8_kind)
775 num_sec = int(tick_prod/real(ticks_per_second, r8_kind))
776 sec_prod = real(time%seconds, r8_kind) * real(n, r8_kind) + real(num_sec, r8_kind)
777 ticks = int(tick_prod) - (num_sec * ticks_per_second)
784 if(sec_prod /= 0.0_r8_kind)
then
785 if(log10(sec_prod) > precision(sec_prod) - 3)
call error_mesg(
'time_scalar_mult', &
786 'Insufficient precision to handle scalar product in time_scalar_mult; contact developer',fatal)
789 days = int(sec_prod / real(seconds_per_day, r8_kind))
790 seconds = int(sec_prod - real(days, r8_kind) * real(seconds_per_day, r8_kind))
803 integer,
intent(in) :: n
817 real(r8_kind) :: d1, d2
822 d1 = real(time1%days, r8_kind) * real(seconds_per_day, r8_kind) + real(time1%seconds, r8_kind) &
823 + real(time1%ticks, r8_kind)/real(ticks_per_second, r8_kind)
824 d2 = real(time2%days, r8_kind) * real(seconds_per_day, r8_kind) + real(time2%seconds, r8_kind) &
825 + real(time2%ticks,r8_kind)/real(ticks_per_second, r8_kind)
832 call error_mesg(
'time_divide',
' quotient error :: notify developer',fatal)
837 function time_real_divide(time1, time2)
839 real(r8_kind) :: time_real_divide
842 real(r8_kind) :: d1, d2
847 d1 = real(time1%days, r8_kind) * real(seconds_per_day, r8_kind) + real(time1%seconds, r8_kind) + &
848 real(time1%ticks, r8_kind)/
real(ticks_per_second, r8_kind)
849 d2 = real(time2%days, r8_kind) * real(seconds_per_day, r8_kind) + real(time2%seconds, r8_kind) + &
850 real(time2%ticks, r8_kind)/
real(ticks_per_second, r8_kind)
852 time_real_divide = d1 / d2
854 end function time_real_divide
860 subroutine time_assignment(time1, time2)
863 time1%seconds = time2%seconds
864 time1%days = time2%days
865 time1%ticks = time2%ticks
866 end subroutine time_assignment
876 time_type_to_real = real(time%days, r8_kind) * 86400.e0_r8_kind + real(time%seconds, r8_kind) + &
877 real(time%ticks, r8_kind)/
real(ticks_per_second, r8_kind)
885 real(r8_kind),
intent(in) :: x
886 character(len=*),
intent(out),
optional :: err_msg
891 character(len=128) :: err_msg_local
892 real(r8_kind),
parameter :: spd = 86400.0_r8_kind
895 tps = real(ticks_per_second, r8_kind)
898 a = x - real(days, r8_kind)*spd
900 a = (a - real(seconds, r8_kind))*tps
903 if (error_handler(
'function real8_to_time_type',err_msg_local,err_msg))
then
910 real(r4_kind),
intent(in) :: x
911 character(len=*),
intent(out),
optional :: err_msg
919 real(r8_kind),
intent(in) :: rval
920 integer,
intent(in) :: mode
924 big = real(huge(ival), r8_kind)
925 if (rval .le. big .and. -1.0_r8_kind*rval .ge. -1.0_r8_kind*big)
then
926 if (mode .eq. do_floor)
then
928 elseif (mode .eq. do_nearest)
then
931 call error_mesg(
"safe_rtoi",
"mode must be either do_floor" &
932 //
" or do_nearest.",fatal)
935 call error_mesg(
"safe_rtoi",
"input value cannot be safely" &
936 //
" converted to a 32-bit integer.",fatal)
946 integer,
intent(in) :: n
947 real(r8_kind) :: d, div, dseconds_per_day, dticks_per_second
948 integer :: days, seconds, ticks
950 character(len=128) tmp1,tmp2
954 dseconds_per_day = real(seconds_per_day, r8_kind)
955 dticks_per_second = real(ticks_per_second, r8_kind)
956 d = real(time%days,r8_kind)*dseconds_per_day*dticks_per_second + real(time%seconds, r8_kind)*dticks_per_second + &
957 real(time%ticks, r8_kind)
958 div = d/real(n, r8_kind)
960 days = int(div/(dseconds_per_day*dticks_per_second))
961 seconds = int(div/dticks_per_second - real(days, r8_kind)*dseconds_per_day)
962 ticks = int(div - (real(days, r8_kind)*dseconds_per_day + real(seconds, r8_kind))*dticks_per_second)
968 if(prod1 > time .or. prod2 <= time)
then
969 call get_time(time, seconds, days, ticks)
970 write(tmp1,20) days,seconds,ticks
972 write(tmp2,30) n,days,seconds,ticks
973 ltmp = error_handler(
'time_scalar_divide',
' quotient error:'//trim(tmp1)//trim(tmp2))
974 20
format(
'time=',i7,
' days, ',i6,
' seconds, ',i6,
' ticks')
975 30
format(
' time divided by',i6,
'=',i7,
' days, ',i6,
' seconds, ',i6,
' ticks')
1002 type(
time_type),
intent(in) :: time_interval
1003 type(
time_type),
intent(in) :: alarm_interval
1007 if((alarm - time) <= (time_interval / 2))
then
1009 alarm = alarm + alarm_interval
1027 type(
time_type),
intent(in) :: alarm_frequency
1028 type(
time_type),
intent(in) :: alarm_length
1031 prev = (time / alarm_frequency) * alarm_frequency
1032 next = prev + alarm_frequency
1033 if(time - prev <= alarm_length / 2 .or. next - time <= alarm_length / 2)
then
1077 integer,
intent(in) ::
type
1078 character(len=*),
intent(out),
optional :: err_msg
1079 character(len=256) :: err_msg_local
1083 if(
present(err_msg)) err_msg =
''
1085 if(
type < 0 .or. type > max_type)
then
1086 err_msg_local =
'Illegal calendar type'
1087 if(error_handler(
'subroutine set_calendar_type', err_msg_local, err_msg))
return
1090 if(seconds_per_day /= 86400 .and.
type /= no_calendar )
then
1091 err_msg_local =
'Only calendar type NO_CALENDAR is allowed when seconds_per_day is not 86400.'// &
1093 write(err_msg_local(len_trim(err_msg_local)+1:len_trim(err_msg_local)+8),
'(i8)') seconds_per_day
1094 if(error_handler(
'subroutine set_calendar_type', err_msg_local, err_msg))
return
1097 calendar_type =
type
1116 integer,
intent(in) :: tps
1118 ticks_per_second = tps
1144 subroutine get_date(time, year, month, day, hour, minute, second, tick, err_msg)
1149 integer,
intent(out) :: second, minute, hour, day, month, year
1150 integer,
intent(out),
optional :: tick
1151 character(len=*),
intent(out),
optional :: err_msg
1152 character(len=128) :: err_msg_local
1156 if(
present(err_msg)) err_msg =
''
1158 select case(calendar_type)
1159 case(thirty_day_months)
1160 call get_date_thirty(time, year, month, day, hour, minute, second, tick1)
1166 call get_date_no_leap_private(time, year, month, day, hour, minute, second, tick1)
1168 err_msg_local =
'Cannot produce a date when the calendar type is NO_CALENDAR'
1169 if(error_handler(
'subroutine get_date', err_msg_local, err_msg))
return
1171 err_msg_local =
'Invalid calendar type'
1172 if(error_handler(
'subroutine get_date', err_msg_local, err_msg))
return
1175 if(
present(tick))
then
1179 err_msg_local =
'tick must be present when time has a second fraction'
1180 if(error_handler(
'subroutine get_date', err_msg_local, err_msg))
return
1193 integer,
intent(out) :: year, month, day, hour, minute, second
1194 integer,
intent(out) :: tick
1195 integer :: iday, isec
1198 integer :: ncenturies
1200 integer :: yearx, monthx, dayx, idayx
1206 if(time%seconds >= 86400)
then
1207 call error_mesg(
'get_date',.ge.
'Time%seconds 86400 in subroutine get_date_gregorian',fatal)
1214 if( iday.eq.0 )
then
1217 else if( iday.gt.365 )
then
1218 yearx = int(iday/365) - 1
1219 ncenturies = int(yearx/100)
1220 nlpyrs = int((yearx-ncenturies*100)/4)
1221 idayx = ncenturies*36524 + (yearx-ncenturies*100)*365 + nlpyrs
1222 if( ncenturies.eq.4 ) idayx = idayx + 1
1223 l = 0 ;
if ( leap_year_gregorian_int(yearx+1) ) l = 1
1224 if ( (iday-idayx).gt.365+l )
then
1226 idayx = idayx + 365 + l
1233 l = 0 ;
if( leap_year_gregorian_int(year) ) l = 1
1235 if( dayx.le.31 )
then
1239 monthx = int(dayx/30)
1242 dayx = dayx - days_per_month(i)
1243 if(i.eq.2) dayx = dayx - l
1247 dayx = dayx - days_per_month(i)
1252 if( dayx.le.0 )
then
1254 day = dayx + days_per_month(monthx)
1255 if(monthx.eq.2) day = day + l
1259 hour = time%seconds / 3600
1260 isec = time%seconds - 3600*hour
1262 second = isec - 60*minute
1268 function cut0(string)
1269 character(len=256) :: cut0
1270 character(len=*),
intent(in) :: string
1276 if(ichar(string(i:i)) == 0 )
then
1291 integer,
intent(out) :: second, minute, hour, day, month, year
1292 integer,
intent(out) :: tick
1293 integer :: m, t, nfour, nex, days_this_month
1297 nfour = time%days / (4 * 365 + 1)
1298 day = modulo(time%days, (4 * 365 + 1))
1306 day=modulo(day, 365) + 1
1312 year = 1 + 4 * nfour + nex
1317 days_this_month = days_per_month(m)
1318 if(leap .and. m == 2) days_this_month = 29
1319 if(day <= days_this_month)
exit
1320 day = day - days_this_month
1325 hour = t / (60 * 60)
1326 t = t - hour * (60 * 60)
1328 second = t - 60 * minute
1333 subroutine get_date_julian(time, year, month, day, hour, minute, second)
1339 integer,
intent(out) :: second, minute, hour, day, month, year
1344 end subroutine get_date_julian
1354 integer,
intent(out) :: second, minute, hour, day, month, year
1355 integer,
intent(out) :: tick
1356 integer :: t, dmonth, dyear
1359 dyear = t / (30 * 12)
1361 t = t - dyear * (30 * 12)
1364 day = t -dmonth * 30 + 1
1367 hour = t / (60 * 60)
1368 t = t - hour * (60 * 60)
1370 second = t - 60 * minute
1376 subroutine get_date_no_leap_private(time, year, month, day, hour, minute, second, tick)
1381 integer,
intent(out) :: second, minute, hour, day, month, year
1382 integer,
intent(out) :: tick
1386 year = time%days / 365 + 1
1387 day = modulo(time%days, 365) + 1
1392 if(day <= days_per_month(m))
exit
1393 day = day - days_per_month(m)
1398 hour = t / (60 * 60)
1399 t = t - hour * (60 * 60)
1401 second = t - 60 * minute
1404 end subroutine get_date_no_leap_private
1407 subroutine get_date_no_leap(time, year, month, day, hour, minute, second)
1413 integer,
intent(out) :: second, minute, hour, day, month, year
1416 call get_date_no_leap_private(time, year, month, day, hour, minute, second, tick)
1418 end subroutine get_date_no_leap
1434 integer,
intent(in) :: year, month, day, hour, minute, second, tick
1436 character(len=*),
intent(out) :: err_msg
1442 select case(calendar_type)
1443 case(thirty_day_months)
1444 set_date_private = set_date_thirty(year, month, day, hour, minute, second, tick, time_out, err_msg)
1448 set_date_private = set_date_julian_private(year, month, day, hour, minute, second, tick, time_out, err_msg)
1450 set_date_private = set_date_no_leap_private(year, month, day, hour, minute, second, tick, time_out, err_msg)
1452 err_msg =
'Cannot produce a date when calendar type is NO_CALENDAR'
1455 err_msg =
'Invalid calendar type'
1464 function set_date_i(year, month, day, hour, minute, second, tick, err_msg)
1466 integer,
intent(in) :: day, month, year
1467 integer,
intent(in),
optional :: second, minute, hour, tick
1468 character(len=*),
intent(out),
optional :: err_msg
1469 integer :: osecond, ominute, ohour, otick
1470 character(len=128) :: err_msg_local
1473 if(
present(err_msg)) err_msg =
''
1476 osecond = 0;
if(
present(second)) osecond = second
1477 ominute = 0;
if(
present(minute)) ominute = minute
1478 ohour = 0;
if(
present(hour)) ohour = hour
1479 otick = 0;
if(
present(tick)) otick = tick
1482 if(error_handler(
'function set_date_i', err_msg_local, err_msg))
return
1507 function set_date_c(string, zero_year_warning, err_msg, allow_rounding)
1509 character(len=*),
intent(in) :: string
1510 logical,
intent(in),
optional :: zero_year_warning
1511 character(len=*),
intent(out),
optional :: err_msg
1512 logical,
intent(in),
optional :: allow_rounding
1513 character(len=4) :: formt=
'(i )'
1514 logical :: correct_form, zero_year_warning_local, allow_rounding_local
1515 integer :: i1, i2, i3, i4, i5, i6, i7
1516 character(len=32) :: string_sifted_left
1517 integer :: year, month, day, hour, minute, second, tick
1518 character(len=128) :: err_msg_local
1521 if(
present(err_msg)) err_msg =
''
1522 if(
present(zero_year_warning))
then
1523 zero_year_warning_local = zero_year_warning
1525 zero_year_warning_local = .true.
1527 if(
present(allow_rounding))
then
1528 allow_rounding_local = allow_rounding
1530 allow_rounding_local = .true.
1533 string_sifted_left = adjustl(string)
1534 i1 = index(string_sifted_left,
'-')
1535 i2 = index(string_sifted_left,
'-',back=.true.)
1536 i3 = index(string_sifted_left,
':')
1537 i4 = index(string_sifted_left,
':',back=.true.)
1538 i5 = len_trim(cut0(string_sifted_left))
1539 i6 = index(string_sifted_left,
'.',back=.true.)
1540 correct_form = (i1 > 1)
1541 correct_form = correct_form .and. (i2-i1 == 2 .or. i2-i1 == 3)
1542 if(.not.correct_form)
then
1543 err_msg_local =
'Form of character time stamp is incorrect. The character time stamp is: '//trim(string)
1544 if(error_handler(
'function set_date_c', err_msg_local, err_msg))
return
1546 write(formt(3:3),
'(i1)') i1-1
1547 read(string_sifted_left(1:i1-1),formt) year
1550 if(zero_year_warning_local)
then
1551 call error_mesg(
'set_date_c',
'Year zero is invalid. Resetting year to 1', warning)
1554 write(formt(3:3),
'(i1)') i2-i1-1
1555 read(string_sifted_left(i1+1:i2-1),formt) month
1557 read(string_sifted_left(i2+1:i7),
'(i2)') day
1569 read(string_sifted_left(i5-1:i5),
'(i2)') hour
1571 else if(i3 == i4)
then
1573 read(string_sifted_left(i3-2:i3-1),
'(i2)') hour
1574 write(formt(3:3),
'(i1)') i5-i3
1575 read(string_sifted_left(i3+1:i5),formt) minute
1580 read(string_sifted_left(i3-2:i3-1),
'(i2)') hour
1581 write(formt(3:3),
'(i1)') i4-i3-1
1582 read(string_sifted_left(i3+1:i4-1),formt) minute
1583 write(formt(3:3),
'(i1)') i5-i4
1586 read(string_sifted_left(i4+1:i5),formt) second
1589 read(string_sifted_left(i4+1:i6-1),formt) second
1590 if(.not.get_tick_from_string(string_sifted_left(i6:i5), err_msg_local, allow_rounding_local, tick))
then
1591 if(error_handler(
'function set_date_c', err_msg_local, err_msg))
return
1594 if(tick == ticks_per_second)
then
1602 if(error_handler(
'function set_date_c', err_msg_local, err_msg))
return
1616 integer,
intent(in) :: year, month, day, hour, minute, second, tick
1617 type(
time_type),
intent(out) :: time_out
1618 character(len=*),
intent(out) :: err_msg
1619 integer :: yearx, monthx, dayx, hrx, minx, secx, tickx, ncenturies, nlpyrs, l
1621 if( .not.valid_increments(year,month,day,hour,minute,second,tick,err_msg) )
then
1626 l = 0 ;
if( leap_year_gregorian_int(year) ) l = 1
1630 if(day.gt.days_per_month(month)+l .or. day.lt.1)
then
1631 err_msg =
'Invalid_date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second)
1636 if(day.gt.days_per_month(month) .or. day.lt.1)
then
1637 err_msg =
'Invalid_date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second)
1643 time_out%seconds = second + 60*(minute + 60*hour)
1645 yearx = mod(year-1,400)
1648 ncenturies = int( yearx/100 )
1649 nlpyrs = int( (yearx-ncenturies*100)/4 )
1650 dayx = ncenturies*36524 + (yearx-ncenturies*100)*365 + nlpyrs
1652 if(ncenturies.eq.4) dayx = dayx + 1
1655 select case( month )
1656 case(1) ; dayx = dayx
1657 case(2) ; dayx = dayx + 31
1658 case(3) ; dayx = dayx + 59 + l
1659 case(4) ; dayx = dayx + 90 + l
1660 case(5) ; dayx = dayx + 120 + l
1661 case(6) ; dayx = dayx + 151 + l
1662 case(7) ; dayx = dayx + 181 + l
1663 case(8) ; dayx = dayx + 212 + l
1664 case(9) ; dayx = dayx + 243 + l
1665 case(10) ; dayx = dayx + 273 + l
1666 case(11) ; dayx = dayx + 304 + l
1667 case(12) ; dayx = dayx + 334 + l
1671 time_out%days = dayx
1672 time_out%ticks = tick
1678 yearx = year ; monthx = month ; dayx = day
1679 hrx = hour ; minx = minute ; secx = second ; tickx = tick
1681 l = 0 ;
if( leap_year_gregorian_int(yearx) ) l = 1
1682 if( monthx.lt.1 .or. monthx.gt.12 )
then
1683 err_msg =
'Invalid_date. Date='//convert_integer_date_to_char(yearx,monthx,dayx,hour,minute,second)
1685 else if( dayx.lt.1 .or. dayx.gt.days_per_month(monthx) )
then
1686 if( monthx.eq.2 .and. dayx.le.days_per_month(monthx)+l )
return
1687 err_msg =
'Invalid_date. Date='//convert_integer_date_to_char(yearx,monthx,dayx,hour,minute,second)
1695 function set_date_julian_private(year, month, day, hour, minute, second, tick, Time_out, err_msg)
1696 logical :: set_date_julian_private
1700 integer,
intent(in) :: year, month, day, hour, minute, second, tick
1701 type(
time_type),
intent(out) :: time_out
1702 character(len=*),
intent(out) :: err_msg
1703 integer :: ndays, m, nleapyr
1706 if( .not.valid_increments(year,month,day,hour,minute,second,tick,err_msg) )
then
1707 set_date_julian_private = .false.
1711 if(month /= 2 .and. day > days_per_month(month))
then
1712 err_msg =
'Invalid date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second)
1713 set_date_julian_private = .false.
1718 leap = (modulo(year,4) == 0)
1720 nleapyr = (year - 1) / 4
1723 if(month == 2 .and. (day > 29 .or. ((.not. leap) .and. day > 28)))
then
1724 err_msg =
'Invalid date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second)
1725 set_date_julian_private = .false.
1731 ndays = ndays + days_per_month(m)
1732 if(leap .and. m == 2) ndays = ndays + 1
1735 time_out%seconds = second + 60 * (minute + 60 * hour)
1736 time_out%days = day -1 + ndays + 365*(year - nleapyr - 1) + 366*(nleapyr)
1737 time_out%ticks = tick
1739 set_date_julian_private = .true.
1741 end function set_date_julian_private
1744 function set_date_julian(year, month, day, hour, minute, second)
1750 integer,
intent(in) :: year, month, day, hour, minute, second
1751 character(len=128) :: err_msg
1753 if(.not.set_date_julian_private(year, month, day, hour, minute, second, 0, set_date_julian, err_msg))
then
1754 call error_mesg(
'set_date_julian',trim(err_msg),fatal)
1757 end function set_date_julian
1760 function set_date_thirty(year, month, day, hour, minute, second, tick, Time_out, err_msg)
1761 logical :: set_date_thirty
1765 integer,
intent(in) :: year, month, day, hour, minute, second, tick
1766 type(
time_type),
intent(out) :: time_out
1767 character(len=*),
intent(out) :: err_msg
1769 if( .not.valid_increments(year,month,day,hour,minute,second,tick,err_msg) )
then
1770 set_date_thirty = .false.
1775 err_msg =
'Invalid date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second)
1776 set_date_thirty = .false.
1780 time_out%days = (day - 1) + 30 * ((month - 1) + 12 * (year - 1))
1781 time_out%seconds = second + 60 * (minute + 60 * hour)
1782 time_out%ticks = tick
1784 set_date_thirty = .true.
1786 end function set_date_thirty
1790 function set_date_no_leap_private(year, month, day, hour, minute, second, tick, Time_out, err_msg)
1791 logical :: set_date_no_leap_private
1795 integer,
intent(in) :: year, month, day, hour, minute, second, tick
1796 type(
time_type),
intent(out) :: time_out
1797 character(len=*),
intent(out) :: err_msg
1800 if( .not.valid_increments(year,month,day,hour,minute,second,tick,err_msg) )
then
1801 set_date_no_leap_private = .false.
1805 if(day > days_per_month(month))
then
1806 err_msg =
'Invalid date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second)
1807 set_date_no_leap_private = .false.
1813 ndays = ndays + days_per_month(m)
1817 time_out =
set_time(second + 60 * (minute + 60 * hour), day -1 + ndays + 365 * (year - 1), tick)
1819 set_date_no_leap_private = .true.
1821 end function set_date_no_leap_private
1824 function set_date_no_leap(year, month, day, hour, minute, second)
1830 integer,
intent(in) :: year, month, day, hour, minute, second
1831 character(len=128) :: err_msg
1833 if(.not.set_date_no_leap_private(year, month, day, hour, minute, second, 0, set_date_no_leap, err_msg))
then
1834 call error_mesg(
'set_date_no_leap',trim(err_msg),fatal)
1837 end function set_date_no_leap
1841 function valid_increments(year, month, day, hour, minute, second, tick, err_msg)
1842 logical :: valid_increments
1843 integer,
intent(in) :: year, month, day, hour, minute, second, tick
1844 character(len=128),
intent(out) :: err_msg
1849 valid_increments = .true.
1850 if(second > 59 .or. second < 0 .or. minute > 59 .or. minute < 0 &
1851 .or. hour > 23 .or. hour < 0 .or. day > 31 .or. day < 1 &
1852 .or. month > 12 .or. month < 1 .or. year < 1)
then
1853 err_msg =
'Invalid date. Date='//convert_integer_date_to_char(year,month,day,hour,minute,second)
1854 valid_increments = .false.
1857 if(tick < 0 .or. tick >= ticks_per_second)
then
1858 write(err_msg,
'(a,i6)')
'Invalid number of ticks. tick=',tick
1859 valid_increments = .false.
1862 end function valid_increments
1866 function convert_integer_date_to_char(year, month, day, hour, minute, second)
1867 character(len=19) :: convert_integer_date_to_char
1868 integer,
intent(in) :: year, month, day
1869 integer,
intent(in) :: hour, minute, second
1871 write(convert_integer_date_to_char,10) year,month,day,hour,minute,second
1872 10
format(i4.4,
'-', i2.2,
'-', i2.2,
' ', i2.2,
':', i2.2,
':', i2.2)
1874 end function convert_integer_date_to_char
1927 function increment_date(Time, years, months, days, hours, minutes, seconds, ticks, err_msg, allow_neg_inc)
1941 integer,
intent(in),
optional :: years, months, days, hours, minutes, seconds, ticks
1942 character(len=*),
intent(out),
optional :: err_msg
1943 logical,
intent(in),
optional :: allow_neg_inc
1945 integer :: oyears, omonths, odays, ohours, ominutes, oseconds, oticks
1946 character(len=128) :: err_msg_local
1947 logical :: allow_neg_inc_local
1950 if(
present(err_msg)) err_msg =
''
1953 oseconds = 0;
if(
present(seconds)) oseconds = seconds
1954 ominutes = 0;
if(
present(minutes)) ominutes = minutes
1955 ohours = 0;
if(
present(hours)) ohours = hours
1956 odays = 0;
if(
present(days)) odays = days
1957 omonths = 0;
if(
present(months)) omonths = months
1958 oyears = 0;
if(
present(years)) oyears = years
1959 oticks = 0;
if(
present(ticks)) oticks = ticks
1960 allow_neg_inc_local=.true.;
if(
present(allow_neg_inc)) allow_neg_inc_local=allow_neg_inc
1962 if(.not.allow_neg_inc_local)
then
1963 if(oyears < 0 .or. omonths < 0 .or. odays < 0 .or. ohours < 0 .or. ominutes < 0 .or. oseconds < 0 .or. &
1965 write(err_msg_local,10) oyears, omonths, odays, ohours, ominutes, oseconds, oticks
1966 if(error_handler(
'function increment_time', err_msg_local, err_msg))
return
1969 10
format(
'One or more time increments are negative: '// &
1970 'years=',i6,
' months=',i6,
' days=',i6,
' hours=',i6,
' minutes=',i6,
' seconds=',i6,
' ticks=',i6)
1973 time, oyears, omonths, odays, ohours, ominutes, oseconds, oticks, increment_date, err_msg_local))
then
1974 if(error_handler(
'function increment_date', err_msg_local, err_msg))
return
1977 end function increment_date
1997 integer,
intent(in) :: years, months, days, hours, minutes, seconds, ticks
1998 type(
time_type),
intent(out) :: time_out
1999 character(len=*),
intent(out) :: err_msg
2000 integer :: cyear , cmonth , cday , chour , cminute , csecond , ctick
2001 logical :: mode_1, mode_2
2006 mode_1 = days /= 0 .or. hours /= 0 .or. minutes /= 0 .or. seconds /= 0 .or. ticks /= 0
2007 mode_2 = years /= 0 .or. months /= 0
2009 if(.not.mode_1 .and. .not.mode_2)
then
2015 if(mode_1 .and. mode_2)
then
2016 err_msg =
'years and/or months must not be incremented with other time units'
2022 csecond = seconds + 60 * (minutes + 60 * hours)
2028 select case(calendar_type)
2029 case(thirty_day_months)
2030 call get_date_thirty (time, cyear, cmonth, cday, chour, cminute, csecond, ctick)
2032 call get_date_no_leap_private (time, cyear, cmonth, cday, chour, cminute, csecond, ctick)
2038 err_msg =
'Cannot increment a date when the calendar type is NO_CALENDAR'
2042 err_msg =
'Invalid calendar type'
2048 cmonth = cmonth + months
2051 cyear = cyear + floor(real(cmonth-1,r8_kind)/12.0_r8_kind)
2052 cmonth = modulo((cmonth-1),12) + 1
2055 cyear = cyear + years
2058 select case(calendar_type)
2059 case(thirty_day_months)
2060 increment_date_private = set_date_thirty(cyear, cmonth, cday, chour, cminute, csecond, ctick, time_out, err_msg)
2063 & time_out, err_msg)
2066 & time_out, err_msg)
2088 function decrement_date(Time, years, months, days, hours, minutes, seconds, ticks, err_msg, allow_neg_inc)
2092 integer,
intent(in),
optional :: seconds, minutes, hours, days, months, years, ticks
2095 character(len=*),
intent(out),
optional :: err_msg
2096 logical,
intent(in),
optional :: allow_neg_inc
2098 integer :: oseconds, ominutes, ohours, odays, omonths, oyears, oticks
2099 character(len=128) :: err_msg_local
2100 logical :: allow_neg_inc_local
2102 if(
present(err_msg)) err_msg =
''
2105 oseconds = 0;
if(
present(seconds)) oseconds = seconds
2106 ominutes = 0;
if(
present(minutes)) ominutes = minutes
2107 ohours = 0;
if(
present(hours)) ohours = hours
2108 odays = 0;
if(
present(days)) odays = days
2109 omonths = 0;
if(
present(months)) omonths = months
2110 oyears = 0;
if(
present(years)) oyears = years
2111 oticks = 0;
if(
present(ticks)) oticks = ticks
2112 allow_neg_inc_local=.true.;
if(
present(allow_neg_inc)) allow_neg_inc_local=allow_neg_inc
2114 if(.not.allow_neg_inc_local)
then
2115 if(oyears < 0 .or. omonths < 0 .or. odays < 0 .or. ohours < 0 .or. ominutes < 0 .or. oseconds < 0 .or. &
2117 write(err_msg_local,10) oyears, omonths, odays, ohours, ominutes, oseconds, oticks
2118 if(error_handler(
'function decrement_date', err_msg_local, err_msg))
return
2121 10
format(
'One or more time increments are negative: '// &
2122 'years=',i6,
' months=',i6,
' days=',i6,
' hours=',i6,
' minutes=',i6,
' seconds=',i6,
' ticks=',i6)
2125 time, -oyears, -omonths, -odays, -ohours, -ominutes, -oseconds, -oticks,
decrement_date, err_msg_local))
then
2126 if(error_handler(
'function decrement_date', err_msg_local, err_msg))
return
2138 character(len=*),
intent(out),
optional :: err_msg
2141 if(
present(err_msg)) err_msg =
''
2143 select case(calendar_type)
2144 case(thirty_day_months)
2153 if(error_handler(
'function days_in_month', &
2154 'days_in_month makes no sense when the calendar type is NO_CALENDAR', err_msg))
return
2156 if(error_handler(
'function days_in_month',
'Invalid calendar type', err_msg))
return
2166 integer :: year, month, day, hour, minute, second, ticks
2180 integer :: year, month, day, hour, minute, second, ticks
2206 integer :: year, month, day, hour, minute, second, ticks
2208 call get_date_no_leap_private(time, year, month, day, hour, minute, second, ticks)
2218 character(len=*),
intent(out),
optional :: err_msg
2221 if(
present(err_msg)) err_msg=
''
2223 select case(calendar_type)
2224 case(thirty_day_months)
2233 if(error_handler(
'function leap_year',
'Invalid calendar type in leap_year', err_msg))
return
2239 function leap_year_gregorian(Time)
2243 logical :: leap_year_gregorian
2245 integer :: seconds, minutes, hours, day, month, year
2247 call get_date(time, year, month, day, hours, minutes, seconds)
2248 leap_year_gregorian = leap_year_gregorian_int(year)
2250 end function leap_year_gregorian
2254 function leap_year_gregorian_int(year)
2255 logical :: leap_year_gregorian_int
2256 integer,
intent(in) :: year
2258 leap_year_gregorian_int = mod(year,4) == 0
2259 leap_year_gregorian_int = leap_year_gregorian_int .and. .not.mod(year,100) == 0
2260 leap_year_gregorian_int = leap_year_gregorian_int .or. mod(year,400) == 0
2262 end function leap_year_gregorian_int
2270 integer :: seconds, minutes, hours, day, month, year
2272 call get_date(time, year, month, day, hours, minutes, seconds)
2310 select case(calendar_type)
2311 case(thirty_day_months)
2320 call error_mesg(
'length_of_year',
'Invalid calendar type in length_of_year',fatal)
2326 function length_of_year_thirty()
2328 type(
time_type) :: length_of_year_thirty
2330 length_of_year_thirty =
set_time(0, 360)
2332 end function length_of_year_thirty
2336 function length_of_year_gregorian()
2338 type(
time_type) :: length_of_year_gregorian
2340 length_of_year_gregorian =
set_time(20952, 365)
2342 end function length_of_year_gregorian
2346 function length_of_year_julian()
2348 type(
time_type) :: length_of_year_julian
2350 length_of_year_julian =
set_time(21600, 365)
2352 end function length_of_year_julian
2356 function length_of_year_no_leap()
2358 type(
time_type) :: length_of_year_no_leap
2360 length_of_year_no_leap =
set_time(0, 365)
2362 end function length_of_year_no_leap
2371 integer :: second, minute, hour, day, month, year
2374 call get_date(time,year,month,day,hour,minute,second)
2391 select case(calendar_type)
2392 case(thirty_day_months)
2401 call error_mesg(
'days_in_year',
'Invalid calendar type in days_in_year',fatal)
2407 function days_in_year_thirty(Time)
2409 integer :: days_in_year_thirty
2412 days_in_year_thirty = 360
2414 end function days_in_year_thirty
2418 function days_in_year_gregorian(Time)
2420 integer :: days_in_year_gregorian
2423 if(leap_year_gregorian(time))
then
2424 days_in_year_gregorian = 366
2426 days_in_year_gregorian = 365
2429 end function days_in_year_gregorian
2432 function days_in_year_julian(Time)
2434 integer :: days_in_year_julian
2438 days_in_year_julian = 366
2440 days_in_year_julian = 365
2443 end function days_in_year_julian
2447 function days_in_year_no_leap(Time)
2449 integer :: days_in_year_no_leap
2452 days_in_year_no_leap = 365
2454 end function days_in_year_no_leap
2470 integer,
intent(in) :: n
2471 character (len = 9),
dimension(12) :: months = (/
'January ',
'February ', &
2472 'March ',
'April ',
'May ',
'June ',
'July ', &
2473 'August ',
'September',
'October ',
'November ',
'December '/)
2477 if(n < 1 .or. n > 12)
call error_mesg(
'month_name',
'Illegal month index',fatal)
2489 function error_handler(routine, err_msg_local, err_msg)
2492 logical :: error_handler
2493 character(len=*),
intent(in) :: routine, err_msg_local
2494 character(len=*),
intent(out),
optional :: err_msg
2496 error_handler = .false.
2497 if(
present(err_msg))
then
2498 err_msg = err_msg_local
2499 error_handler = .true.
2501 call error_mesg(trim(routine),trim(err_msg_local),fatal)
2504 end function error_handler
2511 if (module_is_initialized)
return
2514 module_is_initialized = .true.
2525 character (len=*),
intent(in),
optional :: str
2526 integer ,
intent(in),
optional :: unit
2527 integer :: s,d,ticks, ns,nd,nt, unit_in
2528 character(len=19) :: fmt
2534 if (
present(unit)) unit_in = unit
2540 nd = int(log10(real(max(1,d))))+1
2541 ns = int(log10(real(max(1,s))))+1
2542 nt = int(log10(real(max(1,ticks))))+1
2543 write (fmt,10) nd, ns, nt
2544 10
format (
'(a,i',i2.2,
',a,i',i2.2,
',a,i',i2.2,
')')
2546 if (
present(str))
then
2547 write (unit_in,fmt) trim(str)//
' day=', d,
', sec=', s,
', ticks=', ticks
2549 write (unit_in,fmt)
'TIME: day=', d,
', sec=', s,
', ticks=', ticks
2560 character (len=*),
intent(in),
optional :: str
2561 integer ,
intent(in),
optional :: unit
2562 integer :: y,mo,d,h,m,s, unit_in
2563 character(len=9) :: mon
2569 if (
present(unit)) unit_in = unit
2573 if (
present(str))
then
2574 write (unit_in,10) trim(str)//
' ', y,mon(1:3),
' ',d,
' ',h,
':',m,
':',s
2576 write (unit_in,10)
'DATE: ', y,mon(1:3),
' ',d,
' ',h,
':',m,
':',s
2578 10
format (a,i4,1x,a3,4(a1,i2.2))
2589 integer,
intent(in) :: ncal
2590 character(len=*),
intent(out),
optional :: err_msg
2592 character(len=128) :: err_msg_local
2596 if(
present(err_msg)) err_msg =
''
2598 if(ncal == no_calendar)
then
2600 else if(ncal == thirty_day_months)
then
2602 else if(ncal == julian)
then
2604 else if(ncal == gregorian)
then
2606 else if(ncal == noleap)
then
2609 write(err_msg_local,
'(a,i4,a)')
'calendar type=',ncal,
' is invalid.'
2610 if(error_handler(
'function valid_calendar_types', err_msg_local, err_msg))
return
2620 character(len=*),
intent(out),
optional :: err_msg
2621 character(len=128) :: err_msg_local
2623 integer :: yr,mon,day,hr,min,sec
2625 if(
present(err_msg)) err_msg =
''
2626 call get_date(time,yr,mon,day,hr,min,sec)
2627 if (yr <= 9999)
then
2628 write(
date_to_string,
'(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec
2630 write(err_msg_local,
'(a,i4.4,a)')
'year = ', yr,
' should be less than 10000'
2631 if(error_handler(
'function date_to_string', err_msg_local, err_msg))
return
2640 character(len=:),
allocatable :: terr
2642 allocate (
character(len=10) :: terr)
2644 write (terr,
'(I0)') t%days
2647 end module time_manager_mod
subroutine, public write_version_number(version, tag, unit)
Prints to the log file (or a specified unit) the version id string and tag name.
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
integer function stdout()
This function returns the current standard fortran unit numbers for output.
type(time_type) function, public length_of_year()
Returns the mean length of the year in the default calendar setting.
integer function, public get_ticks_per_second()
Returns the number of ticks per second.
integer function days_in_month_gregorian(Time)
Returns the number of days in a gregorian month.
logical function, public leap_year(Time, err_msg)
Returns true if the year corresponding to the input time is a leap year (for default calendar)....
type(time_type) function set_date_i(year, month, day, hour, minute, second, tick, err_msg)
Calls set_date_private to set days for different calendar types.
integer function, public day_of_year(time)
Returns number of day in year for given time. Jan 1st is day 1, not zero!
type(time_type) function, public decrement_time(Time, seconds, days, ticks, err_msg, allow_neg_inc)
Decrements a time by seconds and days.
type(time_type) function set_time_c(string, err_msg, allow_rounding)
Returns a time_type set to the given amount of time via a string.
type(time_type) function set_date_c(string, zero_year_warning, err_msg, allow_rounding)
Calls set_date_private for different calendar types when given a string input. Examples of acceptable...
type(time_type) function time_scalar_divide(time, n)
Returns the largest time, t, for which n * t <= time.
subroutine, public get_time(Time, seconds, days, ticks, err_msg)
Returns days and seconds ( < 86400 ) corresponding to a time. err_msg should be checked for any error...
type(time_type) function time_scalar_mult(time, n)
Returns time multiplied by integer factor n.
logical function leap_year_thirty(Time)
No leap years in thirty day months, included for transparency.
character(len=15) function, public date_to_string(time, err_msg)
Get the a character string that represents the time. The format will be yyyymmdd.hhmmss.
subroutine, public set_ticks_per_second(tps)
Sets the number of ticks per second.
character(len=24) function, public valid_calendar_types(ncal, err_msg)
Returns a character string that describes the calendar type corresponding to the input integer.
type(time_type) function, public decrement_date(Time, years, months, days, hours, minutes, seconds, ticks, err_msg, allow_neg_inc)
Given a time and some date decrement, computes a new time. Depending on the mapping algorithm from da...
subroutine, public get_date(time, year, month, day, hour, minute, second, tick, err_msg)
Gets the date for different calendar types. Given a time_interval, returns the corresponding date und...
integer function, public days_in_year(Time)
Returns the number of days in the calendar year corresponding to the date represented by time for the...
type(time_type) function scalar_time_mult(n, time)
Returns time multipled by integer factor n.
type(time_type) function, public increment_time(Time, seconds, days, ticks, err_msg, allow_neg_inc)
Increments a time by seconds and days.
logical function leap_year_julian(Time)
Returns the number of days in a julian month.
subroutine, public print_date(Time, str, unit)
Prints the time to standard output (or optional unit) as a date.
subroutine get_date_gregorian(time, year, month, day, hour, minute, second, tick)
Gets the date on a Gregorian calendar. Computes the year, month, day on the fly from the quantity tim...
type(time_type) function set_time_i(seconds, days, ticks, err_msg)
Returns a time_type set to the given amount of time via integer amounts.
integer function days_in_month_julian(Time)
Returns the number of days in a julian month.
subroutine get_date_julian_private(time, year, month, day, hour, minute, second, tick)
Base date for Julian calendar is year 1 with all multiples of 4 years being leap years.
subroutine, public time_manager_init()
Initialization routine. Writes the version information to the log file.
logical function set_date_gregorian(year, month, day, hour, minute, second, tick, Time_out, err_msg)
Sets Time_outdays on a Gregorian calendar Computes the total number of days between 1/1/0001 to the c...
logical function set_date_private(year, month, day, hour, minute, second, tick, Time_out, err_msg)
Sets days for different calendar types. Given an input date in year, month, days, etc....
integer function days_in_month_thirty(Time)
Returns the number of days in a thirty day month (needed for transparent changes to calendar type).
subroutine get_date_thirty(time, year, month, day, hour, minute, second, tick)
Computes date corresponding to time interval for 30 day months, 12 month years.
type(time_type) function real4_to_time_type(x, err_msg)
integer function, public days_in_month(Time, err_msg)
Given a time, computes the corresponding date given the selected date time mapping algorithm.
logical function increment_time_private(Time_in, seconds, days, ticks, Time_out, err_msg)
Increments a time by seconds, days and ticks.
logical function set_time_private(seconds, days, ticks, Time_out, err_msg)
Returns a time interval corresponding to this number of days, seconds, and ticks. days,...
integer, parameter days_in_400_year_period
Used only for gregorian.
character(len=9) function, public month_name(n)
Returns a character string containing the name of the month corresponding to month number n.
type(time_type) function real8_to_time_type(x, err_msg)
Convert a real number of seconds into a time_type variable.
integer function safe_rtoi(rval, mode)
Convert a floating point value to an integer value.
real(kind=r8_kind) function, public time_type_to_real(time)
Converts time to seconds and returns it as a real number.
logical function leap_year_no_leap(Time)
Another tough one; no leap year returns false for leap year inquiry.
integer function days_in_month_no_leap(Time)
Returns the number of days in a 365 day year month.
logical function, public repeat_alarm(time, alarm_frequency, alarm_length)
Repeat_alarm supports an alarm that goes off with alarm_frequency and lasts for alarm_length....
logical function, public interval_alarm(time, time_interval, alarm, alarm_interval)
Supports a commonly used type of test on times for models. Given the current time,...
integer function time_divide(time1, time2)
Returns the largest integer, n, for which time1 >= time2 * n.
integer function, public get_calendar_type()
Returns default calendar type for mapping from time to date.
subroutine, public print_time(Time, str, unit)
Prints the given time_type argument as a time (using days, seconds and ticks)
subroutine, public set_calendar_type(type, err_msg)
Sets calendar_type for mapping an interval to a date. For the Gregorian calendar, negative years and ...
logical function increment_date_private(Time, years, months, days, hours, minutes, seconds, ticks, Time_out, err_msg)
Given a time and some date increment, computes a new time. Depending on the mapping algorithm from da...
subroutine, public time_list_error(T, Terr)
This routine converts the integer tdays to a string.
Given an input date in year, month, days, etc., creates a time_type that represents this time interva...
Given some number of seconds and days, returns the corresponding time_type.
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.
Wrapper for the real to time interface Takes seconds as reals to convert to a time_type representatio...