42 INTEGER,
PARAMETER :: dateint=selected_int_kind(13)
47 INTEGER(KIND=int_ll) :: iminuti
59 INTEGER(KIND=int_ll) :: iminuti
78 TYPE(datetime),
PARAMETER :: datetime_miss=
datetime(illmiss)
80 TYPE(timedelta),
PARAMETER :: timedelta_miss=
timedelta(illmiss, 0)
82 TYPE(timedelta),
PARAMETER :: timedelta_0=
timedelta(0, 0)
84 INTEGER,
PARAMETER :: datetime_utc=1
86 INTEGER,
PARAMETER :: datetime_local=2
88 TYPE(datetime),
PARAMETER :: datetime_min=
datetime(-huge(1_int_ll)-1)
90 TYPE(datetime),
PARAMETER :: datetime_max=
datetime(huge(1_int_ll)-1)
92 TYPE(timedelta),
PARAMETER :: timedelta_min=
timedelta(-huge(1_int_ll)-1,0)
94 TYPE(timedelta),
PARAMETER :: timedelta_max=
timedelta(huge(1_int_ll)-1,0)
96 TYPE(cyclicdatetime),
PARAMETER :: cyclicdatetime_miss=
cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
99 INTEGER(kind=dateint),
PARAMETER :: &
107 INTEGER,
PARAMETER :: &
113 ianno(13,2)=reshape((/ &
114 0,31,59,90,120,151,181,212,243,273,304,334,365, &
115 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
117 INTEGER(KIND=int_ll),
PARAMETER :: &
118 unsec=62135596800_int_ll
124 MODULE PROCEDURE datetime_init, timedelta_init
130 MODULE PROCEDURE datetime_delete, timedelta_delete
135 MODULE PROCEDURE datetime_getval, timedelta_getval
140 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
162 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
170 INTERFACE OPERATOR (==)
171 MODULE PROCEDURE datetime_eq, timedelta_eq, &
172 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
180 INTERFACE OPERATOR (/=)
181 MODULE PROCEDURE datetime_ne, timedelta_ne
191 INTERFACE OPERATOR (>)
192 MODULE PROCEDURE datetime_gt, timedelta_gt
202 INTERFACE OPERATOR (<)
203 MODULE PROCEDURE datetime_lt, timedelta_lt
213 INTERFACE OPERATOR (>=)
214 MODULE PROCEDURE datetime_ge, timedelta_ge
224 INTERFACE OPERATOR (<=)
225 MODULE PROCEDURE datetime_le, timedelta_le
234 INTERFACE OPERATOR (+)
235 MODULE PROCEDURE datetime_add, timedelta_add
245 INTERFACE OPERATOR (-)
246 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
254 INTERFACE OPERATOR (*)
255 MODULE PROCEDURE timedelta_mult, timedelta_tlum
264 INTERFACE OPERATOR (/)
265 MODULE PROCEDURE timedelta_divint, timedelta_divtd
279 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
285 MODULE PROCEDURE timedelta_abs
291 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
292 timedelta_read_unit, timedelta_vect_read_unit
298 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
299 timedelta_write_unit, timedelta_vect_write_unit
304 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
309 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
312 #undef VOL7D_POLY_TYPE 313 #undef VOL7D_POLY_TYPES 315 #define VOL7D_POLY_TYPE TYPE(datetime) 316 #define VOL7D_POLY_TYPES _datetime 318 #include "array_utilities_pre.F90" 321 #define ARRAYOF_ORIGTYPE TYPE(datetime) 322 #define ARRAYOF_TYPE arrayof_datetime 323 #define ARRAYOF_ORIGEQ 1 324 #include "arrayof_pre.F90" 329 PUBLIC datetime, datetime_miss, datetime_utc, datetime_local, &
330 datetime_min, datetime_max, &
333 OPERATOR(==),
OPERATOR(/=),
OPERATOR(>),
OPERATOR(<), &
334 OPERATOR(>=),
OPERATOR(<=),
OPERATOR(+),
OPERATOR(-), &
335 OPERATOR(*),
OPERATOR(/),
mod,
abs, &
336 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
337 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
339 count_distinct, pack_distinct, &
340 count_distinct_sorted, pack_distinct_sorted, &
341 count_and_pack_distinct, &
343 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
345 PUBLIC insert_unique, append_unique
346 PUBLIC cyclicdatetime_to_conventional
361 ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
362 unixtime, isodate, simpledate)
RESULT(this)
363 INTEGER,
INTENT(IN),
OPTIONAL :: year
364 INTEGER,
INTENT(IN),
OPTIONAL :: month
365 INTEGER,
INTENT(IN),
OPTIONAL :: day
366 INTEGER,
INTENT(IN),
OPTIONAL :: hour
367 INTEGER,
INTENT(IN),
OPTIONAL :: minute
368 INTEGER,
INTENT(IN),
OPTIONAL :: msec
369 INTEGER(kind=int_ll),
INTENT(IN),
OPTIONAL :: unixtime
370 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: isodate
371 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: simpledate
373 TYPE(datetime) :: this
374 INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
375 CHARACTER(len=23) :: datebuf
377 IF (
PRESENT(year))
THEN 379 IF (
PRESENT(month))
THEN 384 IF (
PRESENT(day))
THEN 389 IF (
PRESENT(hour))
THEN 394 IF (
PRESENT(minute))
THEN 399 IF (
PRESENT(msec))
THEN 405 if (
c_e(lday) .and.
c_e(lmonth) .and.
c_e(lyear) .and.
c_e(lhour) &
406 .and.
c_e(lminute) .and.
c_e(lmsec))
then 407 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
412 ELSE IF (
PRESENT(unixtime))
THEN 413 if (
c_e(unixtime))
then 414 this%iminuti = (unixtime + unsec)*1000
419 ELSE IF (
PRESENT(isodate))
THEN 421 IF (
c_e(isodate) .AND. len_trim(isodate) > 0)
THEN 422 datebuf(1:23) =
'0001-01-01 00:00:00.000' 423 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
424 READ(datebuf,
'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
425 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
426 lmsec = lmsec + lsec*1000
427 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
437 ELSE IF (
PRESENT(simpledate))
THEN 438 IF (
c_e(simpledate) .AND. len_trim(simpledate) > 0)
THEN 439 datebuf(1:17) =
'00010101000000000' 440 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
441 READ(datebuf,
'(I4.4,5I2.2,I3.3)', err=120) &
442 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
443 lmsec = lmsec + lsec*1000
444 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
458 END FUNCTION datetime_new
462 FUNCTION datetime_new_now(now)
RESULT(this)
463 INTEGER,
INTENT(IN) :: now
464 TYPE(datetime) :: this
469 CALL date_and_time(values=dt)
470 IF (now /= datetime_local) dt(6) = dt(6) - dt(4)
471 CALL init(this, year=dt(1), month=dt(2), day=dt(3), hour=dt(5), minute=dt(6), &
472 msec=dt(7)*1000+dt(8))
477 END FUNCTION datetime_new_now
486 SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
487 unixtime, isodate, simpledate, now)
488 TYPE(datetime),
INTENT(INOUT) :: this
489 INTEGER,
INTENT(IN),
OPTIONAL :: year
490 INTEGER,
INTENT(IN),
OPTIONAL :: month
491 INTEGER,
INTENT(IN),
OPTIONAL :: day
492 INTEGER,
INTENT(IN),
OPTIONAL :: hour
493 INTEGER,
INTENT(IN),
OPTIONAL :: minute
494 INTEGER,
INTENT(IN),
OPTIONAL :: msec
495 INTEGER(kind=int_ll),
INTENT(IN),
OPTIONAL :: unixtime
496 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: isodate
497 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: simpledate
498 INTEGER,
INTENT(IN),
OPTIONAL :: now
500 IF (
PRESENT(now))
THEN 501 this = datetime_new_now(now)
503 this = datetime_new(year, month, day, hour, minute, msec, &
504 unixtime, isodate, simpledate)
507 END SUBROUTINE datetime_init
510 ELEMENTAL SUBROUTINE datetime_delete(this)
511 TYPE(datetime),
INTENT(INOUT) :: this
513 this%iminuti = illmiss
515 END SUBROUTINE datetime_delete
522 PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
523 unixtime, isodate, simpledate, oraclesimdate)
524 TYPE(datetime),
INTENT(IN) :: this
525 INTEGER,
INTENT(OUT),
OPTIONAL :: year
526 INTEGER,
INTENT(OUT),
OPTIONAL :: month
527 INTEGER,
INTENT(OUT),
OPTIONAL :: day
528 INTEGER,
INTENT(OUT),
OPTIONAL :: hour
529 INTEGER,
INTENT(OUT),
OPTIONAL :: minute
530 INTEGER,
INTENT(OUT),
OPTIONAL :: msec
531 INTEGER(kind=int_ll),
INTENT(OUT),
OPTIONAL :: unixtime
532 CHARACTER(len=*),
INTENT(OUT),
OPTIONAL :: isodate
533 CHARACTER(len=*),
INTENT(OUT),
OPTIONAL :: simpledate
534 CHARACTER(len=12),
INTENT(OUT),
OPTIONAL :: oraclesimdate
536 INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
537 CHARACTER(len=23) :: datebuf
539 IF (
PRESENT(year) .OR.
PRESENT(month) .OR.
PRESENT(day) .OR.
PRESENT(hour) &
540 .OR.
PRESENT(minute) .OR.
PRESENT(msec) .OR.
PRESENT(isodate) &
541 .OR.
PRESENT(simpledate) .OR.
PRESENT(oraclesimdate) .OR.
PRESENT(unixtime))
THEN 543 IF (this == datetime_miss)
THEN 545 IF (
PRESENT(msec))
THEN 548 IF (
PRESENT(minute))
THEN 551 IF (
PRESENT(hour))
THEN 554 IF (
PRESENT(day))
THEN 557 IF (
PRESENT(month))
THEN 560 IF (
PRESENT(year))
THEN 563 IF (
PRESENT(isodate))
THEN 566 IF (
PRESENT(simpledate))
THEN 569 IF (
PRESENT(oraclesimdate))
THEN 574 IF (
PRESENT(unixtime))
THEN 580 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
581 IF (
PRESENT(msec))
THEN 584 IF (
PRESENT(minute))
THEN 587 IF (
PRESENT(hour))
THEN 590 IF (
PRESENT(day))
THEN 593 IF (
PRESENT(month))
THEN 596 IF (
PRESENT(year))
THEN 599 IF (
PRESENT(isodate))
THEN 600 WRITE(datebuf(1:23),
'(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
601 lyear,
'-', lmonth,
'-', lday, lhour,
':', lminute,
':', lmsec/1000, &
602 '.',
mod(lmsec, 1000)
603 isodate = datebuf(1:min(len(isodate),23))
605 IF (
PRESENT(simpledate))
THEN 606 WRITE(datebuf(1:17),
'(I4.4,5I2.2,I3.3)') &
607 lyear, lmonth, lday, lhour, lminute, lmsec/1000,
mod(lmsec, 1000)
608 simpledate = datebuf(1:min(len(simpledate),17))
610 IF (
PRESENT(oraclesimdate))
THEN 613 WRITE(oraclesimdate,
'(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
615 IF (
PRESENT(unixtime))
THEN 616 unixtime = this%iminuti/1000_int_ll-unsec
622 END SUBROUTINE datetime_getval
627 elemental FUNCTION datetime_to_char(this)
RESULT(char)
628 TYPE(datetime),
INTENT(IN) :: this
630 CHARACTER(len=23) :: char
634 END FUNCTION datetime_to_char
637 FUNCTION trim_datetime_to_char(in)
RESULT(char)
638 TYPE(datetime),
INTENT(IN) :: in
640 CHARACTER(len=len_trim(datetime_to_char(in))) :: char
642 char=datetime_to_char(in)
644 END FUNCTION trim_datetime_to_char
648 SUBROUTINE display_datetime(this)
649 TYPE(datetime),
INTENT(in) :: this
653 end subroutine display_datetime
657 SUBROUTINE display_timedelta(this)
658 TYPE(timedelta),
INTENT(in) :: this
660 print*,
"TIMEDELTA: ",
to_char(this)
662 end subroutine display_timedelta
666 ELEMENTAL FUNCTION c_e_datetime(this)
result (res)
667 TYPE(datetime),
INTENT(in) :: this
670 res = .not. this == datetime_miss
672 end FUNCTION c_e_datetime
675 ELEMENTAL FUNCTION datetime_eq(this, that)
RESULT(res)
676 TYPE(datetime),
INTENT(IN) :: this, that
679 res = this%iminuti == that%iminuti
681 END FUNCTION datetime_eq
684 ELEMENTAL FUNCTION datetime_ne(this, that)
RESULT(res)
685 TYPE(datetime),
INTENT(IN) :: this, that
688 res = .NOT.(this == that)
690 END FUNCTION datetime_ne
693 ELEMENTAL FUNCTION datetime_gt(this, that)
RESULT(res)
694 TYPE(datetime),
INTENT(IN) :: this, that
697 res = this%iminuti > that%iminuti
699 END FUNCTION datetime_gt
702 ELEMENTAL FUNCTION datetime_lt(this, that)
RESULT(res)
703 TYPE(datetime),
INTENT(IN) :: this, that
706 res = this%iminuti < that%iminuti
708 END FUNCTION datetime_lt
711 ELEMENTAL FUNCTION datetime_ge(this, that)
RESULT(res)
712 TYPE(datetime),
INTENT(IN) :: this, that
715 IF (this == that)
THEN 717 ELSE IF (this > that)
THEN 723 END FUNCTION datetime_ge
726 ELEMENTAL FUNCTION datetime_le(this, that)
RESULT(res)
727 TYPE(
datetime),
INTENT(IN) :: this, that
730 IF (this == that)
THEN 732 ELSE IF (this < that)
THEN 738 END FUNCTION datetime_le
741 FUNCTION datetime_add(this, that)
RESULT(res)
746 INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
748 IF (this == datetime_miss .OR. that == timedelta_miss)
THEN 751 res%iminuti = this%iminuti + that%iminuti
752 IF (that%month /= 0)
THEN 753 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
754 minute=lminute, msec=lmsec)
755 CALL init(res, year=lyear, month=lmonth+that%month, day=lday, &
756 hour=lhour, minute=lminute, msec=lmsec)
760 END FUNCTION datetime_add
763 ELEMENTAL FUNCTION datetime_subdt(this, that)
RESULT(res)
764 TYPE(
datetime),
INTENT(IN) :: this, that
767 IF (this == datetime_miss .OR. that == datetime_miss)
THEN 770 res%iminuti = this%iminuti - that%iminuti
774 END FUNCTION datetime_subdt
777 FUNCTION datetime_subtd(this, that)
RESULT(res)
782 INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
784 IF (this == datetime_miss .OR. that == timedelta_miss)
THEN 787 res%iminuti = this%iminuti - that%iminuti
788 IF (that%month /= 0)
THEN 789 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
790 minute=lminute, msec=lmsec)
791 CALL init(res, year=lyear, month=lmonth-that%month, day=lday, &
792 hour=lhour, minute=lminute, msec=lmsec)
796 END FUNCTION datetime_subtd
803 SUBROUTINE datetime_read_unit(this, unit)
805 INTEGER,
INTENT(in) :: unit
806 CALL datetime_vect_read_unit((/this/), unit)
808 END SUBROUTINE datetime_read_unit
815 SUBROUTINE datetime_vect_read_unit(this, unit)
817 INTEGER,
INTENT(in) :: unit
819 CHARACTER(len=40) :: form
820 CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
823 ALLOCATE(dateiso(
SIZE(this)))
824 INQUIRE(unit, form=form)
825 IF (form ==
'FORMATTED')
THEN 826 READ(unit,
'(A23,1X)')dateiso
830 DO i = 1,
SIZE(dateiso)
831 CALL init(this(i), isodate=dateiso(i))
835 END SUBROUTINE datetime_vect_read_unit
842 SUBROUTINE datetime_write_unit(this, unit)
844 INTEGER,
INTENT(in) :: unit
846 CALL datetime_vect_write_unit((/this/), unit)
848 END SUBROUTINE datetime_write_unit
855 SUBROUTINE datetime_vect_write_unit(this, unit)
856 TYPE(
datetime),
INTENT(in) :: this(:)
857 INTEGER,
INTENT(in) :: unit
859 CHARACTER(len=40) :: form
860 CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
863 ALLOCATE(dateiso(
SIZE(this)))
864 DO i = 1,
SIZE(dateiso)
865 CALL getval(this(i), isodate=dateiso(i))
867 INQUIRE(unit, form=form)
868 IF (form ==
'FORMATTED')
THEN 869 WRITE(unit,
'(A23,1X)')dateiso
875 END SUBROUTINE datetime_vect_write_unit
878 #include "arrayof_post.F90" 890 FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
891 isodate, simpledate, oraclesimdate)
RESULT (this)
892 INTEGER,
INTENT(IN),
OPTIONAL :: year
893 INTEGER,
INTENT(IN),
OPTIONAL :: month
894 INTEGER,
INTENT(IN),
OPTIONAL :: day
895 INTEGER,
INTENT(IN),
OPTIONAL :: hour
896 INTEGER,
INTENT(IN),
OPTIONAL :: minute
897 INTEGER,
INTENT(IN),
OPTIONAL :: sec
898 INTEGER,
INTENT(IN),
OPTIONAL :: msec
899 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: isodate
900 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: simpledate
901 CHARACTER(len=12),
INTENT(IN),
OPTIONAL :: oraclesimdate
905 CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
906 isodate, simpledate, oraclesimdate)
908 END FUNCTION timedelta_new
915 SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
916 isodate, simpledate, oraclesimdate)
918 INTEGER,
INTENT(IN),
OPTIONAL :: year
919 INTEGER,
INTENT(IN),
OPTIONAL :: month
920 INTEGER,
INTENT(IN),
OPTIONAL :: day
921 INTEGER,
INTENT(IN),
OPTIONAL :: hour
922 INTEGER,
INTENT(IN),
OPTIONAL :: minute
923 INTEGER,
INTENT(IN),
OPTIONAL :: sec
924 INTEGER,
INTENT(IN),
OPTIONAL :: msec
925 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: isodate
926 CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: simpledate
927 CHARACTER(len=12),
INTENT(IN),
OPTIONAL :: oraclesimdate
929 INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
930 CHARACTER(len=23) :: datebuf
934 IF (
PRESENT(isodate))
THEN 935 datebuf(1:23) =
'0000000000 00:00:00.000' 936 l = len_trim(isodate)
938 n =
index(trim(isodate),
' ')
940 IF (n > 11 .OR. n < l - 12)
GOTO 200
941 datebuf(12-n:12-n+l-1) = isodate(:l)
943 datebuf(1:l) = isodate(1:l)
948 READ(datebuf,
'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
950 this%month = lmonth + 12*lyear
951 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
952 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
953 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
958 CALL l4f_log(l4f_error,
'isodate '//trim(isodate)//
' not valid')
961 ELSE IF (
PRESENT(simpledate))
THEN 962 datebuf(1:17) =
'00000000000000000' 963 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
964 READ(datebuf,
'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
965 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
966 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
967 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
971 CALL l4f_log(l4f_error,
'simpledate '//trim(simpledate)//
' not valid')
975 ELSE IF (
PRESENT(oraclesimdate))
THEN 976 CALL l4f_log(l4f_warn,
'in timedelta_init, parametro oraclesimdate '// &
977 'obsoleto, usare piuttosto simpledate')
978 READ(oraclesimdate,
'(I8,2I2)')d, h, m
979 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
980 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
982 ELSE IF (.not.
present(year) .and. .not.
present(month) .and. .not.
present(day)&
983 .and. .not.
present(hour) .and. .not.
present(minute) .and. .not.
present(sec)&
984 .and. .not.
present(msec) .and. .not.
present(isodate) &
985 .and. .not.
present(simpledate) .and. .not.
present(oraclesimdate))
THEN 991 IF (
PRESENT(year))
THEN 993 this%month = this%month + year*12
999 IF (
PRESENT(month))
THEN 1001 this%month = this%month + month
1007 IF (
PRESENT(day))
THEN 1009 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
1015 IF (
PRESENT(hour))
THEN 1017 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
1023 IF (
PRESENT(minute))
THEN 1024 if (
c_e(minute))
then 1025 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
1031 IF (
PRESENT(sec))
THEN 1033 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
1039 IF (
PRESENT(msec))
THEN 1041 this%iminuti = this%iminuti + msec
1052 END SUBROUTINE timedelta_init
1055 SUBROUTINE timedelta_delete(this)
1058 this%iminuti = imiss
1061 END SUBROUTINE timedelta_delete
1068 PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
1069 day, hour, minute, sec, msec, &
1070 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
1072 INTEGER,
INTENT(OUT),
OPTIONAL :: year
1073 INTEGER,
INTENT(OUT),
OPTIONAL :: month
1074 INTEGER,
INTENT(OUT),
OPTIONAL :: amonth
1075 INTEGER,
INTENT(OUT),
OPTIONAL :: day
1076 INTEGER,
INTENT(OUT),
OPTIONAL :: hour
1077 INTEGER,
INTENT(OUT),
OPTIONAL :: minute
1078 INTEGER,
INTENT(OUT),
OPTIONAL :: sec
1079 INTEGER,
INTENT(OUT),
OPTIONAL :: msec
1080 INTEGER,
INTENT(OUT),
OPTIONAL :: ahour
1081 INTEGER,
INTENT(OUT),
OPTIONAL :: aminute
1082 INTEGER,
INTENT(OUT),
OPTIONAL :: asec
1083 INTEGER(kind=int_ll),
INTENT(OUT),
OPTIONAL :: amsec
1084 CHARACTER(len=*),
INTENT(OUT),
OPTIONAL :: isodate
1085 CHARACTER(len=*),
INTENT(OUT),
OPTIONAL :: simpledate
1086 CHARACTER(len=12),
INTENT(OUT),
OPTIONAL :: oraclesimdate
1088 CHARACTER(len=23) :: datebuf
1090 IF (
PRESENT(amsec))
THEN 1091 amsec = this%iminuti
1093 IF (
PRESENT(asec))
THEN 1094 asec = int(this%iminuti/1000_int_ll)
1096 IF (
PRESENT(aminute))
THEN 1097 aminute = int(this%iminuti/60000_int_ll)
1099 IF (
PRESENT(ahour))
THEN 1100 ahour = int(this%iminuti/3600000_int_ll)
1102 IF (
PRESENT(msec))
THEN 1103 msec = int(
mod(this%iminuti, 1000_int_ll))
1105 IF (
PRESENT(sec))
THEN 1106 sec = int(
mod(this%iminuti/1000_int_ll, 60_int_ll))
1108 IF (
PRESENT(minute))
THEN 1109 minute = int(
mod(this%iminuti/60000_int_ll, 60_int_ll))
1111 IF (
PRESENT(hour))
THEN 1112 hour = int(
mod(this%iminuti/3600000_int_ll, 24_int_ll))
1114 IF (
PRESENT(day))
THEN 1115 day = int(this%iminuti/86400000_int_ll)
1117 IF (
PRESENT(amonth))
THEN 1120 IF (
PRESENT(month))
THEN 1121 month =
mod(this%month-1,12)+1
1123 IF (
PRESENT(year))
THEN 1124 year = this%month/12
1126 IF (
PRESENT(isodate))
THEN 1127 WRITE(datebuf(1:23),
'(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
1128 this%iminuti/86400000_int_ll,
mod(this%iminuti/3600000_int_ll, 24_int_ll),
':', &
1129 mod(this%iminuti/60000_int_ll, 60_int_ll),
':',
mod(this%iminuti/1000_int_ll, 60_int_ll), &
1130 '.',
mod(this%iminuti, 1000_int_ll)
1131 isodate = datebuf(1:min(len(isodate),23))
1134 IF (
PRESENT(simpledate))
THEN 1135 WRITE(datebuf(1:17),
'(I8.8,3I2.2,I3.3)') &
1136 this%iminuti/86400000_int_ll,
mod(this%iminuti/3600000_int_ll, 24_int_ll), &
1137 mod(this%iminuti/60000_int_ll, 60_int_ll),
mod(this%iminuti/1000_int_ll, 60_int_ll), &
1138 mod(this%iminuti, 1000_int_ll)
1139 simpledate = datebuf(1:min(len(simpledate),17))
1141 IF (
PRESENT(oraclesimdate))
THEN 1144 WRITE(oraclesimdate,
'(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
1145 mod(this%iminuti/3600000_int_ll, 24_int_ll),
mod(this%iminuti/60000_int_ll, 60_int_ll)
1148 END SUBROUTINE timedelta_getval
1153 elemental FUNCTION timedelta_to_char(this)
RESULT(char)
1156 CHARACTER(len=23) :: char
1158 CALL getval(this, isodate=char)
1160 END FUNCTION timedelta_to_char
1163 FUNCTION trim_timedelta_to_char(in)
RESULT(char)
1166 CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
1168 char=timedelta_to_char(in)
1170 END FUNCTION trim_timedelta_to_char
1174 elemental FUNCTION timedelta_getamsec(this)
1175 TYPE(timedelta),
INTENT(IN) :: this
1176 INTEGER(kind=int_ll) :: timedelta_getamsec
1178 timedelta_getamsec = this%iminuti
1180 END FUNCTION timedelta_getamsec
1188 FUNCTION timedelta_depop(this)
1189 TYPE(timedelta),
INTENT(IN) :: this
1190 TYPE(timedelta) :: timedelta_depop
1192 TYPE(datetime) :: tmpdt
1194 IF (this%month == 0)
THEN 1195 timedelta_depop = this
1197 tmpdt = datetime_new(1970, 1, 1)
1198 timedelta_depop = (tmpdt + this) - tmpdt
1201 END FUNCTION timedelta_depop
1204 elemental FUNCTION timedelta_eq(this, that)
RESULT(res)
1205 TYPE(timedelta),
INTENT(IN) :: this, that
1208 res = (this%iminuti == that%iminuti .AND. this%month == that%month)
1210 END FUNCTION timedelta_eq
1213 ELEMENTAL FUNCTION timedelta_ne(this, that)
RESULT(res)
1214 TYPE(timedelta),
INTENT(IN) :: this, that
1217 res = .NOT.(this == that)
1219 END FUNCTION timedelta_ne
1222 ELEMENTAL FUNCTION timedelta_gt(this, that)
RESULT(res)
1223 TYPE(timedelta),
INTENT(IN) :: this, that
1226 res = this%iminuti > that%iminuti
1228 END FUNCTION timedelta_gt
1231 ELEMENTAL FUNCTION timedelta_lt(this, that)
RESULT(res)
1232 TYPE(timedelta),
INTENT(IN) :: this, that
1235 res = this%iminuti < that%iminuti
1237 END FUNCTION timedelta_lt
1240 ELEMENTAL FUNCTION timedelta_ge(this, that)
RESULT(res)
1241 TYPE(timedelta),
INTENT(IN) :: this, that
1244 IF (this == that)
THEN 1246 ELSE IF (this > that)
THEN 1252 END FUNCTION timedelta_ge
1255 elemental FUNCTION timedelta_le(this, that)
RESULT(res)
1256 TYPE(
timedelta),
INTENT(IN) :: this, that
1259 IF (this == that)
THEN 1261 ELSE IF (this < that)
THEN 1267 END FUNCTION timedelta_le
1270 ELEMENTAL FUNCTION timedelta_add(this, that)
RESULT(res)
1271 TYPE(
timedelta),
INTENT(IN) :: this, that
1274 res%iminuti = this%iminuti + that%iminuti
1275 res%month = this%month + that%month
1277 END FUNCTION timedelta_add
1280 ELEMENTAL FUNCTION timedelta_sub(this, that)
RESULT(res)
1281 TYPE(
timedelta),
INTENT(IN) :: this, that
1284 res%iminuti = this%iminuti - that%iminuti
1285 res%month = this%month - that%month
1287 END FUNCTION timedelta_sub
1290 ELEMENTAL FUNCTION timedelta_mult(this, n)
RESULT(res)
1292 INTEGER,
INTENT(IN) :: n
1295 res%iminuti = this%iminuti*n
1296 res%month = this%month*n
1298 END FUNCTION timedelta_mult
1301 ELEMENTAL FUNCTION timedelta_tlum(n, this)
RESULT(res)
1302 INTEGER,
INTENT(IN) :: n
1306 res%iminuti = this%iminuti*n
1307 res%month = this%month*n
1309 END FUNCTION timedelta_tlum
1312 ELEMENTAL FUNCTION timedelta_divint(this, n)
RESULT(res)
1314 INTEGER,
INTENT(IN) :: n
1317 res%iminuti = this%iminuti/n
1318 res%month = this%month/n
1320 END FUNCTION timedelta_divint
1323 ELEMENTAL FUNCTION timedelta_divtd(this, that)
RESULT(res)
1324 TYPE(
timedelta),
INTENT(IN) :: this, that
1327 res = int(this%iminuti/that%iminuti)
1329 END FUNCTION timedelta_divtd
1332 elemental FUNCTION timedelta_mod(this, that)
RESULT(res)
1333 TYPE(
timedelta),
INTENT(IN) :: this, that
1336 res%iminuti =
mod(this%iminuti, that%iminuti)
1339 END FUNCTION timedelta_mod
1342 ELEMENTAL FUNCTION datetime_timedelta_mod(this, that)
RESULT(res)
1347 IF (that%iminuti == 0)
THEN 1350 res%iminuti =
mod(this%iminuti, that%iminuti)
1354 END FUNCTION datetime_timedelta_mod
1357 ELEMENTAL FUNCTION timedelta_abs(this)
RESULT(res)
1361 res%iminuti =
abs(this%iminuti)
1362 res%month =
abs(this%month)
1364 END FUNCTION timedelta_abs
1371 SUBROUTINE timedelta_read_unit(this, unit)
1373 INTEGER,
INTENT(in) :: unit
1375 CALL timedelta_vect_read_unit((/this/), unit)
1377 END SUBROUTINE timedelta_read_unit
1384 SUBROUTINE timedelta_vect_read_unit(this, unit)
1386 INTEGER,
INTENT(in) :: unit
1388 CHARACTER(len=40) :: form
1389 CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
1392 ALLOCATE(dateiso(
SIZE(this)))
1393 INQUIRE(unit, form=form)
1394 IF (form ==
'FORMATTED')
THEN 1395 READ(unit,
'(3(A23,1X))')dateiso
1399 DO i = 1,
SIZE(dateiso)
1400 CALL init(this(i), isodate=dateiso(i))
1404 END SUBROUTINE timedelta_vect_read_unit
1411 SUBROUTINE timedelta_write_unit(this, unit)
1413 INTEGER,
INTENT(in) :: unit
1415 CALL timedelta_vect_write_unit((/this/), unit)
1417 END SUBROUTINE timedelta_write_unit
1424 SUBROUTINE timedelta_vect_write_unit(this, unit)
1426 INTEGER,
INTENT(in) :: unit
1428 CHARACTER(len=40) :: form
1429 CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
1432 ALLOCATE(dateiso(
SIZE(this)))
1433 DO i = 1,
SIZE(dateiso)
1434 CALL getval(this(i), isodate=dateiso(i))
1436 INQUIRE(unit, form=form)
1437 IF (form ==
'FORMATTED')
THEN 1438 WRITE(unit,
'(3(A23,1X))')dateiso
1444 END SUBROUTINE timedelta_vect_write_unit
1447 ELEMENTAL FUNCTION c_e_timedelta(this)
result (res)
1451 res = .not. this == timedelta_miss
1453 end FUNCTION c_e_timedelta
1456 elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
1473 INTEGER,
intent(in) :: iday, imonth, iyear, ihour, imin
1474 INTEGER,
intent(out) :: iminuti
1476 iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
1478 END SUBROUTINE jeladata5
1481 elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
1482 INTEGER,
intent(in) :: iday, imonth, iyear, ihour, imin, imsec
1483 INTEGER(KIND=int_ll),
intent(out) :: imillisec
1485 imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
1488 END SUBROUTINE jeladata5_1
1492 elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
1511 INTEGER,
intent(in) :: iminuti
1512 INTEGER,
intent(out) :: iday, imonth, iyear, ihour, imin
1516 imin =
mod(iminuti,60)
1517 ihour =
mod(iminuti,1440)/60
1518 igiorno = iminuti/1440
1519 IF (
mod(iminuti,1440) < 0) igiorno = igiorno-1
1520 CALL ndyin(igiorno,iday,imonth,iyear)
1522 END SUBROUTINE jeladata6
1525 elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
1526 INTEGER(KIND=int_ll),
INTENT(IN) :: imillisec
1527 INTEGER,
INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
1531 imsec = int(
mod(imillisec, 60000_int_ll))
1534 imin = int(
mod(imillisec, 3600000_int_ll)/60000_int_ll)
1535 ihour = int(
mod(imillisec, 86400000_int_ll)/3600000_int_ll)
1536 igiorno = int(imillisec/86400000_int_ll)
1538 CALL ndyin(igiorno,iday,imonth,iyear)
1540 END SUBROUTINE jeladata6_1
1543 elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
1552 INTEGER,
intent(in) :: ndays
1553 INTEGER,
intent(out) :: igg, imm, iaa
1559 lndays = lndays - n*d400
1561 n = min(lndays/d100, 3)
1562 lndays = lndays - n*d100
1565 lndays = lndays - n*d4
1567 n = min(lndays/d1, 3)
1568 lndays = lndays - n*d1
1572 IF (lndays < ianno(imm+1,n))
EXIT 1574 igg = lndays+1-ianno(imm,n)
1576 END SUBROUTINE ndyin
1579 integer elemental FUNCTION ndays(igg,imm,iaa)
1596 INTEGER,
intent(in) :: igg, imm, iaa
1598 INTEGER :: lmonth, lyear
1601 lmonth = modulo(imm-1, 12) + 1
1602 lyear = iaa + (imm - lmonth)/12
1603 ndays = igg+ianno(lmonth, bisextilis(lyear))
1604 ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
1610 elemental FUNCTION bisextilis(annum)
1611 INTEGER,
INTENT(in) :: annum
1612 INTEGER :: bisextilis
1614 IF (
mod(annum,4) == 0 .AND. (
mod(annum,400) == 0 .EQV.
mod(annum,100) == 0))
THEN 1619 END FUNCTION bisextilis
1622 ELEMENTAL FUNCTION cyclicdatetime_eq(this, that)
RESULT(res)
1623 TYPE(cyclicdatetime),
INTENT(IN) :: this, that
1627 if (this%minute /= that%minute) res=.false.
1628 if (this%hour /= that%hour) res=.false.
1629 if (this%day /= that%day) res=.false.
1630 if (this%month /= that%month) res=.false.
1631 if (this%tendaysp /= that%tendaysp) res=.false.
1633 END FUNCTION cyclicdatetime_eq
1636 ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that)
RESULT(res)
1637 TYPE(cyclicdatetime),
INTENT(IN) :: this
1638 TYPE(datetime),
INTENT(IN) :: that
1641 integer :: minute,hour,day,month
1643 call getval(that,minute=minute,hour=hour,day=day,month=month)
1646 if (
c_e(this%minute) .and. this%minute /= minute) res=.false.
1647 if (
c_e(this%hour) .and. this%hour /= hour) res=.false.
1648 if (
c_e(this%day) .and. this%day /= day) res=.false.
1649 if (
c_e(this%month) .and. this%month /= month) res=.false.
1650 if (
c_e(this%tendaysp))
then 1651 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
1654 END FUNCTION cyclicdatetime_datetime_eq
1657 ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that)
RESULT(res)
1658 TYPE(datetime),
INTENT(IN) :: this
1659 TYPE(cyclicdatetime),
INTENT(IN) :: that
1662 integer :: minute,hour,day,month
1664 call getval(this,minute=minute,hour=hour,day=day,month=month)
1667 if (
c_e(that%minute) .and. that%minute /= minute) res=.false.
1668 if (
c_e(that%hour) .and. that%hour /= hour) res=.false.
1669 if (
c_e(that%day) .and. that%day /= day) res=.false.
1670 if (
c_e(that%month) .and. that%month /= month) res=.false.
1672 if (
c_e(that%tendaysp))
then 1673 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
1677 END FUNCTION datetime_cyclicdatetime_eq
1679 ELEMENTAL FUNCTION c_e_cyclicdatetime(this)
result (res)
1680 TYPE(cyclicdatetime),
INTENT(in) :: this
1683 res = .not. this == cyclicdatetime_miss
1685 end FUNCTION c_e_cyclicdatetime
1690 FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate)
RESULT(this)
1691 INTEGER,
INTENT(IN),
OPTIONAL :: tendaysp
1692 INTEGER,
INTENT(IN),
OPTIONAL :: month
1693 INTEGER,
INTENT(IN),
OPTIONAL :: day
1694 INTEGER,
INTENT(IN),
OPTIONAL :: hour
1695 INTEGER,
INTENT(IN),
OPTIONAL :: minute
1696 CHARACTER(len=9),
INTENT(IN),
OPTIONAL :: chardate
1698 integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
1701 TYPE(cyclicdatetime) :: this
1703 if (
present(chardate))
then 1711 if (
c_e(chardate))
then 1713 read(chardate(1:1),
'(i1)',iostat=ios)ltendaysp
1715 if (ios /= 0)ltendaysp=imiss
1717 read(chardate(2:3),
'(i2)',iostat=ios)lmonth
1719 if (ios /= 0)lmonth=imiss
1721 read(chardate(4:5),
'(i2)',iostat=ios)lday
1723 if (ios /= 0)lday=imiss
1725 read(chardate(6:7),
'(i2)',iostat=ios)lhour
1727 if (ios /= 0)lhour=imiss
1729 read(chardate(8:9),
'(i2)',iostat=ios)lminute
1731 if (ios /= 0)lminute=imiss
1734 this%tendaysp=ltendaysp
1740 this%tendaysp=optio_l(tendaysp)
1741 this%month=optio_l(month)
1742 this%day=optio_l(day)
1743 this%hour=optio_l(hour)
1744 this%minute=optio_l(minute)
1747 END FUNCTION cyclicdatetime_new
1751 elemental FUNCTION cyclicdatetime_to_char(this)
RESULT(char)
1754 CHARACTER(len=80) :: char
1759 END FUNCTION cyclicdatetime_to_char
1774 FUNCTION cyclicdatetime_to_conventional(this)
RESULT(dtc)
1779 integer :: year,month,day,hour
1784 if ( .not.
c_e(this))
then 1785 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
1790 if (
c_e(this%minute))
return 1792 if (
c_e(this%day) .and.
c_e(this%month) .and.
c_e(this%tendaysp))
return 1794 if (
c_e(this%day) .and.
c_e(this%month))
then 1795 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
1796 else if (
c_e(this%tendaysp) .and.
c_e(this%month))
then 1797 day=(this%tendaysp-1)*10+1
1798 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
1799 else if (
c_e(this%month))
then 1800 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
1801 else if (
c_e(this%day))
then 1806 if (
c_e(this%hour))
then 1807 call getval(dtc,year=year,month=month,day=day,hour=hour)
1808 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
1812 END FUNCTION cyclicdatetime_to_conventional
1816 FUNCTION trim_cyclicdatetime_to_char(in)
RESULT(char)
1819 CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
1821 char=cyclicdatetime_to_char(in)
1823 END FUNCTION trim_cyclicdatetime_to_char
1827 SUBROUTINE display_cyclicdatetime(this)
1830 print*,
"CYCLICDATETIME: ",
to_char(this)
1832 end subroutine display_cyclicdatetime
1835 #include "array_utilities_inc.F90" Method for removing elements of the array at a desired position.
Functions that return a trimmed CHARACTER representation of the input variable.
Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o...
Operatore di valore assoluto di un intervallo.
Class for expressing an absolute time value.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Index method with sorted array.
Classi per la gestione delle coordinate temporali.
Method for inserting elements of the array at a desired position.
Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ...
Distruttori per le 2 classi.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Restituiscono il valore dell'oggetto nella forma desiderata.
Operatore di resto della divisione.
Costruttori per le classi datetime e timedelta.
Definitions of constants and functions for working with missing values.
Class for expressing a relative time interval.
Quick method to append an element to the array.
classe per la gestione del logging
Class for expressing a cyclic datetime.
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.