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)
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)
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
632 CALL
getval(this, isodate=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)
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)
742 TYPE(datetime
),
INTENT(IN) :: this
744 TYPE(datetime
) :: 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)
778 TYPE(datetime
),
INTENT(IN) :: this
780 TYPE(datetime
) :: 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)
804 TYPE(datetime
),
INTENT(out) :: this
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)
816 TYPE(datetime
) :: this(:)
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)
843 TYPE(datetime
),
INTENT(in) :: this
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)
1176 INTEGER(kind=int_ll) :: timedelta_getamsec
1178 timedelta_getamsec = this%iminuti
1180 END FUNCTION timedelta_getamsec
1188 FUNCTION timedelta_depop(this)
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)
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)
1343 TYPE(datetime
),
INTENT(IN) :: this
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)
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)
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
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)
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
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)
1777 TYPE(datetime
) :: 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"
Classi per la gestione delle coordinate temporali.
Method for removing elements of the array at a desired position.
Definitions of constants and functions for working with missing values.
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.
Index method with sorted array.
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.
Class for expressing a relative time interval.
Quick method to append an element to the array.
classe per la gestione del logging
Utilities for CHARACTER variables.
Class for expressing a cyclic datetime.
Definition of constants to be used for declaring variables of a desired type.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.