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