libsim Versione 7.2.0

◆ 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 2402 del file datetime_class.F90.

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