libsim Versione 7.2.6
|
◆ timedelta_vect_read_unit()
This method reads from a Fortran file unit the contents of the object this. The record to be read must have been written with the write_unit method. The method works both on formatted and unformatted files.
Definizione alla linea 2012 del file datetime_class.F90. 2013! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2014! authors:
2015! Davide Cesari <dcesari@arpa.emr.it>
2016! Paolo Patruno <ppatruno@arpa.emr.it>
2017
2018! This program is free software; you can redistribute it and/or
2019! modify it under the terms of the GNU General Public License as
2020! published by the Free Software Foundation; either version 2 of
2021! the License, or (at your option) any later version.
2022
2023! This program is distributed in the hope that it will be useful,
2024! but WITHOUT ANY WARRANTY; without even the implied warranty of
2025! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2026! GNU General Public License for more details.
2027
2028! You should have received a copy of the GNU General Public License
2029! along with this program. If not, see <http://www.gnu.org/licenses/>.
2030#include "config.h"
2031!> \brief Classi per la gestione delle coordinate temporali.
2032!!
2033!! Questo module definisce un paio di classi per la gestione di
2034!! date assolute e di intervalli temporali.
2035!! Entrambe le classi hanno le componenti di tipo \c PRIVATE, per
2036!! cui non possono essere manipolate direttamente ma solo tramite i
2037!! relativi metodi. Attualmente la precisione massima consentita � di un
2038!! minuto, mentre l'estensione delle date rappresentabili va dall'anno 1
2039!! all'anno 4074 d.C. circa, ipotizzando un calendario gregoriano per
2040!! tutto il periodo. Questo fatto implica che le date precedenti
2041!! all'introduzione del calendario gregoriano avranno discrepanze di uno
2042!! o pi� giorni rispetto alle date storiche "vere", ammesso che
2043!! qualcuno conosca queste ultime.
2044!! \ingroup base
2052IMPLICIT NONE
2053
2054INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2055
2056!> Class for expressing an absolute time value.
2058 PRIVATE
2059 INTEGER(KIND=int_ll) :: iminuti
2061
2062!> Class for expressing a relative time interval.
2063!! It can take also negative values. According to how it is
2064!! initilasied, it can indicate an interval of fixed duration, or a
2065!! "calendar" interval of variable duration in units of months and/or
2066!! years or even a mix of the two, however, in the latter two cases
2067!! the operations that can be made with objects of this class are
2068!! restricted.
2070 PRIVATE
2071 INTEGER(KIND=int_ll) :: iminuti
2072 INTEGER :: month
2074
2075
2076!> Class for expressing a cyclic datetime.
2077!! It can be used to specify, for example, every January in all years
2078!! or the same time for all days and so on.
2080 PRIVATE
2081 INTEGER :: minute
2082 INTEGER :: hour
2083 INTEGER :: day
2084 INTEGER :: tendaysp
2085 INTEGER :: month
2087
2088
2089!> valore mancante per datetime
2091!> valore mancante per timedelta
2093!> intervallo timedelta di durata nulla
2095!> inizializza con l'ora UTC
2096INTEGER, PARAMETER :: datetime_utc=1
2097!> inizializza con l'ora locale
2098INTEGER, PARAMETER :: datetime_local=2
2099!> Minimum valid value for datetime
2101!> Minimum valid value for datetime
2103!> Minimum valid value for timedelta
2105!> Minimum valid value for timedelta
2107!> missing value for cyclicdatetime
2108TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2109
2110
2111INTEGER(kind=dateint), PARAMETER :: &
2112 sec_in_day=86400, &
2113 sec_in_hour=3600, &
2114 sec_in_min=60, &
2115 min_in_day=1440, &
2116 min_in_hour=60, &
2117 hour_in_day=24
2118
2119INTEGER,PARAMETER :: &
2120 year0=1, & ! anno di origine per iminuti
2121 d1=365, & ! giorni/1 anno nel calendario gregoriano
2122 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2123 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2124 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2125 ianno(13,2)=reshape((/ &
2126 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2127 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2128
2129INTEGER(KIND=int_ll),PARAMETER :: &
2130 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2131
2132!> Costruttori per le classi datetime e timedelta. Devono essere richiamati
2133!! per tutti gli oggetti di questo tipo definiti in un programma
2134!! tranne i casi in cui un oggetto viene creato per assegnazione.
2136 MODULE PROCEDURE datetime_init, timedelta_init
2137END INTERFACE
2138
2139!> Distruttori per le 2 classi. Distruggono gli oggetti in maniera pulita,
2140!! assegnando loro un valore mancante.
2142 MODULE PROCEDURE datetime_delete, timedelta_delete
2143END INTERFACE
2144
2145!> Restituiscono il valore dell'oggetto nella forma desiderata.
2147 MODULE PROCEDURE datetime_getval, timedelta_getval
2148END INTERFACE
2149
2150!> Restituiscono il valore dell'oggetto in forma di stringa stampabile.
2152 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2153END INTERFACE
2154
2155
2156!> Functions that return a trimmed CHARACTER representation of the
2157!! input variable. The functions are analogous to \a to_char but they
2158!! return representation of the input in a CHARACTER with a variable
2159!! length, which needs not to be trimmed before use. The optional
2160!! format here is not accepted and these functions are not \a
2161!! ELEMENTAL so they work only on scalar arguments.
2162!!
2163!! \param in (datetime or timedelta) value to be represented as CHARACTER
2164!!
2165!! Example of use:
2166!! \code
2167!! USE datetime_class
2168!! type(datetime) :: t
2169!! ...
2170!! WRITE(*,*)'The value provided is, '//t2c(t)'
2171!! ...
2172!! \endcode
2174 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2175END INTERFACE
2176
2177!> Operatore logico di uguaglianza tra oggetti della stessa classe.
2178!! Funziona anche per
2179!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2180!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2181!! di 1 dimensione e scalari).
2182INTERFACE OPERATOR (==)
2183 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2184 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2185END INTERFACE
2186
2187!> Operatore logico di disuguaglianza tra oggetti della stessa classe.
2188!! Funziona anche per
2189!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2190!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2191!! di 1 dimensione e scalari).
2192INTERFACE OPERATOR (/=)
2193 MODULE PROCEDURE datetime_ne, timedelta_ne
2194END INTERFACE
2195
2196!> Operatore logico maggiore tra oggetti della stessa classe.
2197!! Funziona anche per
2198!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2199!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2200!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2201!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2202!! \a timedelta "popolari" o misti.
2203INTERFACE OPERATOR (>)
2204 MODULE PROCEDURE datetime_gt, timedelta_gt
2205END INTERFACE
2206
2207!> Operatore logico minore tra oggetti della stessa classe.
2208!! Funziona anche per
2209!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2210!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2211!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2212!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2213!! \a timedelta "popolari" o misti.
2214INTERFACE OPERATOR (<)
2215 MODULE PROCEDURE datetime_lt, timedelta_lt
2216END INTERFACE
2217
2218!> Operatore logico maggiore-uguale tra oggetti della stessa classe.
2219!! Funziona anche per
2220!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2221!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2222!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2223!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2224!! \a timedelta "popolari" o misti.
2225INTERFACE OPERATOR (>=)
2226 MODULE PROCEDURE datetime_ge, timedelta_ge
2227END INTERFACE
2228
2229!> Operatore logico minore-uguale tra oggetti della stessa classe.
2230!! Funziona anche per
2231!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2232!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2233!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2234!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2235!! \a timedelta "popolari" o misti.
2236INTERFACE OPERATOR (<=)
2237 MODULE PROCEDURE datetime_le, timedelta_le
2238END INTERFACE
2239
2240!> Operatore di somma per datetime e timedelta. Solo alcune combinazioni
2241!! sono definite:
2242!! - \a timedelta + \a timedelta = \a timedelta
2243!! - \a datetime + \a timedelta = \a datetime
2244!! .
2245!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
2246INTERFACE OPERATOR (+)
2247 MODULE PROCEDURE datetime_add, timedelta_add
2248END INTERFACE
2249
2250!> Operatore di sottrazione per datetime e timedelta. Solo alcune combinazioni
2251!! sono definite:
2252!! - \a timedelta - \a timedelta = \a timedelta
2253!! - \a datetime - \a timedelta = \a datetime
2254!! - \a datetime - \a datetime = \a timedelta
2255!! .
2256!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
2257INTERFACE OPERATOR (-)
2258 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
2259END INTERFACE
2260
2261!> Operatore di moltiplicazione di timedelta per uno scalare. Sono definite:
2262!! - \a timedelta * \a INTEGER = \a timedelta
2263!! - \a INTEGER * \a timedelta = \a timedelta
2264!! .
2265!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
2266INTERFACE OPERATOR (*)
2267 MODULE PROCEDURE timedelta_mult, timedelta_tlum
2268END INTERFACE
2269
2270!> Operatore di divisione di timedelta. Sono definite:
2271!! - \a timedelta / \a INTEGER = \a timedelta
2272!! - \a timedelta / \a timedelta = \a INTEGER
2273!! .
2274!! La prima combinazione � valida per tutti i tipi di intervallo, mentre la
2275!! seconda � definita solo per intervalli "puri".
2276INTERFACE OPERATOR (/)
2277 MODULE PROCEDURE timedelta_divint, timedelta_divtd
2278END INTERFACE
2279
2280!> Operatore di resto della divisione.
2281!! Sono definite le combinazioni:
2282!! - \a MOD(\a timedelta, \a timedelta) = \a timedelta
2283!! - \a MOD(\a datetime, \a timedelta) = \a timedelta.
2284!!
2285!! Sono definite solo per intervalli "puri"
2286!! La seconda combinazione ha senso principalmente con intervalli di
2287!! 1 minuto, 1 ora o
2288!! 1 giorno, per calcolare di quanto l'oggetto \a datetime indicato dista
2289!! dal minuto, ora o giorno tondo precedente pi� vicino.
2291 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
2292END INTERFACE
2293
2294!> Operatore di valore assoluto di un intervallo.
2295!! - \a ABS(\a timedelta) = \a timedelta
2297 MODULE PROCEDURE timedelta_abs
2298END INTERFACE
2299
2300!> Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da
2301!! un file \c FORMATTED o \c UNFORMATTED.
2303 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
2304 timedelta_read_unit, timedelta_vect_read_unit
2305END INTERFACE
2306
2307!> Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su
2308!! un file \c FORMATTED o \c UNFORMATTED.
2310 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
2311 timedelta_write_unit, timedelta_vect_write_unit
2312END INTERFACE
2313
2314!> Print object
2316 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
2317END INTERFACE
2318
2319!> Missing check
2321 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
2322END INTERFACE
2323
2324#undef VOL7D_POLY_TYPE
2325#undef VOL7D_POLY_TYPES
2326#undef ENABLE_SORT
2327#define VOL7D_POLY_TYPE TYPE(datetime)
2328#define VOL7D_POLY_TYPES _datetime
2329#define ENABLE_SORT
2330#include "array_utilities_pre.F90"
2331
2332
2333#define ARRAYOF_ORIGTYPE TYPE(datetime)
2334#define ARRAYOF_TYPE arrayof_datetime
2335#define ARRAYOF_ORIGEQ 1
2336#include "arrayof_pre.F90"
2337! from arrayof
2338
2339PRIVATE
2340
2342 datetime_min, datetime_max, &
2345 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
2346 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
2348 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
2349 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
2351 count_distinct, pack_distinct, &
2352 count_distinct_sorted, pack_distinct_sorted, &
2353 count_and_pack_distinct, &
2355 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
2357PUBLIC insert_unique, append_unique
2358PUBLIC cyclicdatetime_to_conventional
2359
2360CONTAINS
2361
2362
2363! ==============
2364! == datetime ==
2365! ==============
2366
2367!> Initialize a \a datetime object according to the provided arguments
2368!! If no arguments are passed a missing object is created. Notice
2369!! that the optional parameter groups (\a year, \a month, \a hour, \a
2370!! minute, \a msec), (\a unixtime), (\a isodate), (\a simpledate) are
2371!! mutually exclusive, the results are not guaranteed if arguments of
2372!! different groups are present.
2373ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
2374 unixtime, isodate, simpledate) RESULT(this)
2375INTEGER,INTENT(IN),OPTIONAL :: year !< year a.C.; for reasons not yet investigated, only years >0 (a.C.) are allowed
2376INTEGER,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
2377INTEGER,INTENT(IN),OPTIONAL :: day !< day, default=1 if \a year is present, it can have non canonical values too
2378INTEGER,INTENT(IN),OPTIONAL :: hour !< hours, default=0 if \a year is present, it can have non canonical values too
2379INTEGER,INTENT(IN),OPTIONAL :: minute !< minutes, default=0 if \a year is present, it can have non canonical values too
2380INTEGER,INTENT(IN),OPTIONAL :: msec !< milliseconds, default=0 if \a year is present, it can have non canonical values too
2381INTEGER(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
2382CHARACTER(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
2383CHARACTER(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
2384
2385TYPE(datetime) :: this
2386INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2387CHARACTER(len=23) :: datebuf
2388
2389IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
2390 lyear = year
2391 IF (PRESENT(month)) THEN
2392 lmonth = month
2393 ELSE
2394 lmonth = 1
2395 ENDIF
2396 IF (PRESENT(day)) THEN
2397 lday = day
2398 ELSE
2399 lday = 1
2400 ENDIF
2401 IF (PRESENT(hour)) THEN
2402 lhour = hour
2403 ELSE
2404 lhour = 0
2405 ENDIF
2406 IF (PRESENT(minute)) THEN
2407 lminute = minute
2408 ELSE
2409 lminute = 0
2410 ENDIF
2411 IF (PRESENT(msec)) THEN
2412 lmsec = msec
2413 ELSE
2414 lmsec = 0
2415 ENDIF
2416
2419 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2420 else
2421 this=datetime_miss
2422 end if
2423
2424ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
2426 this%iminuti = (unixtime + unsec)*1000
2427 else
2428 this=datetime_miss
2429 end if
2430
2431ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
2432
2434 datebuf(1:23) = '0001-01-01 00:00:00.000'
2435 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
2436 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
2437 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2438 lmsec = lmsec + lsec*1000
2439 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2440 RETURN
2441
2442100 CONTINUE ! condizione di errore in isodate
2444 RETURN
2445 ELSE
2446 this = datetime_miss
2447 ENDIF
2448
2449ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
2451 datebuf(1:17) = '00010101000000000'
2452 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2453 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
2454 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2455 lmsec = lmsec + lsec*1000
2456 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2457 RETURN
2458
2459120 CONTINUE ! condizione di errore in simpledate
2461 RETURN
2462 ELSE
2463 this = datetime_miss
2464 ENDIF
2465
2466ELSE
2467 this = datetime_miss
2468ENDIF
2469
2470END FUNCTION datetime_new
2471
2472
2473!> Initialize a datetime object with the current system time.
2474FUNCTION datetime_new_now(now) RESULT(this)
2475INTEGER,INTENT(IN) :: now !< select the time for initialisation, \a datetime_utc for UTC (preferred) or \a datetime_local for local time
2476TYPE(datetime) :: this
2477
2478INTEGER :: dt(8)
2479
2481 CALL date_and_time(values=dt)
2482 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
2484 msec=dt(7)*1000+dt(8))
2485ELSE
2486 this = datetime_miss
2487ENDIF
2488
2489END FUNCTION datetime_new_now
2490
2491
2492!> Costruisce un oggetto \a datetime con i parametri opzionali forniti.
2493!! Se non viene passato nulla lo inizializza a 1/1/1.
2494!! Notare che i gruppi di parametri opzionali (\a year, \a month, \a hour,
2495!! \a minute, \a msec), (\a unixtime), (\a isodate), (\a simpledate),
2496!! (\a oraclesimdate) sono mutualmente escludentesi; \a oraclesimedate �
2497!! obsoleto, usare piuttosto \a simpledate.
2498SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
2499 unixtime, isodate, simpledate, now)
2500TYPE(datetime),INTENT(INOUT) :: this !< oggetto da inizializzare
2501INTEGER,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.)
2502INTEGER,INTENT(IN),OPTIONAL :: month !< mese, default=1 se � specificato \a year; pu� assumere anche valori <1 o >12, l'oggetto finale si aggiusta coerentemente
2503INTEGER,INTENT(IN),OPTIONAL :: day !< mese, default=1 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2504INTEGER,INTENT(IN),OPTIONAL :: hour !< ore, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2505INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2506INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2507INTEGER(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)
2508CHARACTER(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
2509CHARACTER(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
2510INTEGER,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
2511
2512IF (PRESENT(now)) THEN
2513 this = datetime_new_now(now)
2514ELSE
2515 this = datetime_new(year, month, day, hour, minute, msec, &
2516 unixtime, isodate, simpledate)
2517ENDIF
2518
2519END SUBROUTINE datetime_init
2520
2521
2522ELEMENTAL SUBROUTINE datetime_delete(this)
2523TYPE(datetime),INTENT(INOUT) :: this
2524
2525this%iminuti = illmiss
2526
2527END SUBROUTINE datetime_delete
2528
2529
2530!> Restituisce il valore di un oggetto \a datetime in una o pi�
2531!! modalit� desiderate. Qualsiasi combinazione dei parametri
2532!! opzionali � consentita. \a oraclesimedate �
2533!! obsoleto, usare piuttosto \a simpledate.
2534PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
2535 unixtime, isodate, simpledate, oraclesimdate)
2536TYPE(datetime),INTENT(IN) :: this !< oggetto di cui restituire il valore
2537INTEGER,INTENT(OUT),OPTIONAL :: year !< anno
2538INTEGER,INTENT(OUT),OPTIONAL :: month !< mese
2539INTEGER,INTENT(OUT),OPTIONAL :: day !< giorno
2540INTEGER,INTENT(OUT),OPTIONAL :: hour !< ore
2541INTEGER,INTENT(OUT),OPTIONAL :: minute !< minuti
2542INTEGER,INTENT(OUT),OPTIONAL :: msec !< millisecondi
2543INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime !< secondi a partire dal 1/1/1970
2544CHARACTER(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
2545CHARACTER(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
2546CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate !< data parziale nel formato \c AAAAMMGGhhmm
2547
2548INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2549CHARACTER(len=23) :: datebuf
2550
2551IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
2552 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
2553 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
2554
2555 IF (this == datetime_miss) THEN
2556
2557 IF (PRESENT(msec)) THEN
2558 msec = imiss
2559 ENDIF
2560 IF (PRESENT(minute)) THEN
2561 minute = imiss
2562 ENDIF
2563 IF (PRESENT(hour)) THEN
2564 hour = imiss
2565 ENDIF
2566 IF (PRESENT(day)) THEN
2567 day = imiss
2568 ENDIF
2569 IF (PRESENT(month)) THEN
2570 month = imiss
2571 ENDIF
2572 IF (PRESENT(year)) THEN
2573 year = imiss
2574 ENDIF
2575 IF (PRESENT(isodate)) THEN
2576 isodate = cmiss
2577 ENDIF
2578 IF (PRESENT(simpledate)) THEN
2579 simpledate = cmiss
2580 ENDIF
2581 IF (PRESENT(oraclesimdate)) THEN
2582!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2583!!$ 'obsoleto, usare piuttosto simpledate')
2584 oraclesimdate=cmiss
2585 ENDIF
2586 IF (PRESENT(unixtime)) THEN
2587 unixtime = illmiss
2588 ENDIF
2589
2590 ELSE
2591
2592 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2593 IF (PRESENT(msec)) THEN
2594 msec = lmsec
2595 ENDIF
2596 IF (PRESENT(minute)) THEN
2597 minute = lminute
2598 ENDIF
2599 IF (PRESENT(hour)) THEN
2600 hour = lhour
2601 ENDIF
2602 IF (PRESENT(day)) THEN
2603 day = lday
2604 ENDIF
2605 IF (PRESENT(month)) THEN
2606 month = lmonth
2607 ENDIF
2608 IF (PRESENT(year)) THEN
2609 year = lyear
2610 ENDIF
2611 IF (PRESENT(isodate)) THEN
2612 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
2613 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
2615 isodate = datebuf(1:min(len(isodate),23))
2616 ENDIF
2617 IF (PRESENT(simpledate)) THEN
2618 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
2619 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
2620 simpledate = datebuf(1:min(len(simpledate),17))
2621 ENDIF
2622 IF (PRESENT(oraclesimdate)) THEN
2623!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2624!!$ 'obsoleto, usare piuttosto simpledate')
2625 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
2626 ENDIF
2627 IF (PRESENT(unixtime)) THEN
2628 unixtime = this%iminuti/1000_int_ll-unsec
2629 ENDIF
2630
2631 ENDIF
2632ENDIF
2633
2634END SUBROUTINE datetime_getval
2635
2636
2637!> Restituisce una rappresentazione carattere stampabile di un oggetto
2638!! \a datetime.
2639elemental FUNCTION datetime_to_char(this) RESULT(char)
2640TYPE(datetime),INTENT(IN) :: this
2641
2642CHARACTER(len=23) :: char
2643
2645
2646END FUNCTION datetime_to_char
2647
2648
2649FUNCTION trim_datetime_to_char(in) RESULT(char)
2650TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
2651
2652CHARACTER(len=len_trim(datetime_to_char(in))) :: char
2653
2654char=datetime_to_char(in)
2655
2656END FUNCTION trim_datetime_to_char
2657
2658
2659
2660SUBROUTINE display_datetime(this)
2661TYPE(datetime),INTENT(in) :: this
2662
2664
2665end subroutine display_datetime
2666
2667
2668
2669SUBROUTINE display_timedelta(this)
2670TYPE(timedelta),INTENT(in) :: this
2671
2673
2674end subroutine display_timedelta
2675
2676
2677
2678ELEMENTAL FUNCTION c_e_datetime(this) result (res)
2679TYPE(datetime),INTENT(in) :: this
2680LOGICAL :: res
2681
2682res = .not. this == datetime_miss
2683
2684end FUNCTION c_e_datetime
2685
2686
2687ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
2688TYPE(datetime),INTENT(IN) :: this, that
2689LOGICAL :: res
2690
2691res = this%iminuti == that%iminuti
2692
2693END FUNCTION datetime_eq
2694
2695
2696ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
2697TYPE(datetime),INTENT(IN) :: this, that
2698LOGICAL :: res
2699
2700res = .NOT.(this == that)
2701
2702END FUNCTION datetime_ne
2703
2704
2705ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
2706TYPE(datetime),INTENT(IN) :: this, that
2707LOGICAL :: res
2708
2709res = this%iminuti > that%iminuti
2710
2711END FUNCTION datetime_gt
2712
2713
2714ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
2715TYPE(datetime),INTENT(IN) :: this, that
2716LOGICAL :: res
2717
2718res = this%iminuti < that%iminuti
2719
2720END FUNCTION datetime_lt
2721
2722
2723ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
2724TYPE(datetime),INTENT(IN) :: this, that
2725LOGICAL :: res
2726
2727IF (this == that) THEN
2728 res = .true.
2729ELSE IF (this > that) THEN
2730 res = .true.
2731ELSE
2732 res = .false.
2733ENDIF
2734
2735END FUNCTION datetime_ge
2736
2737
2738ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
2739TYPE(datetime),INTENT(IN) :: this, that
2740LOGICAL :: res
2741
2742IF (this == that) THEN
2743 res = .true.
2744ELSE IF (this < that) THEN
2745 res = .true.
2746ELSE
2747 res = .false.
2748ENDIF
2749
2750END FUNCTION datetime_le
2751
2752
2753FUNCTION datetime_add(this, that) RESULT(res)
2754TYPE(datetime),INTENT(IN) :: this
2755TYPE(timedelta),INTENT(IN) :: that
2756TYPE(datetime) :: res
2757
2758INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2759
2760IF (this == datetime_miss .OR. that == timedelta_miss) THEN
2761 res = datetime_miss
2762ELSE
2763 res%iminuti = this%iminuti + that%iminuti
2764 IF (that%month /= 0) THEN
2766 minute=lminute, msec=lmsec)
2768 hour=lhour, minute=lminute, msec=lmsec)
2769 ENDIF
2770ENDIF
2771
2772END FUNCTION datetime_add
2773
2774
2775ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
2776TYPE(datetime),INTENT(IN) :: this, that
2777TYPE(timedelta) :: res
2778
2779IF (this == datetime_miss .OR. that == datetime_miss) THEN
2780 res = timedelta_miss
2781ELSE
2782 res%iminuti = this%iminuti - that%iminuti
2783 res%month = 0
2784ENDIF
2785
2786END FUNCTION datetime_subdt
2787
2788
2789FUNCTION datetime_subtd(this, that) RESULT(res)
2790TYPE(datetime),INTENT(IN) :: this
2791TYPE(timedelta),INTENT(IN) :: that
2792TYPE(datetime) :: res
2793
2794INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2795
2796IF (this == datetime_miss .OR. that == timedelta_miss) THEN
2797 res = datetime_miss
2798ELSE
2799 res%iminuti = this%iminuti - that%iminuti
2800 IF (that%month /= 0) THEN
2802 minute=lminute, msec=lmsec)
2804 hour=lhour, minute=lminute, msec=lmsec)
2805 ENDIF
2806ENDIF
2807
2808END FUNCTION datetime_subtd
2809
2810
2811!> This method reads from a Fortran file unit the contents of the
2812!! object \a this. The record to be read must have been written with
2813!! the ::write_unit method. The method works both on formatted and
2814!! unformatted files.
2815SUBROUTINE datetime_read_unit(this, unit)
2816TYPE(datetime),INTENT(out) :: this !< object to be read
2817INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
2818CALL datetime_vect_read_unit((/this/), unit)
2819
2820END SUBROUTINE datetime_read_unit
2821
2822
2823!> This method reads from a Fortran file unit the contents of the
2824!! object \a this. The record to be read must have been written with
2825!! the ::write_unit method. The method works both on formatted and
2826!! unformatted files.
2827SUBROUTINE datetime_vect_read_unit(this, unit)
2828TYPE(datetime) :: this(:) !< object to be read
2829INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
2830
2831CHARACTER(len=40) :: form
2832CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
2833INTEGER :: i
2834
2835ALLOCATE(dateiso(SIZE(this)))
2836INQUIRE(unit, form=form)
2837IF (form == 'FORMATTED') THEN
2838 READ(unit,'(A23,1X)')dateiso
2839ELSE
2840 READ(unit)dateiso
2841ENDIF
2842DO i = 1, SIZE(dateiso)
2844ENDDO
2845DEALLOCATE(dateiso)
2846
2847END SUBROUTINE datetime_vect_read_unit
2848
2849
2850!> This method writes on a Fortran file unit the contents of the
2851!! object \a this. The record can successively be read by the
2852!! ::read_unit method. The method works both on formatted and
2853!! unformatted files.
2854SUBROUTINE datetime_write_unit(this, unit)
2855TYPE(datetime),INTENT(in) :: this !< object to be written
2856INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
2857
2858CALL datetime_vect_write_unit((/this/), unit)
2859
2860END SUBROUTINE datetime_write_unit
2861
2862
2863!> This method writes on a Fortran file unit the contents of the
2864!! object \a this. The record can successively be read by the
2865!! ::read_unit method. The method works both on formatted and
2866!! unformatted files.
2867SUBROUTINE datetime_vect_write_unit(this, unit)
2868TYPE(datetime),INTENT(in) :: this(:) !< object to be written
2869INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
2870
2871CHARACTER(len=40) :: form
2872CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
2873INTEGER :: i
2874
2875ALLOCATE(dateiso(SIZE(this)))
2876DO i = 1, SIZE(dateiso)
2878ENDDO
2879INQUIRE(unit, form=form)
2880IF (form == 'FORMATTED') THEN
2881 WRITE(unit,'(A23,1X)')dateiso
2882ELSE
2883 WRITE(unit)dateiso
2884ENDIF
2885DEALLOCATE(dateiso)
2886
2887END SUBROUTINE datetime_vect_write_unit
2888
2889
2890#include "arrayof_post.F90"
2891
2892
2893! ===============
2894! == timedelta ==
2895! ===============
2896!> Costruisce un oggetto \a timedelta con i parametri opzionali forniti.
2897!! Se non viene passato nulla lo inizializza a intervallo di durata nulla.
2898!! L'intervallo ottenuto � pari alla somma dei valori di tutti i parametri
2899!! forniti, ovviamente non fornire un parametro equivale a fornirlo =0.
2900!! Questa � la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
2901!! rispetto alla versione \c SUBROUTINE \c init.
2902FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
2903 isodate, simpledate, oraclesimdate) RESULT (this)
2904INTEGER,INTENT(IN),OPTIONAL :: year !< anni, se presente l'oggetto diventa "popolare"
2905INTEGER,INTENT(IN),OPTIONAL :: month !< mesi, se presente l'oggetto diventa "popolare"
2906INTEGER,INTENT(IN),OPTIONAL :: day !< giorni
2907INTEGER,INTENT(IN),OPTIONAL :: hour !< ore
2908INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti
2909INTEGER,INTENT(IN),OPTIONAL :: sec !< secondi
2910INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi
2911CHARACTER(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
2912CHARACTER(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
2913CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmm, ignorando tutti gli altri parametri
2914
2915TYPE(timedelta) :: this !< oggetto da inizializzare
2916
2917CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
2918 isodate, simpledate, oraclesimdate)
2919
2920END FUNCTION timedelta_new
2921
2922
2923!> Costruisce un oggetto \a timedelta con i parametri opzionali forniti.
2924!! Se non viene passato nulla lo inizializza a intervallo di durata nulla.
2925!! L'intervallo ottenuto � pari alla somma dei valori di tutti i parametri
2926!! forniti, ovviamente non fornire un parametro equivale a fornirlo =0.
2927SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
2928 isodate, simpledate, oraclesimdate)
2929TYPE(timedelta),INTENT(INOUT) :: this !< oggetto da inizializzare
2930INTEGER,INTENT(IN),OPTIONAL :: year !< anni, se presente l'oggetto diventa "popolare"
2931INTEGER,INTENT(IN),OPTIONAL :: month !< mesi, se presente l'oggetto diventa "popolare"
2932INTEGER,INTENT(IN),OPTIONAL :: day !< giorni
2933INTEGER,INTENT(IN),OPTIONAL :: hour !< ore
2934INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti
2935INTEGER,INTENT(IN),OPTIONAL :: sec !< secondi
2936INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi
2937CHARACTER(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"
2938CHARACTER(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
2939CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmm, ignorando tutti gli altri parametri
2940
2941INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
2942CHARACTER(len=23) :: datebuf
2943
2944this%month = 0
2945
2946IF (PRESENT(isodate)) THEN
2947 datebuf(1:23) = '0000000000 00:00:00.000'
2948 l = len_trim(isodate)
2949! IF (l > 0) THEN
2951 IF (n > 0) THEN
2952 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
2953 datebuf(12-n:12-n+l-1) = isodate(:l)
2954 ELSE
2955 datebuf(1:l) = isodate(1:l)
2956 ENDIF
2957! ENDIF
2958
2959! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
2960 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
2961 h, m, s, ms
2962 this%month = lmonth + 12*lyear
2963 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
2964 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
2965 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
2966 RETURN
2967
2968200 CONTINUE ! condizione di errore in isodate
2970 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
2971 CALL raise_error()
2972
2973ELSE IF (PRESENT(simpledate)) THEN
2974 datebuf(1:17) = '00000000000000000'
2975 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2976 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
2977 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
2978 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
2979 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
2980
2981220 CONTINUE ! condizione di errore in simpledate
2983 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
2984 CALL raise_error()
2985 RETURN
2986
2987ELSE IF (PRESENT(oraclesimdate)) THEN
2988 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
2989 'obsoleto, usare piuttosto simpledate')
2990 READ(oraclesimdate, '(I8,2I2)')d, h, m
2991 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
2992 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
2993
2994ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
2995 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
2996 .and. .not. present(msec) .and. .not. present(isodate) &
2997 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
2998
2999 this=timedelta_miss
3000
3001ELSE
3002 this%iminuti = 0
3003 IF (PRESENT(year)) THEN
3005 this%month = this%month + year*12
3006 else
3007 this=timedelta_miss
3008 return
3009 end if
3010 ENDIF
3011 IF (PRESENT(month)) THEN
3013 this%month = this%month + month
3014 else
3015 this=timedelta_miss
3016 return
3017 end if
3018 ENDIF
3019 IF (PRESENT(day)) THEN
3021 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3022 else
3023 this=timedelta_miss
3024 return
3025 end if
3026 ENDIF
3027 IF (PRESENT(hour)) THEN
3029 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3030 else
3031 this=timedelta_miss
3032 return
3033 end if
3034 ENDIF
3035 IF (PRESENT(minute)) THEN
3037 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3038 else
3039 this=timedelta_miss
3040 return
3041 end if
3042 ENDIF
3043 IF (PRESENT(sec)) THEN
3045 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3046 else
3047 this=timedelta_miss
3048 return
3049 end if
3050 ENDIF
3051 IF (PRESENT(msec)) THEN
3053 this%iminuti = this%iminuti + msec
3054 else
3055 this=timedelta_miss
3056 return
3057 end if
3058 ENDIF
3059ENDIF
3060
3061
3062
3063
3064END SUBROUTINE timedelta_init
3065
3066
3067SUBROUTINE timedelta_delete(this)
3068TYPE(timedelta),INTENT(INOUT) :: this
3069
3070this%iminuti = imiss
3071this%month = 0
3072
3073END SUBROUTINE timedelta_delete
3074
3075
3076!> Restituisce il valore di un oggetto \a timedelta in una o pi�
3077!! modalit� desiderate. Qualsiasi combinazione dei parametri
3078!! opzionali � consentita. \a oraclesimedate �
3079!! obsoleto, usare piuttosto \a simpledate.
3080PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3081 day, hour, minute, sec, msec, &
3082 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3083TYPE(timedelta),INTENT(IN) :: this !< oggetto di cui restituire il valore
3084INTEGER,INTENT(OUT),OPTIONAL :: year !< anni, /=0 solo per intervalli "popolari"
3085INTEGER,INTENT(OUT),OPTIONAL :: month !< mesi modulo 12, /=0 solo per intervalli "popolari"
3086INTEGER,INTENT(OUT),OPTIONAL :: amonth !< mesi totali, /=0 solo per intervalli "popolari"
3087INTEGER,INTENT(OUT),OPTIONAL :: day !< giorni totali
3088INTEGER,INTENT(OUT),OPTIONAL :: hour !< ore modulo 24
3089INTEGER,INTENT(OUT),OPTIONAL :: minute !< minuti modulo 60
3090INTEGER,INTENT(OUT),OPTIONAL :: sec !< secondi modulo 60
3091INTEGER,INTENT(OUT),OPTIONAL :: msec !< millisecondi modulo 1000
3092INTEGER,INTENT(OUT),OPTIONAL :: ahour !< ore totali
3093INTEGER,INTENT(OUT),OPTIONAL :: aminute !< minuti totali
3094INTEGER,INTENT(OUT),OPTIONAL :: asec !< secondi totali
3095INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec !< millisecondi totali
3096CHARACTER(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
3097CHARACTER(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
3098CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate !< intervallo totale nel formato \c GGGGGGGGhhmm
3099
3100CHARACTER(len=23) :: datebuf
3101
3102IF (PRESENT(amsec)) THEN
3103 amsec = this%iminuti
3104ENDIF
3105IF (PRESENT(asec)) THEN
3106 asec = int(this%iminuti/1000_int_ll)
3107ENDIF
3108IF (PRESENT(aminute)) THEN
3109 aminute = int(this%iminuti/60000_int_ll)
3110ENDIF
3111IF (PRESENT(ahour)) THEN
3112 ahour = int(this%iminuti/3600000_int_ll)
3113ENDIF
3114IF (PRESENT(msec)) THEN
3115 msec = int(mod(this%iminuti, 1000_int_ll))
3116ENDIF
3117IF (PRESENT(sec)) THEN
3118 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3119ENDIF
3120IF (PRESENT(minute)) THEN
3121 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3122ENDIF
3123IF (PRESENT(hour)) THEN
3124 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3125ENDIF
3126IF (PRESENT(day)) THEN
3127 day = int(this%iminuti/86400000_int_ll)
3128ENDIF
3129IF (PRESENT(amonth)) THEN
3130 amonth = this%month
3131ENDIF
3132IF (PRESENT(month)) THEN
3133 month = mod(this%month-1,12)+1
3134ENDIF
3135IF (PRESENT(year)) THEN
3136 year = this%month/12
3137ENDIF
3138IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3139 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3143 isodate = datebuf(1:min(len(isodate),23))
3144
3145ENDIF
3146IF (PRESENT(simpledate)) THEN
3147 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3148 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3150 mod(this%iminuti, 1000_int_ll)
3151 simpledate = datebuf(1:min(len(simpledate),17))
3152ENDIF
3153IF (PRESENT(oraclesimdate)) THEN
3154!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3155!!$ 'obsoleto, usare piuttosto simpledate')
3156 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3158ENDIF
3159
3160END SUBROUTINE timedelta_getval
3161
3162
3163!> Restituisce una rappresentazione carattere stampabile di un oggetto
3164!! \a timedelta.
3165elemental FUNCTION timedelta_to_char(this) RESULT(char)
3166TYPE(timedelta),INTENT(IN) :: this
3167
3168CHARACTER(len=23) :: char
3169
3171
3172END FUNCTION timedelta_to_char
3173
3174
3175FUNCTION trim_timedelta_to_char(in) RESULT(char)
3176TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3177
3178CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3179
3180char=timedelta_to_char(in)
3181
3182END FUNCTION trim_timedelta_to_char
3183
3184
3185!> Restituisce il valore in millisecondi totali di un oggetto \a timedelta.
3186elemental FUNCTION timedelta_getamsec(this)
3187TYPE(timedelta),INTENT(IN) :: this !< oggetto di cui restituire il valore
3188INTEGER(kind=int_ll) :: timedelta_getamsec !< millisecondi totali
3189
3190timedelta_getamsec = this%iminuti
3191
3192END FUNCTION timedelta_getamsec
3193
3194
3195!> Depopularize a \a timedelta object.
3196!! If the object represents a "popular" or mixed interval, a fixed
3197!! interval representation is returned, by recomputing it on a
3198!! standard period (starting from 1970-01-01); if it represents
3199!! already a fixed interval, the same object is returned.
3200FUNCTION timedelta_depop(this)
3201TYPE(timedelta),INTENT(IN) :: this !< object to be depopularized
3202TYPE(timedelta) :: timedelta_depop
3203
3204TYPE(datetime) :: tmpdt
3205
3206IF (this%month == 0) THEN
3207 timedelta_depop = this
3208ELSE
3209 tmpdt = datetime_new(1970, 1, 1)
3210 timedelta_depop = (tmpdt + this) - tmpdt
3211ENDIF
3212
3213END FUNCTION timedelta_depop
3214
3215
3216elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3217TYPE(timedelta),INTENT(IN) :: this, that
3218LOGICAL :: res
3219
3220res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3221
3222END FUNCTION timedelta_eq
3223
3224
3225ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3226TYPE(timedelta),INTENT(IN) :: this, that
3227LOGICAL :: res
3228
3229res = .NOT.(this == that)
3230
3231END FUNCTION timedelta_ne
3232
3233
3234ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
3235TYPE(timedelta),INTENT(IN) :: this, that
3236LOGICAL :: res
3237
3238res = this%iminuti > that%iminuti
3239
3240END FUNCTION timedelta_gt
3241
3242
3243ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
3244TYPE(timedelta),INTENT(IN) :: this, that
3245LOGICAL :: res
3246
3247res = this%iminuti < that%iminuti
3248
3249END FUNCTION timedelta_lt
3250
3251
3252ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
3253TYPE(timedelta),INTENT(IN) :: this, that
3254LOGICAL :: res
3255
3256IF (this == that) THEN
3257 res = .true.
3258ELSE IF (this > that) THEN
3259 res = .true.
3260ELSE
3261 res = .false.
3262ENDIF
3263
3264END FUNCTION timedelta_ge
3265
3266
3267elemental FUNCTION timedelta_le(this, that) RESULT(res)
3268TYPE(timedelta),INTENT(IN) :: this, that
3269LOGICAL :: res
3270
3271IF (this == that) THEN
3272 res = .true.
3273ELSE IF (this < that) THEN
3274 res = .true.
3275ELSE
3276 res = .false.
3277ENDIF
3278
3279END FUNCTION timedelta_le
3280
3281
3282ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
3283TYPE(timedelta),INTENT(IN) :: this, that
3284TYPE(timedelta) :: res
3285
3286res%iminuti = this%iminuti + that%iminuti
3287res%month = this%month + that%month
3288
3289END FUNCTION timedelta_add
3290
3291
3292ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
3293TYPE(timedelta),INTENT(IN) :: this, that
3294TYPE(timedelta) :: res
3295
3296res%iminuti = this%iminuti - that%iminuti
3297res%month = this%month - that%month
3298
3299END FUNCTION timedelta_sub
3300
3301
3302ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
3303TYPE(timedelta),INTENT(IN) :: this
3304INTEGER,INTENT(IN) :: n
3305TYPE(timedelta) :: res
3306
3307res%iminuti = this%iminuti*n
3308res%month = this%month*n
3309
3310END FUNCTION timedelta_mult
3311
3312
3313ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
3314INTEGER,INTENT(IN) :: n
3315TYPE(timedelta),INTENT(IN) :: this
3316TYPE(timedelta) :: res
3317
3318res%iminuti = this%iminuti*n
3319res%month = this%month*n
3320
3321END FUNCTION timedelta_tlum
3322
3323
3324ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
3325TYPE(timedelta),INTENT(IN) :: this
3326INTEGER,INTENT(IN) :: n
3327TYPE(timedelta) :: res
3328
3329res%iminuti = this%iminuti/n
3330res%month = this%month/n
3331
3332END FUNCTION timedelta_divint
3333
3334
3335ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
3336TYPE(timedelta),INTENT(IN) :: this, that
3337INTEGER :: res
3338
3339res = int(this%iminuti/that%iminuti)
3340
3341END FUNCTION timedelta_divtd
3342
3343
3344elemental FUNCTION timedelta_mod(this, that) RESULT(res)
3345TYPE(timedelta),INTENT(IN) :: this, that
3346TYPE(timedelta) :: res
3347
3348res%iminuti = mod(this%iminuti, that%iminuti)
3349res%month = 0
3350
3351END FUNCTION timedelta_mod
3352
3353
3354ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
3355TYPE(datetime),INTENT(IN) :: this
3356TYPE(timedelta),INTENT(IN) :: that
3357TYPE(timedelta) :: res
3358
3359IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
3360 res = timedelta_0
3361ELSE
3362 res%iminuti = mod(this%iminuti, that%iminuti)
3363 res%month = 0
3364ENDIF
3365
3366END FUNCTION datetime_timedelta_mod
3367
3368
3369ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
3370TYPE(timedelta),INTENT(IN) :: this
3371TYPE(timedelta) :: res
3372
3373res%iminuti = abs(this%iminuti)
3374res%month = abs(this%month)
3375
3376END FUNCTION timedelta_abs
3377
3378
3379!> This method reads from a Fortran file unit the contents of the
3380!! object \a this. The record to be read must have been written with
3381!! the ::write_unit method. The method works both on formatted and
3382!! unformatted files.
3383SUBROUTINE timedelta_read_unit(this, unit)
3384TYPE(timedelta),INTENT(out) :: this !< object to be read
3385INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3386
3387CALL timedelta_vect_read_unit((/this/), unit)
3388
3389END SUBROUTINE timedelta_read_unit
3390
3391
3392!> This method reads from a Fortran file unit the contents of the
3393!! object \a this. The record to be read must have been written with
3394!! the ::write_unit method. The method works both on formatted and
3395!! unformatted files.
3396SUBROUTINE timedelta_vect_read_unit(this, unit)
3397TYPE(timedelta) :: this(:) !< object to be read
3398INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3399
3400CHARACTER(len=40) :: form
3401CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3402INTEGER :: i
3403
3404ALLOCATE(dateiso(SIZE(this)))
3405INQUIRE(unit, form=form)
3406IF (form == 'FORMATTED') THEN
3407 READ(unit,'(3(A23,1X))')dateiso
3408ELSE
3409 READ(unit)dateiso
3410ENDIF
3411DO i = 1, SIZE(dateiso)
3413ENDDO
3414DEALLOCATE(dateiso)
3415
3416END SUBROUTINE timedelta_vect_read_unit
3417
3418
3419!> This method writes on a Fortran file unit the contents of the
3420!! object \a this. The record can successively be read by the
3421!! ::read_unit method. The method works both on formatted and
3422!! unformatted files.
3423SUBROUTINE timedelta_write_unit(this, unit)
3424TYPE(timedelta),INTENT(in) :: this !< object to be written
3425INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3426
3427CALL timedelta_vect_write_unit((/this/), unit)
3428
3429END SUBROUTINE timedelta_write_unit
3430
3431
3432!> This method writes on a Fortran file unit the contents of the
3433!! object \a this. The record can successively be read by the
3434!! ::read_unit method. The method works both on formatted and
3435!! unformatted files.
3436SUBROUTINE timedelta_vect_write_unit(this, unit)
3437TYPE(timedelta),INTENT(in) :: this(:) !< object to be written
3438INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3439
3440CHARACTER(len=40) :: form
3441CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3442INTEGER :: i
3443
3444ALLOCATE(dateiso(SIZE(this)))
3445DO i = 1, SIZE(dateiso)
3447ENDDO
3448INQUIRE(unit, form=form)
3449IF (form == 'FORMATTED') THEN
3450 WRITE(unit,'(3(A23,1X))')dateiso
3451ELSE
3452 WRITE(unit)dateiso
3453ENDIF
3454DEALLOCATE(dateiso)
3455
3456END SUBROUTINE timedelta_vect_write_unit
3457
3458
3459ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
3460TYPE(timedelta),INTENT(in) :: this
3461LOGICAL :: res
3462
3463res = .not. this == timedelta_miss
3464
3465end FUNCTION c_e_timedelta
3466
3467
3468elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
3469
3470!!omstart JELADATA5
3471! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3472! 1 IMINUTI)
3473!
3474! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
3475!
3476! variabili integer*4
3477! IN:
3478! IDAY,IMONTH,IYEAR, I*4
3479! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3480!
3481! OUT:
3482! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3483!!OMEND
3484
3485INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
3486INTEGER,intent(out) :: iminuti
3487
3488iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
3489
3490END SUBROUTINE jeladata5
3491
3492
3493elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
3494INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
3495INTEGER(KIND=int_ll),intent(out) :: imillisec
3496
3497imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
3498 + imsec
3499
3500END SUBROUTINE jeladata5_1
3501
3502
3503
3504elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
3505
3506!!omstart JELADATA6
3507! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3508! 1 IMINUTI)
3509!
3510! Calcola la data e l'ora corrispondente a IMINUTI dopo il
3511! 1/1/1
3512!
3513! variabili integer*4
3514! IN:
3515! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3516!
3517! OUT:
3518! IDAY,IMONTH,IYEAR, I*4
3519! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3520!!OMEND
3521
3522
3523INTEGER,intent(in) :: iminuti
3524INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
3525
3526INTEGER ::igiorno
3527
3528imin = mod(iminuti,60)
3529ihour = mod(iminuti,1440)/60
3530igiorno = iminuti/1440
3532CALL ndyin(igiorno,iday,imonth,iyear)
3533
3534END SUBROUTINE jeladata6
3535
3536
3537elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
3538INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
3539INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
3540
3541INTEGER :: igiorno
3542
3544!imin = MOD(imillisec/60000_int_ll, 60)
3545!ihour = MOD(imillisec/3600000_int_ll, 24)
3546imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
3547ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
3548igiorno = int(imillisec/86400000_int_ll)
3549!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
3550CALL ndyin(igiorno,iday,imonth,iyear)
3551
3552END SUBROUTINE jeladata6_1
3553
3554
3555elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
3556
3557!!OMSTART NDYIN
3558! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
3559! restituisce la data fornendo in input il numero di
3560! giorni dal 1/1/1
3561!
3562!!omend
3563
3564INTEGER,intent(in) :: ndays
3565INTEGER,intent(out) :: igg, imm, iaa
3566integer :: n,lndays
3567
3568lndays=ndays
3569
3570n = lndays/d400
3571lndays = lndays - n*d400
3572iaa = year0 + n*400
3573n = min(lndays/d100, 3)
3574lndays = lndays - n*d100
3575iaa = iaa + n*100
3576n = lndays/d4
3577lndays = lndays - n*d4
3578iaa = iaa + n*4
3579n = min(lndays/d1, 3)
3580lndays = lndays - n*d1
3581iaa = iaa + n
3582n = bisextilis(iaa)
3583DO imm = 1, 12
3584 IF (lndays < ianno(imm+1,n)) EXIT
3585ENDDO
3586igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
3587
3588END SUBROUTINE ndyin
3589
3590
3591integer elemental FUNCTION ndays(igg,imm,iaa)
3592
3593!!OMSTART NDAYS
3594! FUNCTION NDAYS(IGG,IMM,IAA)
3595! restituisce il numero di giorni dal 1/1/1
3596! fornendo in input la data
3597!
3598!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3599! nota bene E' SICURO !!!
3600! un anno e' bisestile se divisibile per 4
3601! un anno rimane bisestile se divisibile per 400
3602! un anno NON e' bisestile se divisibile per 100
3603!
3604!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3605!
3606!!omend
3607
3608INTEGER, intent(in) :: igg, imm, iaa
3609
3610INTEGER :: lmonth, lyear
3611
3612! Limito il mese a [1-12] e correggo l'anno coerentemente
3613lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
3614lyear = iaa + (imm - lmonth)/12
3615ndays = igg+ianno(lmonth, bisextilis(lyear))
3616ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
3617 (lyear-year0)/400
3618
3619END FUNCTION ndays
3620
3621
3622elemental FUNCTION bisextilis(annum)
3623INTEGER,INTENT(in) :: annum
3624INTEGER :: bisextilis
3625
3627 bisextilis = 2
3628ELSE
3629 bisextilis = 1
3630ENDIF
3631END FUNCTION bisextilis
3632
3633
3634ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
3635TYPE(cyclicdatetime),INTENT(IN) :: this, that
3636LOGICAL :: res
3637
3638res = .true.
3639if (this%minute /= that%minute) res=.false.
3640if (this%hour /= that%hour) res=.false.
3641if (this%day /= that%day) res=.false.
3642if (this%month /= that%month) res=.false.
3643if (this%tendaysp /= that%tendaysp) res=.false.
3644
3645END FUNCTION cyclicdatetime_eq
3646
3647
3648ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
3649TYPE(cyclicdatetime),INTENT(IN) :: this
3650TYPE(datetime),INTENT(IN) :: that
3651LOGICAL :: res
3652
3653integer :: minute,hour,day,month
3654
3656
3657res = .true.
3663 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
3664end if
3665
3666END FUNCTION cyclicdatetime_datetime_eq
3667
3668
3669ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
3670TYPE(datetime),INTENT(IN) :: this
3671TYPE(cyclicdatetime),INTENT(IN) :: that
3672LOGICAL :: res
3673
3674integer :: minute,hour,day,month
3675
3677
3678res = .true.
3683
3685 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
3686end if
3687
3688
3689END FUNCTION datetime_cyclicdatetime_eq
3690
3691ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
3692TYPE(cyclicdatetime),INTENT(in) :: this
3693LOGICAL :: res
3694
3695res = .not. this == cyclicdatetime_miss
3696
3697end FUNCTION c_e_cyclicdatetime
3698
3699
3700!> Costruisce un oggetto \a cyclicdatetime con i parametri opzionali forniti.
3701!! Se non viene passato nulla lo inizializza a missing.
3702FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
3703INTEGER,INTENT(IN),OPTIONAL :: tendaysp !< ten days period in month (1, 2, 3)
3704INTEGER,INTENT(IN),OPTIONAL :: month !< mese, default=missing
3705INTEGER,INTENT(IN),OPTIONAL :: day !< mese, default=missing
3706INTEGER,INTENT(IN),OPTIONAL :: hour !< ore, default=missing
3707INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti, default=missing
3708CHARACTER(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.
3709
3710integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
3711
3712
3713TYPE(cyclicdatetime) :: this !< oggetto da inizializzare
3714
3715if (present(chardate)) then
3716
3717 ltendaysp=imiss
3718 lmonth=imiss
3719 lday=imiss
3720 lhour=imiss
3721 lminute=imiss
3722
3724 ! TMMGGhhmm
3725 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
3726 !print*,chardate(1:1),ios,ltendaysp
3727 if (ios /= 0)ltendaysp=imiss
3728
3729 read(chardate(2:3),'(i2)',iostat=ios)lmonth
3730 !print*,chardate(2:3),ios,lmonth
3731 if (ios /= 0)lmonth=imiss
3732
3733 read(chardate(4:5),'(i2)',iostat=ios)lday
3734 !print*,chardate(4:5),ios,lday
3735 if (ios /= 0)lday=imiss
3736
3737 read(chardate(6:7),'(i2)',iostat=ios)lhour
3738 !print*,chardate(6:7),ios,lhour
3739 if (ios /= 0)lhour=imiss
3740
3741 read(chardate(8:9),'(i2)',iostat=ios)lminute
3742 !print*,chardate(8:9),ios,lminute
3743 if (ios /= 0)lminute=imiss
3744 end if
3745
3746 this%tendaysp=ltendaysp
3747 this%month=lmonth
3748 this%day=lday
3749 this%hour=lhour
3750 this%minute=lminute
3751else
3752 this%tendaysp=optio_l(tendaysp)
3753 this%month=optio_l(month)
3754 this%day=optio_l(day)
3755 this%hour=optio_l(hour)
3756 this%minute=optio_l(minute)
3757end if
3758
3759END FUNCTION cyclicdatetime_new
3760
3761!> Restituisce una rappresentazione carattere stampabile di un oggetto
3762!! \a cyclicdatetime.
3763elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
3764TYPE(cyclicdatetime),INTENT(IN) :: this
3765
3766CHARACTER(len=80) :: char
3767
3770
3771END FUNCTION cyclicdatetime_to_char
3772
3773
3774!> Restituisce una rappresentazione convenzionale in forma datetime
3775!! \a cyclicdatetime.
3776!! The following conventional code values are used to specify which data was taken into account in the computation:
3777!! year=1001 : dayly values of a specified month (depends by day and month)
3778!! year=1002 : dayly,hourly values of a specified month (depends by day and month and hour)
3779!! year=1003 : 10 day period of a specified month (depends by day(1,11,21) and month)
3780!! year=1004 : 10 day period of a specified month,hourly (depends by day(1,11,21) and month and hour)
3781!! year=1005 : mounthly values (depend by month)
3782!! year=1006 : mounthly,hourly values (depend by month and hour)
3783!! year=1007 : yearly values (no other time dependence)
3784!! year=1008 : yearly,hourly values (depend by year and hour)
3785!! 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.
3786FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
3787TYPE(cyclicdatetime),INTENT(IN) :: this !< cycliddatetime to use in compute
3788
3789TYPE(datetime) :: dtc
3790
3791integer :: year,month,day,hour
3792
3793dtc = datetime_miss
3794
3795! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
3797 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
3798 return
3799end if
3800
3801! minute present -> not good for conventional datetime
3803! day, month and tendaysp present -> no good
3805
3807 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
3809 day=(this%tendaysp-1)*10+1
3810 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
3812 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
3814 ! only day present -> no good
3815 return
3816end if
3817
3820 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
3821end if
3822
3823
3824END FUNCTION cyclicdatetime_to_conventional
3825
3826
3827
3828FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
3829TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3830
3831CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
3832
3833char=cyclicdatetime_to_char(in)
3834
3835END FUNCTION trim_cyclicdatetime_to_char
3836
3837
3838
3839SUBROUTINE display_cyclicdatetime(this)
3840TYPE(cyclicdatetime),INTENT(in) :: this
3841
3843
3844end subroutine display_cyclicdatetime
3845
3846
3847#include "array_utilities_inc.F90"
3848
3850
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 |