libsim Versione 7.2.6

◆ timedelta_write_unit()

subroutine timedelta_write_unit ( type(timedelta), intent(in) this,
integer, intent(in) unit )

This method writes on a Fortran file unit the contents of the object this.

The record can successively be read by the read_unit method. The method works both on formatted and unformatted files.

Parametri
[in]thisobject to be written
[in]unitunit where to write, it must be an opened Fortran file unit

Definizione alla linea 2039 del file datetime_class.F90.

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

Generated with Doxygen.