libsim Versione 7.2.6
|
◆ map_distinct_datetime()
map distinct Definizione alla linea 2781 del file datetime_class.F90. 2782! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2783! authors:
2784! Davide Cesari <dcesari@arpa.emr.it>
2785! Paolo Patruno <ppatruno@arpa.emr.it>
2786
2787! This program is free software; you can redistribute it and/or
2788! modify it under the terms of the GNU General Public License as
2789! published by the Free Software Foundation; either version 2 of
2790! the License, or (at your option) any later version.
2791
2792! This program is distributed in the hope that it will be useful,
2793! but WITHOUT ANY WARRANTY; without even the implied warranty of
2794! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2795! GNU General Public License for more details.
2796
2797! You should have received a copy of the GNU General Public License
2798! along with this program. If not, see <http://www.gnu.org/licenses/>.
2799#include "config.h"
2800!> \brief Classi per la gestione delle coordinate temporali.
2801!!
2802!! Questo module definisce un paio di classi per la gestione di
2803!! date assolute e di intervalli temporali.
2804!! Entrambe le classi hanno le componenti di tipo \c PRIVATE, per
2805!! cui non possono essere manipolate direttamente ma solo tramite i
2806!! relativi metodi. Attualmente la precisione massima consentita � di un
2807!! minuto, mentre l'estensione delle date rappresentabili va dall'anno 1
2808!! all'anno 4074 d.C. circa, ipotizzando un calendario gregoriano per
2809!! tutto il periodo. Questo fatto implica che le date precedenti
2810!! all'introduzione del calendario gregoriano avranno discrepanze di uno
2811!! o pi� giorni rispetto alle date storiche "vere", ammesso che
2812!! qualcuno conosca queste ultime.
2813!! \ingroup base
2821IMPLICIT NONE
2822
2823INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2824
2825!> Class for expressing an absolute time value.
2827 PRIVATE
2828 INTEGER(KIND=int_ll) :: iminuti
2830
2831!> Class for expressing a relative time interval.
2832!! It can take also negative values. According to how it is
2833!! initilasied, it can indicate an interval of fixed duration, or a
2834!! "calendar" interval of variable duration in units of months and/or
2835!! years or even a mix of the two, however, in the latter two cases
2836!! the operations that can be made with objects of this class are
2837!! restricted.
2839 PRIVATE
2840 INTEGER(KIND=int_ll) :: iminuti
2841 INTEGER :: month
2843
2844
2845!> Class for expressing a cyclic datetime.
2846!! It can be used to specify, for example, every January in all years
2847!! or the same time for all days and so on.
2849 PRIVATE
2850 INTEGER :: minute
2851 INTEGER :: hour
2852 INTEGER :: day
2853 INTEGER :: tendaysp
2854 INTEGER :: month
2856
2857
2858!> valore mancante per datetime
2860!> valore mancante per timedelta
2862!> intervallo timedelta di durata nulla
2864!> inizializza con l'ora UTC
2865INTEGER, PARAMETER :: datetime_utc=1
2866!> inizializza con l'ora locale
2867INTEGER, PARAMETER :: datetime_local=2
2868!> Minimum valid value for datetime
2870!> Minimum valid value for datetime
2872!> Minimum valid value for timedelta
2874!> Minimum valid value for timedelta
2876!> missing value for cyclicdatetime
2877TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2878
2879
2880INTEGER(kind=dateint), PARAMETER :: &
2881 sec_in_day=86400, &
2882 sec_in_hour=3600, &
2883 sec_in_min=60, &
2884 min_in_day=1440, &
2885 min_in_hour=60, &
2886 hour_in_day=24
2887
2888INTEGER,PARAMETER :: &
2889 year0=1, & ! anno di origine per iminuti
2890 d1=365, & ! giorni/1 anno nel calendario gregoriano
2891 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2892 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2893 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2894 ianno(13,2)=reshape((/ &
2895 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2896 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2897
2898INTEGER(KIND=int_ll),PARAMETER :: &
2899 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2900
2901!> Costruttori per le classi datetime e timedelta. Devono essere richiamati
2902!! per tutti gli oggetti di questo tipo definiti in un programma
2903!! tranne i casi in cui un oggetto viene creato per assegnazione.
2905 MODULE PROCEDURE datetime_init, timedelta_init
2906END INTERFACE
2907
2908!> Distruttori per le 2 classi. Distruggono gli oggetti in maniera pulita,
2909!! assegnando loro un valore mancante.
2911 MODULE PROCEDURE datetime_delete, timedelta_delete
2912END INTERFACE
2913
2914!> Restituiscono il valore dell'oggetto nella forma desiderata.
2916 MODULE PROCEDURE datetime_getval, timedelta_getval
2917END INTERFACE
2918
2919!> Restituiscono il valore dell'oggetto in forma di stringa stampabile.
2921 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2922END INTERFACE
2923
2924
2925!> Functions that return a trimmed CHARACTER representation of the
2926!! input variable. The functions are analogous to \a to_char but they
2927!! return representation of the input in a CHARACTER with a variable
2928!! length, which needs not to be trimmed before use. The optional
2929!! format here is not accepted and these functions are not \a
2930!! ELEMENTAL so they work only on scalar arguments.
2931!!
2932!! \param in (datetime or timedelta) value to be represented as CHARACTER
2933!!
2934!! Example of use:
2935!! \code
2936!! USE datetime_class
2937!! type(datetime) :: t
2938!! ...
2939!! WRITE(*,*)'The value provided is, '//t2c(t)'
2940!! ...
2941!! \endcode
2943 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2944END INTERFACE
2945
2946!> Operatore logico di uguaglianza tra oggetti della stessa classe.
2947!! Funziona anche per
2948!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2949!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2950!! di 1 dimensione e scalari).
2951INTERFACE OPERATOR (==)
2952 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2953 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2954END INTERFACE
2955
2956!> Operatore logico di disuguaglianza tra oggetti della stessa classe.
2957!! Funziona anche per
2958!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2959!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2960!! di 1 dimensione e scalari).
2961INTERFACE OPERATOR (/=)
2962 MODULE PROCEDURE datetime_ne, timedelta_ne
2963END INTERFACE
2964
2965!> Operatore logico maggiore tra oggetti della stessa classe.
2966!! Funziona anche per
2967!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2968!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2969!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2970!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2971!! \a timedelta "popolari" o misti.
2972INTERFACE OPERATOR (>)
2973 MODULE PROCEDURE datetime_gt, timedelta_gt
2974END INTERFACE
2975
2976!> Operatore logico minore tra oggetti della stessa classe.
2977!! Funziona anche per
2978!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2979!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2980!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2981!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2982!! \a timedelta "popolari" o misti.
2983INTERFACE OPERATOR (<)
2984 MODULE PROCEDURE datetime_lt, timedelta_lt
2985END INTERFACE
2986
2987!> Operatore logico maggiore-uguale tra oggetti della stessa classe.
2988!! Funziona anche per
2989!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2990!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2991!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2992!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2993!! \a timedelta "popolari" o misti.
2994INTERFACE OPERATOR (>=)
2995 MODULE PROCEDURE datetime_ge, timedelta_ge
2996END INTERFACE
2997
2998!> Operatore logico minore-uguale tra oggetti della stessa classe.
2999!! Funziona anche per
3000!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
3001!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
3002!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
3003!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
3004!! \a timedelta "popolari" o misti.
3005INTERFACE OPERATOR (<=)
3006 MODULE PROCEDURE datetime_le, timedelta_le
3007END INTERFACE
3008
3009!> Operatore di somma per datetime e timedelta. Solo alcune combinazioni
3010!! sono definite:
3011!! - \a timedelta + \a timedelta = \a timedelta
3012!! - \a datetime + \a timedelta = \a datetime
3013!! .
3014!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
3015INTERFACE OPERATOR (+)
3016 MODULE PROCEDURE datetime_add, timedelta_add
3017END INTERFACE
3018
3019!> Operatore di sottrazione per datetime e timedelta. Solo alcune combinazioni
3020!! sono definite:
3021!! - \a timedelta - \a timedelta = \a timedelta
3022!! - \a datetime - \a timedelta = \a datetime
3023!! - \a datetime - \a datetime = \a timedelta
3024!! .
3025!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
3026INTERFACE OPERATOR (-)
3027 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
3028END INTERFACE
3029
3030!> Operatore di moltiplicazione di timedelta per uno scalare. Sono definite:
3031!! - \a timedelta * \a INTEGER = \a timedelta
3032!! - \a INTEGER * \a timedelta = \a timedelta
3033!! .
3034!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
3035INTERFACE OPERATOR (*)
3036 MODULE PROCEDURE timedelta_mult, timedelta_tlum
3037END INTERFACE
3038
3039!> Operatore di divisione di timedelta. Sono definite:
3040!! - \a timedelta / \a INTEGER = \a timedelta
3041!! - \a timedelta / \a timedelta = \a INTEGER
3042!! .
3043!! La prima combinazione � valida per tutti i tipi di intervallo, mentre la
3044!! seconda � definita solo per intervalli "puri".
3045INTERFACE OPERATOR (/)
3046 MODULE PROCEDURE timedelta_divint, timedelta_divtd
3047END INTERFACE
3048
3049!> Operatore di resto della divisione.
3050!! Sono definite le combinazioni:
3051!! - \a MOD(\a timedelta, \a timedelta) = \a timedelta
3052!! - \a MOD(\a datetime, \a timedelta) = \a timedelta.
3053!!
3054!! Sono definite solo per intervalli "puri"
3055!! La seconda combinazione ha senso principalmente con intervalli di
3056!! 1 minuto, 1 ora o
3057!! 1 giorno, per calcolare di quanto l'oggetto \a datetime indicato dista
3058!! dal minuto, ora o giorno tondo precedente pi� vicino.
3060 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
3061END INTERFACE
3062
3063!> Operatore di valore assoluto di un intervallo.
3064!! - \a ABS(\a timedelta) = \a timedelta
3066 MODULE PROCEDURE timedelta_abs
3067END INTERFACE
3068
3069!> Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da
3070!! un file \c FORMATTED o \c UNFORMATTED.
3072 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
3073 timedelta_read_unit, timedelta_vect_read_unit
3074END INTERFACE
3075
3076!> Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su
3077!! un file \c FORMATTED o \c UNFORMATTED.
3079 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
3080 timedelta_write_unit, timedelta_vect_write_unit
3081END INTERFACE
3082
3083!> Print object
3085 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
3086END INTERFACE
3087
3088!> Missing check
3090 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
3091END INTERFACE
3092
3093#undef VOL7D_POLY_TYPE
3094#undef VOL7D_POLY_TYPES
3095#undef ENABLE_SORT
3096#define VOL7D_POLY_TYPE TYPE(datetime)
3097#define VOL7D_POLY_TYPES _datetime
3098#define ENABLE_SORT
3099#include "array_utilities_pre.F90"
3100
3101
3102#define ARRAYOF_ORIGTYPE TYPE(datetime)
3103#define ARRAYOF_TYPE arrayof_datetime
3104#define ARRAYOF_ORIGEQ 1
3105#include "arrayof_pre.F90"
3106! from arrayof
3107
3108PRIVATE
3109
3111 datetime_min, datetime_max, &
3114 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
3115 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
3117 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
3118 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
3120 count_distinct, pack_distinct, &
3121 count_distinct_sorted, pack_distinct_sorted, &
3122 count_and_pack_distinct, &
3124 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
3126PUBLIC insert_unique, append_unique
3127PUBLIC cyclicdatetime_to_conventional
3128
3129CONTAINS
3130
3131
3132! ==============
3133! == datetime ==
3134! ==============
3135
3136!> Initialize a \a datetime object according to the provided arguments
3137!! If no arguments are passed a missing object is created. Notice
3138!! that the optional parameter groups (\a year, \a month, \a hour, \a
3139!! minute, \a msec), (\a unixtime), (\a isodate), (\a simpledate) are
3140!! mutually exclusive, the results are not guaranteed if arguments of
3141!! different groups are present.
3142ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
3143 unixtime, isodate, simpledate) RESULT(this)
3144INTEGER,INTENT(IN),OPTIONAL :: year !< year a.C.; for reasons not yet investigated, only years >0 (a.C.) are allowed
3145INTEGER,INTENT(IN),OPTIONAL :: month !< month, default=1 if \a year is present, it can also be outside the interval 1-12, the function behaves reasonably in that case
3146INTEGER,INTENT(IN),OPTIONAL :: day !< day, default=1 if \a year is present, it can have non canonical values too
3147INTEGER,INTENT(IN),OPTIONAL :: hour !< hours, default=0 if \a year is present, it can have non canonical values too
3148INTEGER,INTENT(IN),OPTIONAL :: minute !< minutes, default=0 if \a year is present, it can have non canonical values too
3149INTEGER,INTENT(IN),OPTIONAL :: msec !< milliseconds, default=0 if \a year is present, it can have non canonical values too
3150INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime !< initialize the object to \a unixtime seconds after 1/1/1970, UNIX convention, notice that this is an 8-byte integer
3151CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate !< initialize the object to a date expressed as a string \c YYYY-MM-DD \c hh:mm:ss.msc, (iso format), the initial part YYYY-MM-DD is compulsory, the remaining part is optional
3152CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate !< initialize the object to a date expressed as a string \c YYYYMMDDhh:mm:ss.msc, (iso format), the initial part YYYYMMDD is compulsory, the remaining part is optional
3153
3154TYPE(datetime) :: this
3155INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3156CHARACTER(len=23) :: datebuf
3157
3158IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
3159 lyear = year
3160 IF (PRESENT(month)) THEN
3161 lmonth = month
3162 ELSE
3163 lmonth = 1
3164 ENDIF
3165 IF (PRESENT(day)) THEN
3166 lday = day
3167 ELSE
3168 lday = 1
3169 ENDIF
3170 IF (PRESENT(hour)) THEN
3171 lhour = hour
3172 ELSE
3173 lhour = 0
3174 ENDIF
3175 IF (PRESENT(minute)) THEN
3176 lminute = minute
3177 ELSE
3178 lminute = 0
3179 ENDIF
3180 IF (PRESENT(msec)) THEN
3181 lmsec = msec
3182 ELSE
3183 lmsec = 0
3184 ENDIF
3185
3188 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3189 else
3190 this=datetime_miss
3191 end if
3192
3193ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
3195 this%iminuti = (unixtime + unsec)*1000
3196 else
3197 this=datetime_miss
3198 end if
3199
3200ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
3201
3203 datebuf(1:23) = '0001-01-01 00:00:00.000'
3204 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
3205 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
3206 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3207 lmsec = lmsec + lsec*1000
3208 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3209 RETURN
3210
3211100 CONTINUE ! condizione di errore in isodate
3213 RETURN
3214 ELSE
3215 this = datetime_miss
3216 ENDIF
3217
3218ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
3220 datebuf(1:17) = '00010101000000000'
3221 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3222 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
3223 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3224 lmsec = lmsec + lsec*1000
3225 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3226 RETURN
3227
3228120 CONTINUE ! condizione di errore in simpledate
3230 RETURN
3231 ELSE
3232 this = datetime_miss
3233 ENDIF
3234
3235ELSE
3236 this = datetime_miss
3237ENDIF
3238
3239END FUNCTION datetime_new
3240
3241
3242!> Initialize a datetime object with the current system time.
3243FUNCTION datetime_new_now(now) RESULT(this)
3244INTEGER,INTENT(IN) :: now !< select the time for initialisation, \a datetime_utc for UTC (preferred) or \a datetime_local for local time
3245TYPE(datetime) :: this
3246
3247INTEGER :: dt(8)
3248
3250 CALL date_and_time(values=dt)
3251 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
3253 msec=dt(7)*1000+dt(8))
3254ELSE
3255 this = datetime_miss
3256ENDIF
3257
3258END FUNCTION datetime_new_now
3259
3260
3261!> Costruisce un oggetto \a datetime con i parametri opzionali forniti.
3262!! Se non viene passato nulla lo inizializza a 1/1/1.
3263!! Notare che i gruppi di parametri opzionali (\a year, \a month, \a hour,
3264!! \a minute, \a msec), (\a unixtime), (\a isodate), (\a simpledate),
3265!! (\a oraclesimdate) sono mutualmente escludentesi; \a oraclesimedate �
3266!! obsoleto, usare piuttosto \a simpledate.
3267SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
3268 unixtime, isodate, simpledate, now)
3269TYPE(datetime),INTENT(INOUT) :: this !< oggetto da inizializzare
3270INTEGER,INTENT(IN),OPTIONAL :: year !< anno d.C., se � specificato, tutti gli eventuali parametri tranne \a month, \a day, \a hour e \a minute sono ignorati; per un problema non risolto, sono ammessi solo anni >0 (d.C.)
3271INTEGER,INTENT(IN),OPTIONAL :: month !< mese, default=1 se � specificato \a year; pu� assumere anche valori <1 o >12, l'oggetto finale si aggiusta coerentemente
3272INTEGER,INTENT(IN),OPTIONAL :: day !< mese, default=1 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
3273INTEGER,INTENT(IN),OPTIONAL :: hour !< ore, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
3274INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
3275INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
3276INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime !< inizializza l'oggetto a \a unixtime secondi dopo il 1/1/1970 (convenzione UNIX, notare che il parametro deve essere un intero a 8 byte)
3277CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate !< inizializza l'oggetto ad una data espressa nel formato \c AAAA-MM-GG \c hh:mm:ss.msc, un sottoinsieme del formato noto come \a ISO, la parte iniziale \c AAAA-MM-GG � obbligatoria, il resto � opzionale
3278CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate !< inizializza l'oggetto ad una data espressa nel formato \c AAAAMMGGhhmmssmsc, la parte iniziale \c AAAAMMGG � obbligatoria, il resto � opzionale, da preferire rispetto a \a oraclesimdate
3279INTEGER,INTENT(IN),OPTIONAL :: now !< inizializza l'oggetto all'istante corrente, se \a � \a datetime_utc inizializza con l'ora UTC (preferibile), se � \a datetime_local usa l'ora locale
3280
3281IF (PRESENT(now)) THEN
3282 this = datetime_new_now(now)
3283ELSE
3284 this = datetime_new(year, month, day, hour, minute, msec, &
3285 unixtime, isodate, simpledate)
3286ENDIF
3287
3288END SUBROUTINE datetime_init
3289
3290
3291ELEMENTAL SUBROUTINE datetime_delete(this)
3292TYPE(datetime),INTENT(INOUT) :: this
3293
3294this%iminuti = illmiss
3295
3296END SUBROUTINE datetime_delete
3297
3298
3299!> Restituisce il valore di un oggetto \a datetime in una o pi�
3300!! modalit� desiderate. Qualsiasi combinazione dei parametri
3301!! opzionali � consentita. \a oraclesimedate �
3302!! obsoleto, usare piuttosto \a simpledate.
3303PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
3304 unixtime, isodate, simpledate, oraclesimdate)
3305TYPE(datetime),INTENT(IN) :: this !< oggetto di cui restituire il valore
3306INTEGER,INTENT(OUT),OPTIONAL :: year !< anno
3307INTEGER,INTENT(OUT),OPTIONAL :: month !< mese
3308INTEGER,INTENT(OUT),OPTIONAL :: day !< giorno
3309INTEGER,INTENT(OUT),OPTIONAL :: hour !< ore
3310INTEGER,INTENT(OUT),OPTIONAL :: minute !< minuti
3311INTEGER,INTENT(OUT),OPTIONAL :: msec !< millisecondi
3312INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime !< secondi a partire dal 1/1/1970
3313CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate !< data completa nel formato \c AAAA-MM-GG \c hh:mm:ss.msc (simil-ISO), la variabile pu� essere pi� corta di 23 caratteri, in tal caso conterr� solo ci� che vi cape
3314CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate !< data completa nel formato \c AAAAMMGGhhmmssmsc , la variabile pu� essere pi� corta di 17 caratteri, in tal caso conterr� solo ci� che vi cape, da preferire rispetto a \a oraclesimdate
3315CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate !< data parziale nel formato \c AAAAMMGGhhmm
3316
3317INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3318CHARACTER(len=23) :: datebuf
3319
3320IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
3321 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
3322 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
3323
3324 IF (this == datetime_miss) THEN
3325
3326 IF (PRESENT(msec)) THEN
3327 msec = imiss
3328 ENDIF
3329 IF (PRESENT(minute)) THEN
3330 minute = imiss
3331 ENDIF
3332 IF (PRESENT(hour)) THEN
3333 hour = imiss
3334 ENDIF
3335 IF (PRESENT(day)) THEN
3336 day = imiss
3337 ENDIF
3338 IF (PRESENT(month)) THEN
3339 month = imiss
3340 ENDIF
3341 IF (PRESENT(year)) THEN
3342 year = imiss
3343 ENDIF
3344 IF (PRESENT(isodate)) THEN
3345 isodate = cmiss
3346 ENDIF
3347 IF (PRESENT(simpledate)) THEN
3348 simpledate = cmiss
3349 ENDIF
3350 IF (PRESENT(oraclesimdate)) THEN
3351!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3352!!$ 'obsoleto, usare piuttosto simpledate')
3353 oraclesimdate=cmiss
3354 ENDIF
3355 IF (PRESENT(unixtime)) THEN
3356 unixtime = illmiss
3357 ENDIF
3358
3359 ELSE
3360
3361 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3362 IF (PRESENT(msec)) THEN
3363 msec = lmsec
3364 ENDIF
3365 IF (PRESENT(minute)) THEN
3366 minute = lminute
3367 ENDIF
3368 IF (PRESENT(hour)) THEN
3369 hour = lhour
3370 ENDIF
3371 IF (PRESENT(day)) THEN
3372 day = lday
3373 ENDIF
3374 IF (PRESENT(month)) THEN
3375 month = lmonth
3376 ENDIF
3377 IF (PRESENT(year)) THEN
3378 year = lyear
3379 ENDIF
3380 IF (PRESENT(isodate)) THEN
3381 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3382 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
3384 isodate = datebuf(1:min(len(isodate),23))
3385 ENDIF
3386 IF (PRESENT(simpledate)) THEN
3387 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
3388 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
3389 simpledate = datebuf(1:min(len(simpledate),17))
3390 ENDIF
3391 IF (PRESENT(oraclesimdate)) THEN
3392!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3393!!$ 'obsoleto, usare piuttosto simpledate')
3394 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
3395 ENDIF
3396 IF (PRESENT(unixtime)) THEN
3397 unixtime = this%iminuti/1000_int_ll-unsec
3398 ENDIF
3399
3400 ENDIF
3401ENDIF
3402
3403END SUBROUTINE datetime_getval
3404
3405
3406!> Restituisce una rappresentazione carattere stampabile di un oggetto
3407!! \a datetime.
3408elemental FUNCTION datetime_to_char(this) RESULT(char)
3409TYPE(datetime),INTENT(IN) :: this
3410
3411CHARACTER(len=23) :: char
3412
3414
3415END FUNCTION datetime_to_char
3416
3417
3418FUNCTION trim_datetime_to_char(in) RESULT(char)
3419TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3420
3421CHARACTER(len=len_trim(datetime_to_char(in))) :: char
3422
3423char=datetime_to_char(in)
3424
3425END FUNCTION trim_datetime_to_char
3426
3427
3428
3429SUBROUTINE display_datetime(this)
3430TYPE(datetime),INTENT(in) :: this
3431
3433
3434end subroutine display_datetime
3435
3436
3437
3438SUBROUTINE display_timedelta(this)
3439TYPE(timedelta),INTENT(in) :: this
3440
3442
3443end subroutine display_timedelta
3444
3445
3446
3447ELEMENTAL FUNCTION c_e_datetime(this) result (res)
3448TYPE(datetime),INTENT(in) :: this
3449LOGICAL :: res
3450
3451res = .not. this == datetime_miss
3452
3453end FUNCTION c_e_datetime
3454
3455
3456ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
3457TYPE(datetime),INTENT(IN) :: this, that
3458LOGICAL :: res
3459
3460res = this%iminuti == that%iminuti
3461
3462END FUNCTION datetime_eq
3463
3464
3465ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3466TYPE(datetime),INTENT(IN) :: this, that
3467LOGICAL :: res
3468
3469res = .NOT.(this == that)
3470
3471END FUNCTION datetime_ne
3472
3473
3474ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3475TYPE(datetime),INTENT(IN) :: this, that
3476LOGICAL :: res
3477
3478res = this%iminuti > that%iminuti
3479
3480END FUNCTION datetime_gt
3481
3482
3483ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3484TYPE(datetime),INTENT(IN) :: this, that
3485LOGICAL :: res
3486
3487res = this%iminuti < that%iminuti
3488
3489END FUNCTION datetime_lt
3490
3491
3492ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3493TYPE(datetime),INTENT(IN) :: this, that
3494LOGICAL :: res
3495
3496IF (this == that) THEN
3497 res = .true.
3498ELSE IF (this > that) THEN
3499 res = .true.
3500ELSE
3501 res = .false.
3502ENDIF
3503
3504END FUNCTION datetime_ge
3505
3506
3507ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3508TYPE(datetime),INTENT(IN) :: this, that
3509LOGICAL :: res
3510
3511IF (this == that) THEN
3512 res = .true.
3513ELSE IF (this < that) THEN
3514 res = .true.
3515ELSE
3516 res = .false.
3517ENDIF
3518
3519END FUNCTION datetime_le
3520
3521
3522FUNCTION datetime_add(this, that) RESULT(res)
3523TYPE(datetime),INTENT(IN) :: this
3524TYPE(timedelta),INTENT(IN) :: that
3525TYPE(datetime) :: res
3526
3527INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3528
3529IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3530 res = datetime_miss
3531ELSE
3532 res%iminuti = this%iminuti + that%iminuti
3533 IF (that%month /= 0) THEN
3535 minute=lminute, msec=lmsec)
3537 hour=lhour, minute=lminute, msec=lmsec)
3538 ENDIF
3539ENDIF
3540
3541END FUNCTION datetime_add
3542
3543
3544ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3545TYPE(datetime),INTENT(IN) :: this, that
3546TYPE(timedelta) :: res
3547
3548IF (this == datetime_miss .OR. that == datetime_miss) THEN
3549 res = timedelta_miss
3550ELSE
3551 res%iminuti = this%iminuti - that%iminuti
3552 res%month = 0
3553ENDIF
3554
3555END FUNCTION datetime_subdt
3556
3557
3558FUNCTION datetime_subtd(this, that) RESULT(res)
3559TYPE(datetime),INTENT(IN) :: this
3560TYPE(timedelta),INTENT(IN) :: that
3561TYPE(datetime) :: res
3562
3563INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3564
3565IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3566 res = datetime_miss
3567ELSE
3568 res%iminuti = this%iminuti - that%iminuti
3569 IF (that%month /= 0) THEN
3571 minute=lminute, msec=lmsec)
3573 hour=lhour, minute=lminute, msec=lmsec)
3574 ENDIF
3575ENDIF
3576
3577END FUNCTION datetime_subtd
3578
3579
3580!> This method reads from a Fortran file unit the contents of the
3581!! object \a this. The record to be read must have been written with
3582!! the ::write_unit method. The method works both on formatted and
3583!! unformatted files.
3584SUBROUTINE datetime_read_unit(this, unit)
3585TYPE(datetime),INTENT(out) :: this !< object to be read
3586INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3587CALL datetime_vect_read_unit((/this/), unit)
3588
3589END SUBROUTINE datetime_read_unit
3590
3591
3592!> This method reads from a Fortran file unit the contents of the
3593!! object \a this. The record to be read must have been written with
3594!! the ::write_unit method. The method works both on formatted and
3595!! unformatted files.
3596SUBROUTINE datetime_vect_read_unit(this, unit)
3597TYPE(datetime) :: this(:) !< object to be read
3598INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3599
3600CHARACTER(len=40) :: form
3601CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3602INTEGER :: i
3603
3604ALLOCATE(dateiso(SIZE(this)))
3605INQUIRE(unit, form=form)
3606IF (form == 'FORMATTED') THEN
3607 READ(unit,'(A23,1X)')dateiso
3608ELSE
3609 READ(unit)dateiso
3610ENDIF
3611DO i = 1, SIZE(dateiso)
3613ENDDO
3614DEALLOCATE(dateiso)
3615
3616END SUBROUTINE datetime_vect_read_unit
3617
3618
3619!> This method writes on a Fortran file unit the contents of the
3620!! object \a this. The record can successively be read by the
3621!! ::read_unit method. The method works both on formatted and
3622!! unformatted files.
3623SUBROUTINE datetime_write_unit(this, unit)
3624TYPE(datetime),INTENT(in) :: this !< object to be written
3625INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3626
3627CALL datetime_vect_write_unit((/this/), unit)
3628
3629END SUBROUTINE datetime_write_unit
3630
3631
3632!> This method writes on a Fortran file unit the contents of the
3633!! object \a this. The record can successively be read by the
3634!! ::read_unit method. The method works both on formatted and
3635!! unformatted files.
3636SUBROUTINE datetime_vect_write_unit(this, unit)
3637TYPE(datetime),INTENT(in) :: this(:) !< object to be written
3638INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3639
3640CHARACTER(len=40) :: form
3641CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3642INTEGER :: i
3643
3644ALLOCATE(dateiso(SIZE(this)))
3645DO i = 1, SIZE(dateiso)
3647ENDDO
3648INQUIRE(unit, form=form)
3649IF (form == 'FORMATTED') THEN
3650 WRITE(unit,'(A23,1X)')dateiso
3651ELSE
3652 WRITE(unit)dateiso
3653ENDIF
3654DEALLOCATE(dateiso)
3655
3656END SUBROUTINE datetime_vect_write_unit
3657
3658
3659#include "arrayof_post.F90"
3660
3661
3662! ===============
3663! == timedelta ==
3664! ===============
3665!> Costruisce un oggetto \a timedelta con i parametri opzionali forniti.
3666!! Se non viene passato nulla lo inizializza a intervallo di durata nulla.
3667!! L'intervallo ottenuto � pari alla somma dei valori di tutti i parametri
3668!! forniti, ovviamente non fornire un parametro equivale a fornirlo =0.
3669!! Questa � la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
3670!! rispetto alla versione \c SUBROUTINE \c init.
3671FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3672 isodate, simpledate, oraclesimdate) RESULT (this)
3673INTEGER,INTENT(IN),OPTIONAL :: year !< anni, se presente l'oggetto diventa "popolare"
3674INTEGER,INTENT(IN),OPTIONAL :: month !< mesi, se presente l'oggetto diventa "popolare"
3675INTEGER,INTENT(IN),OPTIONAL :: day !< giorni
3676INTEGER,INTENT(IN),OPTIONAL :: hour !< ore
3677INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti
3678INTEGER,INTENT(IN),OPTIONAL :: sec !< secondi
3679INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi
3680CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGGG \c hh:mm:ss.msc, ignorando tutti gli altri parametri
3681CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmmmsc, ignorando tutti gli altri parametri, da preferire rispetto a \a oraclesimdate
3682CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmm, ignorando tutti gli altri parametri
3683
3684TYPE(timedelta) :: this !< oggetto da inizializzare
3685
3686CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3687 isodate, simpledate, oraclesimdate)
3688
3689END FUNCTION timedelta_new
3690
3691
3692!> Costruisce un oggetto \a timedelta con i parametri opzionali forniti.
3693!! Se non viene passato nulla lo inizializza a intervallo di durata nulla.
3694!! L'intervallo ottenuto � pari alla somma dei valori di tutti i parametri
3695!! forniti, ovviamente non fornire un parametro equivale a fornirlo =0.
3696SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3697 isodate, simpledate, oraclesimdate)
3698TYPE(timedelta),INTENT(INOUT) :: this !< oggetto da inizializzare
3699INTEGER,INTENT(IN),OPTIONAL :: year !< anni, se presente l'oggetto diventa "popolare"
3700INTEGER,INTENT(IN),OPTIONAL :: month !< mesi, se presente l'oggetto diventa "popolare"
3701INTEGER,INTENT(IN),OPTIONAL :: day !< giorni
3702INTEGER,INTENT(IN),OPTIONAL :: hour !< ore
3703INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti
3704INTEGER,INTENT(IN),OPTIONAL :: sec !< secondi
3705INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi
3706CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate !< inizializza l'oggetto ad un intervallo nel formato \c AAAAMMGGGG \c hh:mm:ss.msc, ignorando tutti gli altri parametri, se \c AAAA o \c MM sono diversi da 0 l'oggetto diventa "popolare"
3707CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmmmsc, ignorando tutti gli altri parametri, da preferire rispetto a \a oraclesimdate
3708CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmm, ignorando tutti gli altri parametri
3709
3710INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3711CHARACTER(len=23) :: datebuf
3712
3713this%month = 0
3714
3715IF (PRESENT(isodate)) THEN
3716 datebuf(1:23) = '0000000000 00:00:00.000'
3717 l = len_trim(isodate)
3718! IF (l > 0) THEN
3720 IF (n > 0) THEN
3721 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3722 datebuf(12-n:12-n+l-1) = isodate(:l)
3723 ELSE
3724 datebuf(1:l) = isodate(1:l)
3725 ENDIF
3726! ENDIF
3727
3728! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3729 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3730 h, m, s, ms
3731 this%month = lmonth + 12*lyear
3732 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3733 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3734 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3735 RETURN
3736
3737200 CONTINUE ! condizione di errore in isodate
3739 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3740 CALL raise_error()
3741
3742ELSE IF (PRESENT(simpledate)) THEN
3743 datebuf(1:17) = '00000000000000000'
3744 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3745 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3746 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3747 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3748 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3749
3750220 CONTINUE ! condizione di errore in simpledate
3752 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3753 CALL raise_error()
3754 RETURN
3755
3756ELSE IF (PRESENT(oraclesimdate)) THEN
3757 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3758 'obsoleto, usare piuttosto simpledate')
3759 READ(oraclesimdate, '(I8,2I2)')d, h, m
3760 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3761 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3762
3763ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3764 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3765 .and. .not. present(msec) .and. .not. present(isodate) &
3766 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3767
3768 this=timedelta_miss
3769
3770ELSE
3771 this%iminuti = 0
3772 IF (PRESENT(year)) THEN
3774 this%month = this%month + year*12
3775 else
3776 this=timedelta_miss
3777 return
3778 end if
3779 ENDIF
3780 IF (PRESENT(month)) THEN
3782 this%month = this%month + month
3783 else
3784 this=timedelta_miss
3785 return
3786 end if
3787 ENDIF
3788 IF (PRESENT(day)) THEN
3790 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3791 else
3792 this=timedelta_miss
3793 return
3794 end if
3795 ENDIF
3796 IF (PRESENT(hour)) THEN
3798 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3799 else
3800 this=timedelta_miss
3801 return
3802 end if
3803 ENDIF
3804 IF (PRESENT(minute)) THEN
3806 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3807 else
3808 this=timedelta_miss
3809 return
3810 end if
3811 ENDIF
3812 IF (PRESENT(sec)) THEN
3814 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3815 else
3816 this=timedelta_miss
3817 return
3818 end if
3819 ENDIF
3820 IF (PRESENT(msec)) THEN
3822 this%iminuti = this%iminuti + msec
3823 else
3824 this=timedelta_miss
3825 return
3826 end if
3827 ENDIF
3828ENDIF
3829
3830
3831
3832
3833END SUBROUTINE timedelta_init
3834
3835
3836SUBROUTINE timedelta_delete(this)
3837TYPE(timedelta),INTENT(INOUT) :: this
3838
3839this%iminuti = imiss
3840this%month = 0
3841
3842END SUBROUTINE timedelta_delete
3843
3844
3845!> Restituisce il valore di un oggetto \a timedelta in una o pi�
3846!! modalit� desiderate. Qualsiasi combinazione dei parametri
3847!! opzionali � consentita. \a oraclesimedate �
3848!! obsoleto, usare piuttosto \a simpledate.
3849PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3850 day, hour, minute, sec, msec, &
3851 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3852TYPE(timedelta),INTENT(IN) :: this !< oggetto di cui restituire il valore
3853INTEGER,INTENT(OUT),OPTIONAL :: year !< anni, /=0 solo per intervalli "popolari"
3854INTEGER,INTENT(OUT),OPTIONAL :: month !< mesi modulo 12, /=0 solo per intervalli "popolari"
3855INTEGER,INTENT(OUT),OPTIONAL :: amonth !< mesi totali, /=0 solo per intervalli "popolari"
3856INTEGER,INTENT(OUT),OPTIONAL :: day !< giorni totali
3857INTEGER,INTENT(OUT),OPTIONAL :: hour !< ore modulo 24
3858INTEGER,INTENT(OUT),OPTIONAL :: minute !< minuti modulo 60
3859INTEGER,INTENT(OUT),OPTIONAL :: sec !< secondi modulo 60
3860INTEGER,INTENT(OUT),OPTIONAL :: msec !< millisecondi modulo 1000
3861INTEGER,INTENT(OUT),OPTIONAL :: ahour !< ore totali
3862INTEGER,INTENT(OUT),OPTIONAL :: aminute !< minuti totali
3863INTEGER,INTENT(OUT),OPTIONAL :: asec !< secondi totali
3864INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec !< millisecondi totali
3865CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate !< intervallo totale nel formato \c GGGGGGGGGG \c hh:mm:ss.msc (simil-ISO), la variabile può essere più corta di 23 caratteri, in tal caso conterr� solo ci� che vi cape
3866CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate !< intervallo totale nel formato \c GGGGGGGGhhmmssmsc , la variabile pu� essere pi� corta di 17 caratteri, in tal caso conterr� solo ci� che vi cape, da preferire rispetto a \a oraclesimdate
3867CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate !< intervallo totale nel formato \c GGGGGGGGhhmm
3868
3869CHARACTER(len=23) :: datebuf
3870
3871IF (PRESENT(amsec)) THEN
3872 amsec = this%iminuti
3873ENDIF
3874IF (PRESENT(asec)) THEN
3875 asec = int(this%iminuti/1000_int_ll)
3876ENDIF
3877IF (PRESENT(aminute)) THEN
3878 aminute = int(this%iminuti/60000_int_ll)
3879ENDIF
3880IF (PRESENT(ahour)) THEN
3881 ahour = int(this%iminuti/3600000_int_ll)
3882ENDIF
3883IF (PRESENT(msec)) THEN
3884 msec = int(mod(this%iminuti, 1000_int_ll))
3885ENDIF
3886IF (PRESENT(sec)) THEN
3887 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3888ENDIF
3889IF (PRESENT(minute)) THEN
3890 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3891ENDIF
3892IF (PRESENT(hour)) THEN
3893 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3894ENDIF
3895IF (PRESENT(day)) THEN
3896 day = int(this%iminuti/86400000_int_ll)
3897ENDIF
3898IF (PRESENT(amonth)) THEN
3899 amonth = this%month
3900ENDIF
3901IF (PRESENT(month)) THEN
3902 month = mod(this%month-1,12)+1
3903ENDIF
3904IF (PRESENT(year)) THEN
3905 year = this%month/12
3906ENDIF
3907IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3908 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3912 isodate = datebuf(1:min(len(isodate),23))
3913
3914ENDIF
3915IF (PRESENT(simpledate)) THEN
3916 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3917 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3919 mod(this%iminuti, 1000_int_ll)
3920 simpledate = datebuf(1:min(len(simpledate),17))
3921ENDIF
3922IF (PRESENT(oraclesimdate)) THEN
3923!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3924!!$ 'obsoleto, usare piuttosto simpledate')
3925 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3927ENDIF
3928
3929END SUBROUTINE timedelta_getval
3930
3931
3932!> Restituisce una rappresentazione carattere stampabile di un oggetto
3933!! \a timedelta.
3934elemental FUNCTION timedelta_to_char(this) RESULT(char)
3935TYPE(timedelta),INTENT(IN) :: this
3936
3937CHARACTER(len=23) :: char
3938
3940
3941END FUNCTION timedelta_to_char
3942
3943
3944FUNCTION trim_timedelta_to_char(in) RESULT(char)
3945TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3946
3947CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3948
3949char=timedelta_to_char(in)
3950
3951END FUNCTION trim_timedelta_to_char
3952
3953
3954!> Restituisce il valore in millisecondi totali di un oggetto \a timedelta.
3955elemental FUNCTION timedelta_getamsec(this)
3956TYPE(timedelta),INTENT(IN) :: this !< oggetto di cui restituire il valore
3957INTEGER(kind=int_ll) :: timedelta_getamsec !< millisecondi totali
3958
3959timedelta_getamsec = this%iminuti
3960
3961END FUNCTION timedelta_getamsec
3962
3963
3964!> Depopularize a \a timedelta object.
3965!! If the object represents a "popular" or mixed interval, a fixed
3966!! interval representation is returned, by recomputing it on a
3967!! standard period (starting from 1970-01-01); if it represents
3968!! already a fixed interval, the same object is returned.
3969FUNCTION timedelta_depop(this)
3970TYPE(timedelta),INTENT(IN) :: this !< object to be depopularized
3971TYPE(timedelta) :: timedelta_depop
3972
3973TYPE(datetime) :: tmpdt
3974
3975IF (this%month == 0) THEN
3976 timedelta_depop = this
3977ELSE
3978 tmpdt = datetime_new(1970, 1, 1)
3979 timedelta_depop = (tmpdt + this) - tmpdt
3980ENDIF
3981
3982END FUNCTION timedelta_depop
3983
3984
3985elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3986TYPE(timedelta),INTENT(IN) :: this, that
3987LOGICAL :: res
3988
3989res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3990
3991END FUNCTION timedelta_eq
3992
3993
3994ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3995TYPE(timedelta),INTENT(IN) :: this, that
3996LOGICAL :: res
3997
3998res = .NOT.(this == that)
3999
4000END FUNCTION timedelta_ne
4001
4002
4003ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
4004TYPE(timedelta),INTENT(IN) :: this, that
4005LOGICAL :: res
4006
4007res = this%iminuti > that%iminuti
4008
4009END FUNCTION timedelta_gt
4010
4011
4012ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
4013TYPE(timedelta),INTENT(IN) :: this, that
4014LOGICAL :: res
4015
4016res = this%iminuti < that%iminuti
4017
4018END FUNCTION timedelta_lt
4019
4020
4021ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
4022TYPE(timedelta),INTENT(IN) :: this, that
4023LOGICAL :: res
4024
4025IF (this == that) THEN
4026 res = .true.
4027ELSE IF (this > that) THEN
4028 res = .true.
4029ELSE
4030 res = .false.
4031ENDIF
4032
4033END FUNCTION timedelta_ge
4034
4035
4036elemental FUNCTION timedelta_le(this, that) RESULT(res)
4037TYPE(timedelta),INTENT(IN) :: this, that
4038LOGICAL :: res
4039
4040IF (this == that) THEN
4041 res = .true.
4042ELSE IF (this < that) THEN
4043 res = .true.
4044ELSE
4045 res = .false.
4046ENDIF
4047
4048END FUNCTION timedelta_le
4049
4050
4051ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
4052TYPE(timedelta),INTENT(IN) :: this, that
4053TYPE(timedelta) :: res
4054
4055res%iminuti = this%iminuti + that%iminuti
4056res%month = this%month + that%month
4057
4058END FUNCTION timedelta_add
4059
4060
4061ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
4062TYPE(timedelta),INTENT(IN) :: this, that
4063TYPE(timedelta) :: res
4064
4065res%iminuti = this%iminuti - that%iminuti
4066res%month = this%month - that%month
4067
4068END FUNCTION timedelta_sub
4069
4070
4071ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
4072TYPE(timedelta),INTENT(IN) :: this
4073INTEGER,INTENT(IN) :: n
4074TYPE(timedelta) :: res
4075
4076res%iminuti = this%iminuti*n
4077res%month = this%month*n
4078
4079END FUNCTION timedelta_mult
4080
4081
4082ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
4083INTEGER,INTENT(IN) :: n
4084TYPE(timedelta),INTENT(IN) :: this
4085TYPE(timedelta) :: res
4086
4087res%iminuti = this%iminuti*n
4088res%month = this%month*n
4089
4090END FUNCTION timedelta_tlum
4091
4092
4093ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
4094TYPE(timedelta),INTENT(IN) :: this
4095INTEGER,INTENT(IN) :: n
4096TYPE(timedelta) :: res
4097
4098res%iminuti = this%iminuti/n
4099res%month = this%month/n
4100
4101END FUNCTION timedelta_divint
4102
4103
4104ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
4105TYPE(timedelta),INTENT(IN) :: this, that
4106INTEGER :: res
4107
4108res = int(this%iminuti/that%iminuti)
4109
4110END FUNCTION timedelta_divtd
4111
4112
4113elemental FUNCTION timedelta_mod(this, that) RESULT(res)
4114TYPE(timedelta),INTENT(IN) :: this, that
4115TYPE(timedelta) :: res
4116
4117res%iminuti = mod(this%iminuti, that%iminuti)
4118res%month = 0
4119
4120END FUNCTION timedelta_mod
4121
4122
4123ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
4124TYPE(datetime),INTENT(IN) :: this
4125TYPE(timedelta),INTENT(IN) :: that
4126TYPE(timedelta) :: res
4127
4128IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
4129 res = timedelta_0
4130ELSE
4131 res%iminuti = mod(this%iminuti, that%iminuti)
4132 res%month = 0
4133ENDIF
4134
4135END FUNCTION datetime_timedelta_mod
4136
4137
4138ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
4139TYPE(timedelta),INTENT(IN) :: this
4140TYPE(timedelta) :: res
4141
4142res%iminuti = abs(this%iminuti)
4143res%month = abs(this%month)
4144
4145END FUNCTION timedelta_abs
4146
4147
4148!> This method reads from a Fortran file unit the contents of the
4149!! object \a this. The record to be read must have been written with
4150!! the ::write_unit method. The method works both on formatted and
4151!! unformatted files.
4152SUBROUTINE timedelta_read_unit(this, unit)
4153TYPE(timedelta),INTENT(out) :: this !< object to be read
4154INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
4155
4156CALL timedelta_vect_read_unit((/this/), unit)
4157
4158END SUBROUTINE timedelta_read_unit
4159
4160
4161!> This method reads from a Fortran file unit the contents of the
4162!! object \a this. The record to be read must have been written with
4163!! the ::write_unit method. The method works both on formatted and
4164!! unformatted files.
4165SUBROUTINE timedelta_vect_read_unit(this, unit)
4166TYPE(timedelta) :: this(:) !< object to be read
4167INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
4168
4169CHARACTER(len=40) :: form
4170CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
4171INTEGER :: i
4172
4173ALLOCATE(dateiso(SIZE(this)))
4174INQUIRE(unit, form=form)
4175IF (form == 'FORMATTED') THEN
4176 READ(unit,'(3(A23,1X))')dateiso
4177ELSE
4178 READ(unit)dateiso
4179ENDIF
4180DO i = 1, SIZE(dateiso)
4182ENDDO
4183DEALLOCATE(dateiso)
4184
4185END SUBROUTINE timedelta_vect_read_unit
4186
4187
4188!> This method writes on a Fortran file unit the contents of the
4189!! object \a this. The record can successively be read by the
4190!! ::read_unit method. The method works both on formatted and
4191!! unformatted files.
4192SUBROUTINE timedelta_write_unit(this, unit)
4193TYPE(timedelta),INTENT(in) :: this !< object to be written
4194INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
4195
4196CALL timedelta_vect_write_unit((/this/), unit)
4197
4198END SUBROUTINE timedelta_write_unit
4199
4200
4201!> This method writes on a Fortran file unit the contents of the
4202!! object \a this. The record can successively be read by the
4203!! ::read_unit method. The method works both on formatted and
4204!! unformatted files.
4205SUBROUTINE timedelta_vect_write_unit(this, unit)
4206TYPE(timedelta),INTENT(in) :: this(:) !< object to be written
4207INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
4208
4209CHARACTER(len=40) :: form
4210CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
4211INTEGER :: i
4212
4213ALLOCATE(dateiso(SIZE(this)))
4214DO i = 1, SIZE(dateiso)
4216ENDDO
4217INQUIRE(unit, form=form)
4218IF (form == 'FORMATTED') THEN
4219 WRITE(unit,'(3(A23,1X))')dateiso
4220ELSE
4221 WRITE(unit)dateiso
4222ENDIF
4223DEALLOCATE(dateiso)
4224
4225END SUBROUTINE timedelta_vect_write_unit
4226
4227
4228ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
4229TYPE(timedelta),INTENT(in) :: this
4230LOGICAL :: res
4231
4232res = .not. this == timedelta_miss
4233
4234end FUNCTION c_e_timedelta
4235
4236
4237elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
4238
4239!!omstart JELADATA5
4240! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
4241! 1 IMINUTI)
4242!
4243! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
4244!
4245! variabili integer*4
4246! IN:
4247! IDAY,IMONTH,IYEAR, I*4
4248! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
4249!
4250! OUT:
4251! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
4252!!OMEND
4253
4254INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
4255INTEGER,intent(out) :: iminuti
4256
4257iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
4258
4259END SUBROUTINE jeladata5
4260
4261
4262elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
4263INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
4264INTEGER(KIND=int_ll),intent(out) :: imillisec
4265
4266imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
4267 + imsec
4268
4269END SUBROUTINE jeladata5_1
4270
4271
4272
4273elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
4274
4275!!omstart JELADATA6
4276! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
4277! 1 IMINUTI)
4278!
4279! Calcola la data e l'ora corrispondente a IMINUTI dopo il
4280! 1/1/1
4281!
4282! variabili integer*4
4283! IN:
4284! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
4285!
4286! OUT:
4287! IDAY,IMONTH,IYEAR, I*4
4288! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
4289!!OMEND
4290
4291
4292INTEGER,intent(in) :: iminuti
4293INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
4294
4295INTEGER ::igiorno
4296
4297imin = mod(iminuti,60)
4298ihour = mod(iminuti,1440)/60
4299igiorno = iminuti/1440
4301CALL ndyin(igiorno,iday,imonth,iyear)
4302
4303END SUBROUTINE jeladata6
4304
4305
4306elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
4307INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
4308INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
4309
4310INTEGER :: igiorno
4311
4313!imin = MOD(imillisec/60000_int_ll, 60)
4314!ihour = MOD(imillisec/3600000_int_ll, 24)
4315imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
4316ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
4317igiorno = int(imillisec/86400000_int_ll)
4318!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
4319CALL ndyin(igiorno,iday,imonth,iyear)
4320
4321END SUBROUTINE jeladata6_1
4322
4323
4324elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
4325
4326!!OMSTART NDYIN
4327! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
4328! restituisce la data fornendo in input il numero di
4329! giorni dal 1/1/1
4330!
4331!!omend
4332
4333INTEGER,intent(in) :: ndays
4334INTEGER,intent(out) :: igg, imm, iaa
4335integer :: n,lndays
4336
4337lndays=ndays
4338
4339n = lndays/d400
4340lndays = lndays - n*d400
4341iaa = year0 + n*400
4342n = min(lndays/d100, 3)
4343lndays = lndays - n*d100
4344iaa = iaa + n*100
4345n = lndays/d4
4346lndays = lndays - n*d4
4347iaa = iaa + n*4
4348n = min(lndays/d1, 3)
4349lndays = lndays - n*d1
4350iaa = iaa + n
4351n = bisextilis(iaa)
4352DO imm = 1, 12
4353 IF (lndays < ianno(imm+1,n)) EXIT
4354ENDDO
4355igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
4356
4357END SUBROUTINE ndyin
4358
4359
4360integer elemental FUNCTION ndays(igg,imm,iaa)
4361
4362!!OMSTART NDAYS
4363! FUNCTION NDAYS(IGG,IMM,IAA)
4364! restituisce il numero di giorni dal 1/1/1
4365! fornendo in input la data
4366!
4367!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4368! nota bene E' SICURO !!!
4369! un anno e' bisestile se divisibile per 4
4370! un anno rimane bisestile se divisibile per 400
4371! un anno NON e' bisestile se divisibile per 100
4372!
4373!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4374!
4375!!omend
4376
4377INTEGER, intent(in) :: igg, imm, iaa
4378
4379INTEGER :: lmonth, lyear
4380
4381! Limito il mese a [1-12] e correggo l'anno coerentemente
4382lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
4383lyear = iaa + (imm - lmonth)/12
4384ndays = igg+ianno(lmonth, bisextilis(lyear))
4385ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
4386 (lyear-year0)/400
4387
4388END FUNCTION ndays
4389
4390
4391elemental FUNCTION bisextilis(annum)
4392INTEGER,INTENT(in) :: annum
4393INTEGER :: bisextilis
4394
4396 bisextilis = 2
4397ELSE
4398 bisextilis = 1
4399ENDIF
4400END FUNCTION bisextilis
4401
4402
4403ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
4404TYPE(cyclicdatetime),INTENT(IN) :: this, that
4405LOGICAL :: res
4406
4407res = .true.
4408if (this%minute /= that%minute) res=.false.
4409if (this%hour /= that%hour) res=.false.
4410if (this%day /= that%day) res=.false.
4411if (this%month /= that%month) res=.false.
4412if (this%tendaysp /= that%tendaysp) res=.false.
4413
4414END FUNCTION cyclicdatetime_eq
4415
4416
4417ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
4418TYPE(cyclicdatetime),INTENT(IN) :: this
4419TYPE(datetime),INTENT(IN) :: that
4420LOGICAL :: res
4421
4422integer :: minute,hour,day,month
4423
4425
4426res = .true.
4432 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4433end if
4434
4435END FUNCTION cyclicdatetime_datetime_eq
4436
4437
4438ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
4439TYPE(datetime),INTENT(IN) :: this
4440TYPE(cyclicdatetime),INTENT(IN) :: that
4441LOGICAL :: res
4442
4443integer :: minute,hour,day,month
4444
4446
4447res = .true.
4452
4454 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4455end if
4456
4457
4458END FUNCTION datetime_cyclicdatetime_eq
4459
4460ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
4461TYPE(cyclicdatetime),INTENT(in) :: this
4462LOGICAL :: res
4463
4464res = .not. this == cyclicdatetime_miss
4465
4466end FUNCTION c_e_cyclicdatetime
4467
4468
4469!> Costruisce un oggetto \a cyclicdatetime con i parametri opzionali forniti.
4470!! Se non viene passato nulla lo inizializza a missing.
4471FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4472INTEGER,INTENT(IN),OPTIONAL :: tendaysp !< ten days period in month (1, 2, 3)
4473INTEGER,INTENT(IN),OPTIONAL :: month !< mese, default=missing
4474INTEGER,INTENT(IN),OPTIONAL :: day !< mese, default=missing
4475INTEGER,INTENT(IN),OPTIONAL :: hour !< ore, default=missing
4476INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti, default=missing
4477CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate !< inizializza l'oggetto ad una data espressa nel formato \c TMMGGhhmm where any doubled char should be // for missing. This parameter have priority on others also if set to missing.
4478
4479integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4480
4481
4482TYPE(cyclicdatetime) :: this !< oggetto da inizializzare
4483
4484if (present(chardate)) then
4485
4486 ltendaysp=imiss
4487 lmonth=imiss
4488 lday=imiss
4489 lhour=imiss
4490 lminute=imiss
4491
4493 ! TMMGGhhmm
4494 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4495 !print*,chardate(1:1),ios,ltendaysp
4496 if (ios /= 0)ltendaysp=imiss
4497
4498 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4499 !print*,chardate(2:3),ios,lmonth
4500 if (ios /= 0)lmonth=imiss
4501
4502 read(chardate(4:5),'(i2)',iostat=ios)lday
4503 !print*,chardate(4:5),ios,lday
4504 if (ios /= 0)lday=imiss
4505
4506 read(chardate(6:7),'(i2)',iostat=ios)lhour
4507 !print*,chardate(6:7),ios,lhour
4508 if (ios /= 0)lhour=imiss
4509
4510 read(chardate(8:9),'(i2)',iostat=ios)lminute
4511 !print*,chardate(8:9),ios,lminute
4512 if (ios /= 0)lminute=imiss
4513 end if
4514
4515 this%tendaysp=ltendaysp
4516 this%month=lmonth
4517 this%day=lday
4518 this%hour=lhour
4519 this%minute=lminute
4520else
4521 this%tendaysp=optio_l(tendaysp)
4522 this%month=optio_l(month)
4523 this%day=optio_l(day)
4524 this%hour=optio_l(hour)
4525 this%minute=optio_l(minute)
4526end if
4527
4528END FUNCTION cyclicdatetime_new
4529
4530!> Restituisce una rappresentazione carattere stampabile di un oggetto
4531!! \a cyclicdatetime.
4532elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4533TYPE(cyclicdatetime),INTENT(IN) :: this
4534
4535CHARACTER(len=80) :: char
4536
4539
4540END FUNCTION cyclicdatetime_to_char
4541
4542
4543!> Restituisce una rappresentazione convenzionale in forma datetime
4544!! \a cyclicdatetime.
4545!! The following conventional code values are used to specify which data was taken into account in the computation:
4546!! year=1001 : dayly values of a specified month (depends by day and month)
4547!! year=1002 : dayly,hourly values of a specified month (depends by day and month and hour)
4548!! year=1003 : 10 day period of a specified month (depends by day(1,11,21) and month)
4549!! year=1004 : 10 day period of a specified month,hourly (depends by day(1,11,21) and month and hour)
4550!! year=1005 : mounthly values (depend by month)
4551!! year=1006 : mounthly,hourly values (depend by month and hour)
4552!! year=1007 : yearly values (no other time dependence)
4553!! year=1008 : yearly,hourly values (depend by year and hour)
4554!! 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.
4555FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4556TYPE(cyclicdatetime),INTENT(IN) :: this !< cycliddatetime to use in compute
4557
4558TYPE(datetime) :: dtc
4559
4560integer :: year,month,day,hour
4561
4562dtc = datetime_miss
4563
4564! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4566 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4567 return
4568end if
4569
4570! minute present -> not good for conventional datetime
4572! day, month and tendaysp present -> no good
4574
4576 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4578 day=(this%tendaysp-1)*10+1
4579 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4581 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4583 ! only day present -> no good
4584 return
4585end if
4586
4589 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4590end if
4591
4592
4593END FUNCTION cyclicdatetime_to_conventional
4594
4595
4596
4597FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4598TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4599
4600CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4601
4602char=cyclicdatetime_to_char(in)
4603
4604END FUNCTION trim_cyclicdatetime_to_char
4605
4606
4607
4608SUBROUTINE display_cyclicdatetime(this)
4609TYPE(cyclicdatetime),INTENT(in) :: this
4610
4612
4613end subroutine display_cyclicdatetime
4614
4615
4616#include "array_utilities_inc.F90"
4617
4619
Quick method to append an element to the array. Definition datetime_class.F90:616 Restituiscono il valore dell'oggetto nella forma desiderata. Definition datetime_class.F90:322 Costruttori per le classi datetime e timedelta. Definition datetime_class.F90:311 Method for inserting elements of the array at a desired position. Definition datetime_class.F90:607 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition datetime_class.F90:639 Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o... Definition datetime_class.F90:478 Method for removing elements of the array at a desired position. Definition datetime_class.F90:622 Functions that return a trimmed CHARACTER representation of the input variable. Definition datetime_class.F90:349 Restituiscono il valore dell'oggetto in forma di stringa stampabile. Definition datetime_class.F90:327 Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ... Definition datetime_class.F90:485 Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 Definitions of constants and functions for working with missing values. Definition missing_values.f90:50 Module for quickly interpreting the OPTIONAL parameters passed to a subprogram. Definition optional_values.f90:28 Class for expressing a cyclic datetime. Definition datetime_class.F90:255 Class for expressing an absolute time value. Definition datetime_class.F90:233 Class for expressing a relative time interval. Definition datetime_class.F90:245 |