libsim Versione 7.1.11

◆ cyclicdatetime_to_conventional()

type(datetime) function, public cyclicdatetime_to_conventional ( type(cyclicdatetime), intent(in)  this)

Restituisce una rappresentazione convenzionale in forma datetime cyclicdatetime.

The following conventional code values are used to specify which data was taken into account in the computation: year=1001 : dayly values of a specified month (depends by day and month) year=1002 : dayly,hourly values of a specified month (depends by day and month and hour) year=1003 : 10 day period of a specified month (depends by day(1,11,21) and month) year=1004 : 10 day period of a specified month,hourly (depends by day(1,11,21) and month and hour) year=1005 : mounthly values (depend by month) year=1006 : mounthly,hourly values (depend by month and hour) year=1007 : yearly values (no other time dependence) year=1008 : yearly,hourly values (depend by year and hour) The other conventional month hour and minute should be 01 when they are not significative, day should be 1 or, if year=1003 or year=1004 is used, 1,11 or 21.

Parametri
[in]thiscycliddatetime to use in compute

Definizione alla linea 2408 del file datetime_class.F90.

2409! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2410! authors:
2411! Davide Cesari <dcesari@arpa.emr.it>
2412! Paolo Patruno <ppatruno@arpa.emr.it>
2413
2414! This program is free software; you can redistribute it and/or
2415! modify it under the terms of the GNU General Public License as
2416! published by the Free Software Foundation; either version 2 of
2417! the License, or (at your option) any later version.
2418
2419! This program is distributed in the hope that it will be useful,
2420! but WITHOUT ANY WARRANTY; without even the implied warranty of
2421! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2422! GNU General Public License for more details.
2423
2424! You should have received a copy of the GNU General Public License
2425! along with this program. If not, see <http://www.gnu.org/licenses/>.
2426#include "config.h"
2427
2441MODULE datetime_class
2442USE kinds
2443USE log4fortran
2444USE err_handling
2448IMPLICIT NONE
2449
2450INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2451
2453TYPE datetime
2454 PRIVATE
2455 INTEGER(KIND=int_ll) :: iminuti
2456END TYPE datetime
2457
2465TYPE timedelta
2466 PRIVATE
2467 INTEGER(KIND=int_ll) :: iminuti
2468 INTEGER :: month
2469END TYPE timedelta
2470
2471
2475TYPE cyclicdatetime
2476 PRIVATE
2477 INTEGER :: minute
2478 INTEGER :: hour
2479 INTEGER :: day
2480 INTEGER :: tendaysp
2481 INTEGER :: month
2482END TYPE cyclicdatetime
2483
2484
2486TYPE(datetime), PARAMETER :: datetime_miss=datetime(illmiss)
2488TYPE(timedelta), PARAMETER :: timedelta_miss=timedelta(illmiss, 0)
2490TYPE(timedelta), PARAMETER :: timedelta_0=timedelta(0, 0)
2492INTEGER, PARAMETER :: datetime_utc=1
2494INTEGER, PARAMETER :: datetime_local=2
2496TYPE(datetime), PARAMETER :: datetime_min=datetime(-huge(1_int_ll)-1)
2498TYPE(datetime), PARAMETER :: datetime_max=datetime(huge(1_int_ll)-1)
2500TYPE(timedelta), PARAMETER :: timedelta_min=timedelta(-huge(1_int_ll)-1,0)
2502TYPE(timedelta), PARAMETER :: timedelta_max=timedelta(huge(1_int_ll)-1,0)
2504TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2505
2506
2507INTEGER(kind=dateint), PARAMETER :: &
2508 sec_in_day=86400, &
2509 sec_in_hour=3600, &
2510 sec_in_min=60, &
2511 min_in_day=1440, &
2512 min_in_hour=60, &
2513 hour_in_day=24
2514
2515INTEGER,PARAMETER :: &
2516 year0=1, & ! anno di origine per iminuti
2517 d1=365, & ! giorni/1 anno nel calendario gregoriano
2518 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2519 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2520 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2521 ianno(13,2)=reshape((/ &
2522 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2523 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2524
2525INTEGER(KIND=int_ll),PARAMETER :: &
2526 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2527
2531INTERFACE init
2532 MODULE PROCEDURE datetime_init, timedelta_init
2533END INTERFACE
2534
2537INTERFACE delete
2538 MODULE PROCEDURE datetime_delete, timedelta_delete
2539END INTERFACE
2540
2542INTERFACE getval
2543 MODULE PROCEDURE datetime_getval, timedelta_getval
2544END INTERFACE
2545
2547INTERFACE to_char
2548 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2549END INTERFACE
2550
2551
2569INTERFACE t2c
2570 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2571END INTERFACE
2572
2578INTERFACE OPERATOR (==)
2579 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2580 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2581END INTERFACE
2582
2588INTERFACE OPERATOR (/=)
2589 MODULE PROCEDURE datetime_ne, timedelta_ne
2590END INTERFACE
2591
2599INTERFACE OPERATOR (>)
2600 MODULE PROCEDURE datetime_gt, timedelta_gt
2601END INTERFACE
2602
2610INTERFACE OPERATOR (<)
2611 MODULE PROCEDURE datetime_lt, timedelta_lt
2612END INTERFACE
2613
2621INTERFACE OPERATOR (>=)
2622 MODULE PROCEDURE datetime_ge, timedelta_ge
2623END INTERFACE
2624
2632INTERFACE OPERATOR (<=)
2633 MODULE PROCEDURE datetime_le, timedelta_le
2634END INTERFACE
2635
2642INTERFACE OPERATOR (+)
2643 MODULE PROCEDURE datetime_add, timedelta_add
2644END INTERFACE
2645
2653INTERFACE OPERATOR (-)
2654 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
2655END INTERFACE
2656
2662INTERFACE OPERATOR (*)
2663 MODULE PROCEDURE timedelta_mult, timedelta_tlum
2664END INTERFACE
2665
2672INTERFACE OPERATOR (/)
2673 MODULE PROCEDURE timedelta_divint, timedelta_divtd
2674END INTERFACE
2675
2686INTERFACE mod
2687 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
2688END INTERFACE
2689
2692INTERFACE abs
2693 MODULE PROCEDURE timedelta_abs
2694END INTERFACE
2695
2698INTERFACE read_unit
2699 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
2700 timedelta_read_unit, timedelta_vect_read_unit
2701END INTERFACE
2702
2705INTERFACE write_unit
2706 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
2707 timedelta_write_unit, timedelta_vect_write_unit
2708END INTERFACE
2709
2711INTERFACE display
2712 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
2713END INTERFACE
2714
2716INTERFACE c_e
2717 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
2718END INTERFACE
2719
2720#undef VOL7D_POLY_TYPE
2721#undef VOL7D_POLY_TYPES
2722#undef ENABLE_SORT
2723#define VOL7D_POLY_TYPE TYPE(datetime)
2724#define VOL7D_POLY_TYPES _datetime
2725#define ENABLE_SORT
2726#include "array_utilities_pre.F90"
2727
2728
2729#define ARRAYOF_ORIGTYPE TYPE(datetime)
2730#define ARRAYOF_TYPE arrayof_datetime
2731#define ARRAYOF_ORIGEQ 1
2732#include "arrayof_pre.F90"
2733! from arrayof
2734
2735PRIVATE
2736
2737PUBLIC datetime, datetime_miss, datetime_utc, datetime_local, &
2738 datetime_min, datetime_max, &
2739 datetime_new, datetime_new_now, init, delete, getval, to_char, t2c, &
2741 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
2742 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
2743 OPERATOR(*), OPERATOR(/), mod, abs, &
2744 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
2745 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
2746 display, c_e, &
2747 count_distinct, pack_distinct, &
2748 count_distinct_sorted, pack_distinct_sorted, &
2749 count_and_pack_distinct, &
2750 map_distinct, map_inv_distinct, index, index_sorted, sort, &
2751 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
2752PUBLIC insert, append, remove, packarray
2753PUBLIC insert_unique, append_unique
2754PUBLIC cyclicdatetime_to_conventional
2755
2756CONTAINS
2757
2758
2759! ==============
2760! == datetime ==
2761! ==============
2762
2769ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
2770 unixtime, isodate, simpledate) RESULT(this)
2771INTEGER,INTENT(IN),OPTIONAL :: year
2772INTEGER,INTENT(IN),OPTIONAL :: month
2773INTEGER,INTENT(IN),OPTIONAL :: day
2774INTEGER,INTENT(IN),OPTIONAL :: hour
2775INTEGER,INTENT(IN),OPTIONAL :: minute
2776INTEGER,INTENT(IN),OPTIONAL :: msec
2777INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2778CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2779CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2780
2781TYPE(datetime) :: this
2782INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2783CHARACTER(len=23) :: datebuf
2784
2785IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
2786 lyear = year
2787 IF (PRESENT(month)) THEN
2788 lmonth = month
2789 ELSE
2790 lmonth = 1
2791 ENDIF
2792 IF (PRESENT(day)) THEN
2793 lday = day
2794 ELSE
2795 lday = 1
2796 ENDIF
2797 IF (PRESENT(hour)) THEN
2798 lhour = hour
2799 ELSE
2800 lhour = 0
2801 ENDIF
2802 IF (PRESENT(minute)) THEN
2803 lminute = minute
2804 ELSE
2805 lminute = 0
2806 ENDIF
2807 IF (PRESENT(msec)) THEN
2808 lmsec = msec
2809 ELSE
2810 lmsec = 0
2811 ENDIF
2812
2813 if (c_e(lday) .and. c_e(lmonth) .and. c_e(lyear) .and. c_e(lhour) &
2814 .and. c_e(lminute) .and. c_e(lmsec)) then
2815 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2816 else
2817 this=datetime_miss
2818 end if
2819
2820ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
2821 if (c_e(unixtime)) then
2822 this%iminuti = (unixtime + unsec)*1000
2823 else
2824 this=datetime_miss
2825 end if
2826
2827ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
2828
2829 IF (c_e(isodate) .AND. len_trim(isodate) > 0) THEN
2830 datebuf(1:23) = '0001-01-01 00:00:00.000'
2831 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
2832 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
2833 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2834 lmsec = lmsec + lsec*1000
2835 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2836 RETURN
2837
2838100 CONTINUE ! condizione di errore in isodate
2839 CALL delete(this)
2840 RETURN
2841 ELSE
2842 this = datetime_miss
2843 ENDIF
2844
2845ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
2846 IF (c_e(simpledate) .AND. len_trim(simpledate) > 0)THEN
2847 datebuf(1:17) = '00010101000000000'
2848 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2849 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
2850 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2851 lmsec = lmsec + lsec*1000
2852 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2853 RETURN
2854
2855120 CONTINUE ! condizione di errore in simpledate
2856 CALL delete(this)
2857 RETURN
2858 ELSE
2859 this = datetime_miss
2860 ENDIF
2861
2862ELSE
2863 this = datetime_miss
2864ENDIF
2865
2866END FUNCTION datetime_new
2867
2868
2870FUNCTION datetime_new_now(now) RESULT(this)
2871INTEGER,INTENT(IN) :: now
2872TYPE(datetime) :: this
2873
2874INTEGER :: dt(8)
2875
2876IF (c_e(now)) THEN
2877 CALL date_and_time(values=dt)
2878 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
2879 CALL init(this, year=dt(1), month=dt(2), day=dt(3), hour=dt(5), minute=dt(6), &
2880 msec=dt(7)*1000+dt(8))
2881ELSE
2882 this = datetime_miss
2883ENDIF
2884
2885END FUNCTION datetime_new_now
2886
2887
2894SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
2895 unixtime, isodate, simpledate, now)
2896TYPE(datetime),INTENT(INOUT) :: this
2897INTEGER,INTENT(IN),OPTIONAL :: year
2898INTEGER,INTENT(IN),OPTIONAL :: month
2899INTEGER,INTENT(IN),OPTIONAL :: day
2900INTEGER,INTENT(IN),OPTIONAL :: hour
2901INTEGER,INTENT(IN),OPTIONAL :: minute
2902INTEGER,INTENT(IN),OPTIONAL :: msec
2903INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2904CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2905CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2906INTEGER,INTENT(IN),OPTIONAL :: now
2907
2908IF (PRESENT(now)) THEN
2909 this = datetime_new_now(now)
2910ELSE
2911 this = datetime_new(year, month, day, hour, minute, msec, &
2912 unixtime, isodate, simpledate)
2913ENDIF
2914
2915END SUBROUTINE datetime_init
2916
2917
2918ELEMENTAL SUBROUTINE datetime_delete(this)
2919TYPE(datetime),INTENT(INOUT) :: this
2920
2921this%iminuti = illmiss
2922
2923END SUBROUTINE datetime_delete
2924
2925
2930PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
2931 unixtime, isodate, simpledate, oraclesimdate)
2932TYPE(datetime),INTENT(IN) :: this
2933INTEGER,INTENT(OUT),OPTIONAL :: year
2934INTEGER,INTENT(OUT),OPTIONAL :: month
2935INTEGER,INTENT(OUT),OPTIONAL :: day
2936INTEGER,INTENT(OUT),OPTIONAL :: hour
2937INTEGER,INTENT(OUT),OPTIONAL :: minute
2938INTEGER,INTENT(OUT),OPTIONAL :: msec
2939INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime
2940CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
2941CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
2942CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
2943
2944INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2945CHARACTER(len=23) :: datebuf
2946
2947IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
2948 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
2949 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
2950
2951 IF (this == datetime_miss) THEN
2952
2953 IF (PRESENT(msec)) THEN
2954 msec = imiss
2955 ENDIF
2956 IF (PRESENT(minute)) THEN
2957 minute = imiss
2958 ENDIF
2959 IF (PRESENT(hour)) THEN
2960 hour = imiss
2961 ENDIF
2962 IF (PRESENT(day)) THEN
2963 day = imiss
2964 ENDIF
2965 IF (PRESENT(month)) THEN
2966 month = imiss
2967 ENDIF
2968 IF (PRESENT(year)) THEN
2969 year = imiss
2970 ENDIF
2971 IF (PRESENT(isodate)) THEN
2972 isodate = cmiss
2973 ENDIF
2974 IF (PRESENT(simpledate)) THEN
2975 simpledate = cmiss
2976 ENDIF
2977 IF (PRESENT(oraclesimdate)) THEN
2978!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2979!!$ 'obsoleto, usare piuttosto simpledate')
2980 oraclesimdate=cmiss
2981 ENDIF
2982 IF (PRESENT(unixtime)) THEN
2983 unixtime = illmiss
2984 ENDIF
2985
2986 ELSE
2987
2988 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2989 IF (PRESENT(msec)) THEN
2990 msec = lmsec
2991 ENDIF
2992 IF (PRESENT(minute)) THEN
2993 minute = lminute
2994 ENDIF
2995 IF (PRESENT(hour)) THEN
2996 hour = lhour
2997 ENDIF
2998 IF (PRESENT(day)) THEN
2999 day = lday
3000 ENDIF
3001 IF (PRESENT(month)) THEN
3002 month = lmonth
3003 ENDIF
3004 IF (PRESENT(year)) THEN
3005 year = lyear
3006 ENDIF
3007 IF (PRESENT(isodate)) THEN
3008 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3009 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
3010 '.', mod(lmsec, 1000)
3011 isodate = datebuf(1:min(len(isodate),23))
3012 ENDIF
3013 IF (PRESENT(simpledate)) THEN
3014 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
3015 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
3016 simpledate = datebuf(1:min(len(simpledate),17))
3017 ENDIF
3018 IF (PRESENT(oraclesimdate)) THEN
3019!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3020!!$ 'obsoleto, usare piuttosto simpledate')
3021 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
3022 ENDIF
3023 IF (PRESENT(unixtime)) THEN
3024 unixtime = this%iminuti/1000_int_ll-unsec
3025 ENDIF
3026
3027 ENDIF
3028ENDIF
3029
3030END SUBROUTINE datetime_getval
3031
3032
3035elemental FUNCTION datetime_to_char(this) RESULT(char)
3036TYPE(datetime),INTENT(IN) :: this
3037
3038CHARACTER(len=23) :: char
3039
3040CALL getval(this, isodate=char)
3041
3042END FUNCTION datetime_to_char
3043
3044
3045FUNCTION trim_datetime_to_char(in) RESULT(char)
3046TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3047
3048CHARACTER(len=len_trim(datetime_to_char(in))) :: char
3049
3050char=datetime_to_char(in)
3051
3052END FUNCTION trim_datetime_to_char
3053
3054
3055
3056SUBROUTINE display_datetime(this)
3057TYPE(datetime),INTENT(in) :: this
3058
3059print*,"TIME: ",to_char(this)
3060
3061end subroutine display_datetime
3062
3063
3064
3065SUBROUTINE display_timedelta(this)
3066TYPE(timedelta),INTENT(in) :: this
3067
3068print*,"TIMEDELTA: ",to_char(this)
3069
3070end subroutine display_timedelta
3071
3072
3073
3074ELEMENTAL FUNCTION c_e_datetime(this) result (res)
3075TYPE(datetime),INTENT(in) :: this
3076LOGICAL :: res
3077
3078res = .not. this == datetime_miss
3079
3080end FUNCTION c_e_datetime
3081
3082
3083ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
3084TYPE(datetime),INTENT(IN) :: this, that
3085LOGICAL :: res
3086
3087res = this%iminuti == that%iminuti
3088
3089END FUNCTION datetime_eq
3090
3091
3092ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3093TYPE(datetime),INTENT(IN) :: this, that
3094LOGICAL :: res
3095
3096res = .NOT.(this == that)
3097
3098END FUNCTION datetime_ne
3099
3100
3101ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3102TYPE(datetime),INTENT(IN) :: this, that
3103LOGICAL :: res
3104
3105res = this%iminuti > that%iminuti
3106
3107END FUNCTION datetime_gt
3108
3109
3110ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3111TYPE(datetime),INTENT(IN) :: this, that
3112LOGICAL :: res
3113
3114res = this%iminuti < that%iminuti
3115
3116END FUNCTION datetime_lt
3117
3118
3119ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3120TYPE(datetime),INTENT(IN) :: this, that
3121LOGICAL :: res
3122
3123IF (this == that) THEN
3124 res = .true.
3125ELSE IF (this > that) THEN
3126 res = .true.
3127ELSE
3128 res = .false.
3129ENDIF
3130
3131END FUNCTION datetime_ge
3132
3133
3134ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3135TYPE(datetime),INTENT(IN) :: this, that
3136LOGICAL :: res
3137
3138IF (this == that) THEN
3139 res = .true.
3140ELSE IF (this < that) THEN
3141 res = .true.
3142ELSE
3143 res = .false.
3144ENDIF
3145
3146END FUNCTION datetime_le
3147
3148
3149FUNCTION datetime_add(this, that) RESULT(res)
3150TYPE(datetime),INTENT(IN) :: this
3151TYPE(timedelta),INTENT(IN) :: that
3152TYPE(datetime) :: res
3153
3154INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3155
3156IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3157 res = datetime_miss
3158ELSE
3159 res%iminuti = this%iminuti + that%iminuti
3160 IF (that%month /= 0) THEN
3161 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
3162 minute=lminute, msec=lmsec)
3163 CALL init(res, year=lyear, month=lmonth+that%month, day=lday, &
3164 hour=lhour, minute=lminute, msec=lmsec)
3165 ENDIF
3166ENDIF
3167
3168END FUNCTION datetime_add
3169
3170
3171ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3172TYPE(datetime),INTENT(IN) :: this, that
3173TYPE(timedelta) :: res
3174
3175IF (this == datetime_miss .OR. that == datetime_miss) THEN
3176 res = timedelta_miss
3177ELSE
3178 res%iminuti = this%iminuti - that%iminuti
3179 res%month = 0
3180ENDIF
3181
3182END FUNCTION datetime_subdt
3183
3184
3185FUNCTION datetime_subtd(this, that) RESULT(res)
3186TYPE(datetime),INTENT(IN) :: this
3187TYPE(timedelta),INTENT(IN) :: that
3188TYPE(datetime) :: res
3189
3190INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3191
3192IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3193 res = datetime_miss
3194ELSE
3195 res%iminuti = this%iminuti - that%iminuti
3196 IF (that%month /= 0) THEN
3197 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
3198 minute=lminute, msec=lmsec)
3199 CALL init(res, year=lyear, month=lmonth-that%month, day=lday, &
3200 hour=lhour, minute=lminute, msec=lmsec)
3201 ENDIF
3202ENDIF
3203
3204END FUNCTION datetime_subtd
3205
3206
3211SUBROUTINE datetime_read_unit(this, unit)
3212TYPE(datetime),INTENT(out) :: this
3213INTEGER, INTENT(in) :: unit
3214CALL datetime_vect_read_unit((/this/), unit)
3215
3216END SUBROUTINE datetime_read_unit
3217
3218
3223SUBROUTINE datetime_vect_read_unit(this, unit)
3224TYPE(datetime) :: this(:)
3225INTEGER, INTENT(in) :: unit
3226
3227CHARACTER(len=40) :: form
3228CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3229INTEGER :: i
3230
3231ALLOCATE(dateiso(SIZE(this)))
3232INQUIRE(unit, form=form)
3233IF (form == 'FORMATTED') THEN
3234 READ(unit,'(A23,1X)')dateiso
3235ELSE
3236 READ(unit)dateiso
3237ENDIF
3238DO i = 1, SIZE(dateiso)
3239 CALL init(this(i), isodate=dateiso(i))
3240ENDDO
3241DEALLOCATE(dateiso)
3242
3243END SUBROUTINE datetime_vect_read_unit
3244
3245
3250SUBROUTINE datetime_write_unit(this, unit)
3251TYPE(datetime),INTENT(in) :: this
3252INTEGER, INTENT(in) :: unit
3253
3254CALL datetime_vect_write_unit((/this/), unit)
3255
3256END SUBROUTINE datetime_write_unit
3257
3258
3263SUBROUTINE datetime_vect_write_unit(this, unit)
3264TYPE(datetime),INTENT(in) :: this(:)
3265INTEGER, INTENT(in) :: unit
3266
3267CHARACTER(len=40) :: form
3268CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3269INTEGER :: i
3270
3271ALLOCATE(dateiso(SIZE(this)))
3272DO i = 1, SIZE(dateiso)
3273 CALL getval(this(i), isodate=dateiso(i))
3274ENDDO
3275INQUIRE(unit, form=form)
3276IF (form == 'FORMATTED') THEN
3277 WRITE(unit,'(A23,1X)')dateiso
3278ELSE
3279 WRITE(unit)dateiso
3280ENDIF
3281DEALLOCATE(dateiso)
3282
3283END SUBROUTINE datetime_vect_write_unit
3284
3285
3286#include "arrayof_post.F90"
3287
3288
3289! ===============
3290! == timedelta ==
3291! ===============
3298FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3299 isodate, simpledate, oraclesimdate) RESULT (this)
3300INTEGER,INTENT(IN),OPTIONAL :: year
3301INTEGER,INTENT(IN),OPTIONAL :: month
3302INTEGER,INTENT(IN),OPTIONAL :: day
3303INTEGER,INTENT(IN),OPTIONAL :: hour
3304INTEGER,INTENT(IN),OPTIONAL :: minute
3305INTEGER,INTENT(IN),OPTIONAL :: sec
3306INTEGER,INTENT(IN),OPTIONAL :: msec
3307CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3308CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3309CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3310
3311TYPE(timedelta) :: this
3312
3313CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3314 isodate, simpledate, oraclesimdate)
3315
3316END FUNCTION timedelta_new
3317
3318
3323SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3324 isodate, simpledate, oraclesimdate)
3325TYPE(timedelta),INTENT(INOUT) :: this
3326INTEGER,INTENT(IN),OPTIONAL :: year
3327INTEGER,INTENT(IN),OPTIONAL :: month
3328INTEGER,INTENT(IN),OPTIONAL :: day
3329INTEGER,INTENT(IN),OPTIONAL :: hour
3330INTEGER,INTENT(IN),OPTIONAL :: minute
3331INTEGER,INTENT(IN),OPTIONAL :: sec
3332INTEGER,INTENT(IN),OPTIONAL :: msec
3333CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3334CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3335CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3336
3337INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3338CHARACTER(len=23) :: datebuf
3339
3340this%month = 0
3341
3342IF (PRESENT(isodate)) THEN
3343 datebuf(1:23) = '0000000000 00:00:00.000'
3344 l = len_trim(isodate)
3345! IF (l > 0) THEN
3346 n = index(trim(isodate), ' ') ! align blank space separator
3347 IF (n > 0) THEN
3348 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3349 datebuf(12-n:12-n+l-1) = isodate(:l)
3350 ELSE
3351 datebuf(1:l) = isodate(1:l)
3352 ENDIF
3353! ENDIF
3354
3355! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3356 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3357 h, m, s, ms
3358 this%month = lmonth + 12*lyear
3359 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3360 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3361 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3362 RETURN
3363
3364200 CONTINUE ! condizione di errore in isodate
3365 CALL delete(this)
3366 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3367 CALL raise_error()
3368
3369ELSE IF (PRESENT(simpledate)) THEN
3370 datebuf(1:17) = '00000000000000000'
3371 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3372 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3373 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3374 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3375 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3376
3377220 CONTINUE ! condizione di errore in simpledate
3378 CALL delete(this)
3379 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3380 CALL raise_error()
3381 RETURN
3382
3383ELSE IF (PRESENT(oraclesimdate)) THEN
3384 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3385 'obsoleto, usare piuttosto simpledate')
3386 READ(oraclesimdate, '(I8,2I2)')d, h, m
3387 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3388 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3389
3390ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3391 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3392 .and. .not. present(msec) .and. .not. present(isodate) &
3393 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3394
3395 this=timedelta_miss
3396
3397ELSE
3398 this%iminuti = 0
3399 IF (PRESENT(year)) THEN
3400 if (c_e(year))then
3401 this%month = this%month + year*12
3402 else
3403 this=timedelta_miss
3404 return
3405 end if
3406 ENDIF
3407 IF (PRESENT(month)) THEN
3408 if (c_e(month))then
3409 this%month = this%month + month
3410 else
3411 this=timedelta_miss
3412 return
3413 end if
3414 ENDIF
3415 IF (PRESENT(day)) THEN
3416 if (c_e(day))then
3417 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3418 else
3419 this=timedelta_miss
3420 return
3421 end if
3422 ENDIF
3423 IF (PRESENT(hour)) THEN
3424 if (c_e(hour))then
3425 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3426 else
3427 this=timedelta_miss
3428 return
3429 end if
3430 ENDIF
3431 IF (PRESENT(minute)) THEN
3432 if (c_e(minute))then
3433 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3434 else
3435 this=timedelta_miss
3436 return
3437 end if
3438 ENDIF
3439 IF (PRESENT(sec)) THEN
3440 if (c_e(sec))then
3441 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3442 else
3443 this=timedelta_miss
3444 return
3445 end if
3446 ENDIF
3447 IF (PRESENT(msec)) THEN
3448 if (c_e(msec))then
3449 this%iminuti = this%iminuti + msec
3450 else
3451 this=timedelta_miss
3452 return
3453 end if
3454 ENDIF
3455ENDIF
3456
3457
3458
3459
3460END SUBROUTINE timedelta_init
3461
3462
3463SUBROUTINE timedelta_delete(this)
3464TYPE(timedelta),INTENT(INOUT) :: this
3465
3466this%iminuti = imiss
3467this%month = 0
3468
3469END SUBROUTINE timedelta_delete
3470
3471
3476PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3477 day, hour, minute, sec, msec, &
3478 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3479TYPE(timedelta),INTENT(IN) :: this
3480INTEGER,INTENT(OUT),OPTIONAL :: year
3481INTEGER,INTENT(OUT),OPTIONAL :: month
3482INTEGER,INTENT(OUT),OPTIONAL :: amonth
3483INTEGER,INTENT(OUT),OPTIONAL :: day
3484INTEGER,INTENT(OUT),OPTIONAL :: hour
3485INTEGER,INTENT(OUT),OPTIONAL :: minute
3486INTEGER,INTENT(OUT),OPTIONAL :: sec
3487INTEGER,INTENT(OUT),OPTIONAL :: msec
3488INTEGER,INTENT(OUT),OPTIONAL :: ahour
3489INTEGER,INTENT(OUT),OPTIONAL :: aminute
3490INTEGER,INTENT(OUT),OPTIONAL :: asec
3491INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec
3492CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3493CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3494CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3495
3496CHARACTER(len=23) :: datebuf
3497
3498IF (PRESENT(amsec)) THEN
3499 amsec = this%iminuti
3500ENDIF
3501IF (PRESENT(asec)) THEN
3502 asec = int(this%iminuti/1000_int_ll)
3503ENDIF
3504IF (PRESENT(aminute)) THEN
3505 aminute = int(this%iminuti/60000_int_ll)
3506ENDIF
3507IF (PRESENT(ahour)) THEN
3508 ahour = int(this%iminuti/3600000_int_ll)
3509ENDIF
3510IF (PRESENT(msec)) THEN
3511 msec = int(mod(this%iminuti, 1000_int_ll))
3512ENDIF
3513IF (PRESENT(sec)) THEN
3514 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3515ENDIF
3516IF (PRESENT(minute)) THEN
3517 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3518ENDIF
3519IF (PRESENT(hour)) THEN
3520 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3521ENDIF
3522IF (PRESENT(day)) THEN
3523 day = int(this%iminuti/86400000_int_ll)
3524ENDIF
3525IF (PRESENT(amonth)) THEN
3526 amonth = this%month
3527ENDIF
3528IF (PRESENT(month)) THEN
3529 month = mod(this%month-1,12)+1
3530ENDIF
3531IF (PRESENT(year)) THEN
3532 year = this%month/12
3533ENDIF
3534IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3535 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3536 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), ':', &
3537 mod(this%iminuti/60000_int_ll, 60_int_ll), ':', mod(this%iminuti/1000_int_ll, 60_int_ll), &
3538 '.', mod(this%iminuti, 1000_int_ll)
3539 isodate = datebuf(1:min(len(isodate),23))
3540
3541ENDIF
3542IF (PRESENT(simpledate)) THEN
3543 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3544 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3545 mod(this%iminuti/60000_int_ll, 60_int_ll), mod(this%iminuti/1000_int_ll, 60_int_ll), &
3546 mod(this%iminuti, 1000_int_ll)
3547 simpledate = datebuf(1:min(len(simpledate),17))
3548ENDIF
3549IF (PRESENT(oraclesimdate)) THEN
3550!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3551!!$ 'obsoleto, usare piuttosto simpledate')
3552 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3553 mod(this%iminuti/3600000_int_ll, 24_int_ll), mod(this%iminuti/60000_int_ll, 60_int_ll)
3554ENDIF
3555
3556END SUBROUTINE timedelta_getval
3557
3558
3561elemental FUNCTION timedelta_to_char(this) RESULT(char)
3562TYPE(timedelta),INTENT(IN) :: this
3563
3564CHARACTER(len=23) :: char
3565
3566CALL getval(this, isodate=char)
3567
3568END FUNCTION timedelta_to_char
3569
3570
3571FUNCTION trim_timedelta_to_char(in) RESULT(char)
3572TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3573
3574CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3575
3576char=timedelta_to_char(in)
3577
3578END FUNCTION trim_timedelta_to_char
3579
3580
3582elemental FUNCTION timedelta_getamsec(this)
3583TYPE(timedelta),INTENT(IN) :: this
3584INTEGER(kind=int_ll) :: timedelta_getamsec
3585
3586timedelta_getamsec = this%iminuti
3587
3588END FUNCTION timedelta_getamsec
3589
3590
3596FUNCTION timedelta_depop(this)
3597TYPE(timedelta),INTENT(IN) :: this
3598TYPE(timedelta) :: timedelta_depop
3599
3600TYPE(datetime) :: tmpdt
3601
3602IF (this%month == 0) THEN
3603 timedelta_depop = this
3604ELSE
3605 tmpdt = datetime_new(1970, 1, 1)
3606 timedelta_depop = (tmpdt + this) - tmpdt
3607ENDIF
3608
3609END FUNCTION timedelta_depop
3610
3611
3612elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3613TYPE(timedelta),INTENT(IN) :: this, that
3614LOGICAL :: res
3615
3616res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3617
3618END FUNCTION timedelta_eq
3619
3620
3621ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3622TYPE(timedelta),INTENT(IN) :: this, that
3623LOGICAL :: res
3624
3625res = .NOT.(this == that)
3626
3627END FUNCTION timedelta_ne
3628
3629
3630ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
3631TYPE(timedelta),INTENT(IN) :: this, that
3632LOGICAL :: res
3633
3634res = this%iminuti > that%iminuti
3635
3636END FUNCTION timedelta_gt
3637
3638
3639ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
3640TYPE(timedelta),INTENT(IN) :: this, that
3641LOGICAL :: res
3642
3643res = this%iminuti < that%iminuti
3644
3645END FUNCTION timedelta_lt
3646
3647
3648ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
3649TYPE(timedelta),INTENT(IN) :: this, that
3650LOGICAL :: res
3651
3652IF (this == that) THEN
3653 res = .true.
3654ELSE IF (this > that) THEN
3655 res = .true.
3656ELSE
3657 res = .false.
3658ENDIF
3659
3660END FUNCTION timedelta_ge
3661
3662
3663elemental FUNCTION timedelta_le(this, that) RESULT(res)
3664TYPE(timedelta),INTENT(IN) :: this, that
3665LOGICAL :: res
3666
3667IF (this == that) THEN
3668 res = .true.
3669ELSE IF (this < that) THEN
3670 res = .true.
3671ELSE
3672 res = .false.
3673ENDIF
3674
3675END FUNCTION timedelta_le
3676
3677
3678ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
3679TYPE(timedelta),INTENT(IN) :: this, that
3680TYPE(timedelta) :: res
3681
3682res%iminuti = this%iminuti + that%iminuti
3683res%month = this%month + that%month
3684
3685END FUNCTION timedelta_add
3686
3687
3688ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
3689TYPE(timedelta),INTENT(IN) :: this, that
3690TYPE(timedelta) :: res
3691
3692res%iminuti = this%iminuti - that%iminuti
3693res%month = this%month - that%month
3694
3695END FUNCTION timedelta_sub
3696
3697
3698ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
3699TYPE(timedelta),INTENT(IN) :: this
3700INTEGER,INTENT(IN) :: n
3701TYPE(timedelta) :: res
3702
3703res%iminuti = this%iminuti*n
3704res%month = this%month*n
3705
3706END FUNCTION timedelta_mult
3707
3708
3709ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
3710INTEGER,INTENT(IN) :: n
3711TYPE(timedelta),INTENT(IN) :: this
3712TYPE(timedelta) :: res
3713
3714res%iminuti = this%iminuti*n
3715res%month = this%month*n
3716
3717END FUNCTION timedelta_tlum
3718
3719
3720ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
3721TYPE(timedelta),INTENT(IN) :: this
3722INTEGER,INTENT(IN) :: n
3723TYPE(timedelta) :: res
3724
3725res%iminuti = this%iminuti/n
3726res%month = this%month/n
3727
3728END FUNCTION timedelta_divint
3729
3730
3731ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
3732TYPE(timedelta),INTENT(IN) :: this, that
3733INTEGER :: res
3734
3735res = int(this%iminuti/that%iminuti)
3736
3737END FUNCTION timedelta_divtd
3738
3739
3740elemental FUNCTION timedelta_mod(this, that) RESULT(res)
3741TYPE(timedelta),INTENT(IN) :: this, that
3742TYPE(timedelta) :: res
3743
3744res%iminuti = mod(this%iminuti, that%iminuti)
3745res%month = 0
3746
3747END FUNCTION timedelta_mod
3748
3749
3750ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
3751TYPE(datetime),INTENT(IN) :: this
3752TYPE(timedelta),INTENT(IN) :: that
3753TYPE(timedelta) :: res
3754
3755IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
3756 res = timedelta_0
3757ELSE
3758 res%iminuti = mod(this%iminuti, that%iminuti)
3759 res%month = 0
3760ENDIF
3761
3762END FUNCTION datetime_timedelta_mod
3763
3764
3765ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
3766TYPE(timedelta),INTENT(IN) :: this
3767TYPE(timedelta) :: res
3768
3769res%iminuti = abs(this%iminuti)
3770res%month = abs(this%month)
3771
3772END FUNCTION timedelta_abs
3773
3774
3779SUBROUTINE timedelta_read_unit(this, unit)
3780TYPE(timedelta),INTENT(out) :: this
3781INTEGER, INTENT(in) :: unit
3782
3783CALL timedelta_vect_read_unit((/this/), unit)
3784
3785END SUBROUTINE timedelta_read_unit
3786
3787
3792SUBROUTINE timedelta_vect_read_unit(this, unit)
3793TYPE(timedelta) :: this(:)
3794INTEGER, INTENT(in) :: unit
3795
3796CHARACTER(len=40) :: form
3797CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3798INTEGER :: i
3799
3800ALLOCATE(dateiso(SIZE(this)))
3801INQUIRE(unit, form=form)
3802IF (form == 'FORMATTED') THEN
3803 READ(unit,'(3(A23,1X))')dateiso
3804ELSE
3805 READ(unit)dateiso
3806ENDIF
3807DO i = 1, SIZE(dateiso)
3808 CALL init(this(i), isodate=dateiso(i))
3809ENDDO
3810DEALLOCATE(dateiso)
3811
3812END SUBROUTINE timedelta_vect_read_unit
3813
3814
3819SUBROUTINE timedelta_write_unit(this, unit)
3820TYPE(timedelta),INTENT(in) :: this
3821INTEGER, INTENT(in) :: unit
3822
3823CALL timedelta_vect_write_unit((/this/), unit)
3824
3825END SUBROUTINE timedelta_write_unit
3826
3827
3832SUBROUTINE timedelta_vect_write_unit(this, unit)
3833TYPE(timedelta),INTENT(in) :: this(:)
3834INTEGER, INTENT(in) :: unit
3835
3836CHARACTER(len=40) :: form
3837CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3838INTEGER :: i
3839
3840ALLOCATE(dateiso(SIZE(this)))
3841DO i = 1, SIZE(dateiso)
3842 CALL getval(this(i), isodate=dateiso(i))
3843ENDDO
3844INQUIRE(unit, form=form)
3845IF (form == 'FORMATTED') THEN
3846 WRITE(unit,'(3(A23,1X))')dateiso
3847ELSE
3848 WRITE(unit)dateiso
3849ENDIF
3850DEALLOCATE(dateiso)
3851
3852END SUBROUTINE timedelta_vect_write_unit
3853
3854
3855ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
3856TYPE(timedelta),INTENT(in) :: this
3857LOGICAL :: res
3858
3859res = .not. this == timedelta_miss
3860
3861end FUNCTION c_e_timedelta
3862
3863
3864elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
3865
3866!!omstart JELADATA5
3867! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3868! 1 IMINUTI)
3869!
3870! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
3871!
3872! variabili integer*4
3873! IN:
3874! IDAY,IMONTH,IYEAR, I*4
3875! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3876!
3877! OUT:
3878! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3879!!OMEND
3880
3881INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
3882INTEGER,intent(out) :: iminuti
3883
3884iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
3885
3886END SUBROUTINE jeladata5
3887
3888
3889elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
3890INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
3891INTEGER(KIND=int_ll),intent(out) :: imillisec
3892
3893imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
3894 + imsec
3895
3896END SUBROUTINE jeladata5_1
3897
3898
3899
3900elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
3901
3902!!omstart JELADATA6
3903! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3904! 1 IMINUTI)
3905!
3906! Calcola la data e l'ora corrispondente a IMINUTI dopo il
3907! 1/1/1
3908!
3909! variabili integer*4
3910! IN:
3911! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3912!
3913! OUT:
3914! IDAY,IMONTH,IYEAR, I*4
3915! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3916!!OMEND
3917
3918
3919INTEGER,intent(in) :: iminuti
3920INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
3921
3922INTEGER ::igiorno
3923
3924imin = mod(iminuti,60)
3925ihour = mod(iminuti,1440)/60
3926igiorno = iminuti/1440
3927IF (mod(iminuti,1440) < 0) igiorno = igiorno-1
3928CALL ndyin(igiorno,iday,imonth,iyear)
3929
3930END SUBROUTINE jeladata6
3931
3932
3933elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
3934INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
3935INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
3936
3937INTEGER :: igiorno
3938
3939imsec = int(mod(imillisec, 60000_int_ll)) ! partial msec
3940!imin = MOD(imillisec/60000_int_ll, 60)
3941!ihour = MOD(imillisec/3600000_int_ll, 24)
3942imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
3943ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
3944igiorno = int(imillisec/86400000_int_ll)
3945!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
3946CALL ndyin(igiorno,iday,imonth,iyear)
3947
3948END SUBROUTINE jeladata6_1
3949
3950
3951elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
3952
3953!!OMSTART NDYIN
3954! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
3955! restituisce la data fornendo in input il numero di
3956! giorni dal 1/1/1
3957!
3958!!omend
3959
3960INTEGER,intent(in) :: ndays
3961INTEGER,intent(out) :: igg, imm, iaa
3962integer :: n,lndays
3963
3964lndays=ndays
3965
3966n = lndays/d400
3967lndays = lndays - n*d400
3968iaa = year0 + n*400
3969n = min(lndays/d100, 3)
3970lndays = lndays - n*d100
3971iaa = iaa + n*100
3972n = lndays/d4
3973lndays = lndays - n*d4
3974iaa = iaa + n*4
3975n = min(lndays/d1, 3)
3976lndays = lndays - n*d1
3977iaa = iaa + n
3978n = bisextilis(iaa)
3979DO imm = 1, 12
3980 IF (lndays < ianno(imm+1,n)) EXIT
3981ENDDO
3982igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
3983
3984END SUBROUTINE ndyin
3985
3986
3987integer elemental FUNCTION ndays(igg,imm,iaa)
3988
3989!!OMSTART NDAYS
3990! FUNCTION NDAYS(IGG,IMM,IAA)
3991! restituisce il numero di giorni dal 1/1/1
3992! fornendo in input la data
3993!
3994!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3995! nota bene E' SICURO !!!
3996! un anno e' bisestile se divisibile per 4
3997! un anno rimane bisestile se divisibile per 400
3998! un anno NON e' bisestile se divisibile per 100
3999!
4000!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4001!
4002!!omend
4003
4004INTEGER, intent(in) :: igg, imm, iaa
4005
4006INTEGER :: lmonth, lyear
4007
4008! Limito il mese a [1-12] e correggo l'anno coerentemente
4009lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
4010lyear = iaa + (imm - lmonth)/12
4011ndays = igg+ianno(lmonth, bisextilis(lyear))
4012ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
4013 (lyear-year0)/400
4014
4015END FUNCTION ndays
4016
4017
4018elemental FUNCTION bisextilis(annum)
4019INTEGER,INTENT(in) :: annum
4020INTEGER :: bisextilis
4021
4022IF (mod(annum,4) == 0 .AND. (mod(annum,400) == 0 .EQV. mod(annum,100) == 0)) THEN
4023 bisextilis = 2
4024ELSE
4025 bisextilis = 1
4026ENDIF
4027END FUNCTION bisextilis
4028
4029
4030ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
4031TYPE(cyclicdatetime),INTENT(IN) :: this, that
4032LOGICAL :: res
4033
4034res = .true.
4035if (this%minute /= that%minute) res=.false.
4036if (this%hour /= that%hour) res=.false.
4037if (this%day /= that%day) res=.false.
4038if (this%month /= that%month) res=.false.
4039if (this%tendaysp /= that%tendaysp) res=.false.
4040
4041END FUNCTION cyclicdatetime_eq
4042
4043
4044ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
4045TYPE(cyclicdatetime),INTENT(IN) :: this
4046TYPE(datetime),INTENT(IN) :: that
4047LOGICAL :: res
4048
4049integer :: minute,hour,day,month
4050
4051call getval(that,minute=minute,hour=hour,day=day,month=month)
4052
4053res = .true.
4054if (c_e(this%minute) .and. this%minute /= minute) res=.false.
4055if (c_e(this%hour) .and. this%hour /= hour) res=.false.
4056if (c_e(this%day) .and. this%day /= day) res=.false.
4057if (c_e(this%month) .and. this%month /= month) res=.false.
4058if (c_e(this%tendaysp)) then
4059 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4060end if
4061
4062END FUNCTION cyclicdatetime_datetime_eq
4063
4064
4065ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
4066TYPE(datetime),INTENT(IN) :: this
4067TYPE(cyclicdatetime),INTENT(IN) :: that
4068LOGICAL :: res
4069
4070integer :: minute,hour,day,month
4071
4072call getval(this,minute=minute,hour=hour,day=day,month=month)
4073
4074res = .true.
4075if (c_e(that%minute) .and. that%minute /= minute) res=.false.
4076if (c_e(that%hour) .and. that%hour /= hour) res=.false.
4077if (c_e(that%day) .and. that%day /= day) res=.false.
4078if (c_e(that%month) .and. that%month /= month) res=.false.
4079
4080if (c_e(that%tendaysp)) then
4081 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4082end if
4083
4084
4085END FUNCTION datetime_cyclicdatetime_eq
4086
4087ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
4088TYPE(cyclicdatetime),INTENT(in) :: this
4089LOGICAL :: res
4090
4091res = .not. this == cyclicdatetime_miss
4092
4093end FUNCTION c_e_cyclicdatetime
4094
4095
4098FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4099INTEGER,INTENT(IN),OPTIONAL :: tendaysp
4100INTEGER,INTENT(IN),OPTIONAL :: month
4101INTEGER,INTENT(IN),OPTIONAL :: day
4102INTEGER,INTENT(IN),OPTIONAL :: hour
4103INTEGER,INTENT(IN),OPTIONAL :: minute
4104CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate
4105
4106integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4107
4108
4109TYPE(cyclicdatetime) :: this
4110
4111if (present(chardate)) then
4112
4113 ltendaysp=imiss
4114 lmonth=imiss
4115 lday=imiss
4116 lhour=imiss
4117 lminute=imiss
4118
4119 if (c_e(chardate))then
4120 ! TMMGGhhmm
4121 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4122 !print*,chardate(1:1),ios,ltendaysp
4123 if (ios /= 0)ltendaysp=imiss
4124
4125 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4126 !print*,chardate(2:3),ios,lmonth
4127 if (ios /= 0)lmonth=imiss
4128
4129 read(chardate(4:5),'(i2)',iostat=ios)lday
4130 !print*,chardate(4:5),ios,lday
4131 if (ios /= 0)lday=imiss
4132
4133 read(chardate(6:7),'(i2)',iostat=ios)lhour
4134 !print*,chardate(6:7),ios,lhour
4135 if (ios /= 0)lhour=imiss
4136
4137 read(chardate(8:9),'(i2)',iostat=ios)lminute
4138 !print*,chardate(8:9),ios,lminute
4139 if (ios /= 0)lminute=imiss
4140 end if
4141
4142 this%tendaysp=ltendaysp
4143 this%month=lmonth
4144 this%day=lday
4145 this%hour=lhour
4146 this%minute=lminute
4147else
4148 this%tendaysp=optio_l(tendaysp)
4149 this%month=optio_l(month)
4150 this%day=optio_l(day)
4151 this%hour=optio_l(hour)
4152 this%minute=optio_l(minute)
4153end if
4154
4155END FUNCTION cyclicdatetime_new
4156
4159elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4160TYPE(cyclicdatetime),INTENT(IN) :: this
4161
4162CHARACTER(len=80) :: char
4163
4164char=to_char(this%tendaysp)//";"//to_char(this%month)//";"//to_char(this%day)//";"//&
4165to_char(this%hour)//";"//to_char(this%minute)
4166
4167END FUNCTION cyclicdatetime_to_char
4168
4169
4182FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4183TYPE(cyclicdatetime),INTENT(IN) :: this
4184
4185TYPE(datetime) :: dtc
4186
4187integer :: year,month,day,hour
4188
4189dtc = datetime_miss
4190
4191! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4192if ( .not. c_e(this)) then
4193 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4194 return
4195end if
4196
4197! minute present -> not good for conventional datetime
4198if (c_e(this%minute)) return
4199! day, month and tendaysp present -> no good
4200if (c_e(this%day) .and. c_e(this%month) .and. c_e(this%tendaysp)) return
4201
4202if (c_e(this%day) .and. c_e(this%month)) then
4203 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4204else if (c_e(this%tendaysp) .and. c_e(this%month)) then
4205 day=(this%tendaysp-1)*10+1
4206 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4207else if (c_e(this%month)) then
4208 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4209else if (c_e(this%day)) then
4210 ! only day present -> no good
4211 return
4212end if
4213
4214if (c_e(this%hour)) then
4215 call getval(dtc,year=year,month=month,day=day,hour=hour)
4216 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4217end if
4218
4219
4220END FUNCTION cyclicdatetime_to_conventional
4221
4222
4223
4224FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4225TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4226
4227CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4228
4229char=cyclicdatetime_to_char(in)
4230
4231END FUNCTION trim_cyclicdatetime_to_char
4232
4233
4234
4235SUBROUTINE display_cyclicdatetime(this)
4236TYPE(cyclicdatetime),INTENT(in) :: this
4237
4238print*,"CYCLICDATETIME: ",to_char(this)
4239
4240end subroutine display_cyclicdatetime
4241
4242
4243#include "array_utilities_inc.F90"
4244
4245END MODULE datetime_class
4246
Operatore di valore assoluto di un intervallo.
Quick method to append an element to the array.
Distruttori per le 2 classi.
Restituiscono il valore dell'oggetto nella forma desiderata.
Index method with sorted array.
Costruttori per le classi datetime e timedelta.
Method for inserting elements of the array at a desired position.
Operatore di resto della divisione.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o...
Method for removing elements of the array at a desired position.
Functions that return a trimmed CHARACTER representation of the input variable.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ...
Index method.
Utilities for CHARACTER variables.
Classi per la gestione delle coordinate temporali.
Gestione degli errori.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:251
classe per la gestione del logging
Definitions of constants and functions for working with missing values.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Class for expressing a cyclic datetime.
Class for expressing an absolute time value.
Class for expressing a relative time interval.

Generated with Doxygen.