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