libsim Versione 7.2.6
|
◆ cyclicdatetime_new()
Costruisce un oggetto cyclicdatetime con i parametri opzionali forniti. Se non viene passato nulla lo inizializza a missing.
Definizione alla linea 2318 del file datetime_class.F90. 2319! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2320! authors:
2321! Davide Cesari <dcesari@arpa.emr.it>
2322! Paolo Patruno <ppatruno@arpa.emr.it>
2323
2324! This program is free software; you can redistribute it and/or
2325! modify it under the terms of the GNU General Public License as
2326! published by the Free Software Foundation; either version 2 of
2327! the License, or (at your option) any later version.
2328
2329! This program is distributed in the hope that it will be useful,
2330! but WITHOUT ANY WARRANTY; without even the implied warranty of
2331! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2332! GNU General Public License for more details.
2333
2334! You should have received a copy of the GNU General Public License
2335! along with this program. If not, see <http://www.gnu.org/licenses/>.
2336#include "config.h"
2337!> \brief Classi per la gestione delle coordinate temporali.
2338!!
2339!! Questo module definisce un paio di classi per la gestione di
2340!! date assolute e di intervalli temporali.
2341!! Entrambe le classi hanno le componenti di tipo \c PRIVATE, per
2342!! cui non possono essere manipolate direttamente ma solo tramite i
2343!! relativi metodi. Attualmente la precisione massima consentita � di un
2344!! minuto, mentre l'estensione delle date rappresentabili va dall'anno 1
2345!! all'anno 4074 d.C. circa, ipotizzando un calendario gregoriano per
2346!! tutto il periodo. Questo fatto implica che le date precedenti
2347!! all'introduzione del calendario gregoriano avranno discrepanze di uno
2348!! o pi� giorni rispetto alle date storiche "vere", ammesso che
2349!! qualcuno conosca queste ultime.
2350!! \ingroup base
2358IMPLICIT NONE
2359
2360INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2361
2362!> Class for expressing an absolute time value.
2364 PRIVATE
2365 INTEGER(KIND=int_ll) :: iminuti
2367
2368!> Class for expressing a relative time interval.
2369!! It can take also negative values. According to how it is
2370!! initilasied, it can indicate an interval of fixed duration, or a
2371!! "calendar" interval of variable duration in units of months and/or
2372!! years or even a mix of the two, however, in the latter two cases
2373!! the operations that can be made with objects of this class are
2374!! restricted.
2376 PRIVATE
2377 INTEGER(KIND=int_ll) :: iminuti
2378 INTEGER :: month
2380
2381
2382!> Class for expressing a cyclic datetime.
2383!! It can be used to specify, for example, every January in all years
2384!! or the same time for all days and so on.
2386 PRIVATE
2387 INTEGER :: minute
2388 INTEGER :: hour
2389 INTEGER :: day
2390 INTEGER :: tendaysp
2391 INTEGER :: month
2393
2394
2395!> valore mancante per datetime
2397!> valore mancante per timedelta
2399!> intervallo timedelta di durata nulla
2401!> inizializza con l'ora UTC
2402INTEGER, PARAMETER :: datetime_utc=1
2403!> inizializza con l'ora locale
2404INTEGER, PARAMETER :: datetime_local=2
2405!> Minimum valid value for datetime
2407!> Minimum valid value for datetime
2409!> Minimum valid value for timedelta
2411!> Minimum valid value for timedelta
2413!> missing value for cyclicdatetime
2414TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2415
2416
2417INTEGER(kind=dateint), PARAMETER :: &
2418 sec_in_day=86400, &
2419 sec_in_hour=3600, &
2420 sec_in_min=60, &
2421 min_in_day=1440, &
2422 min_in_hour=60, &
2423 hour_in_day=24
2424
2425INTEGER,PARAMETER :: &
2426 year0=1, & ! anno di origine per iminuti
2427 d1=365, & ! giorni/1 anno nel calendario gregoriano
2428 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2429 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2430 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2431 ianno(13,2)=reshape((/ &
2432 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2433 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2434
2435INTEGER(KIND=int_ll),PARAMETER :: &
2436 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2437
2438!> Costruttori per le classi datetime e timedelta. Devono essere richiamati
2439!! per tutti gli oggetti di questo tipo definiti in un programma
2440!! tranne i casi in cui un oggetto viene creato per assegnazione.
2442 MODULE PROCEDURE datetime_init, timedelta_init
2443END INTERFACE
2444
2445!> Distruttori per le 2 classi. Distruggono gli oggetti in maniera pulita,
2446!! assegnando loro un valore mancante.
2448 MODULE PROCEDURE datetime_delete, timedelta_delete
2449END INTERFACE
2450
2451!> Restituiscono il valore dell'oggetto nella forma desiderata.
2453 MODULE PROCEDURE datetime_getval, timedelta_getval
2454END INTERFACE
2455
2456!> Restituiscono il valore dell'oggetto in forma di stringa stampabile.
2458 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2459END INTERFACE
2460
2461
2462!> Functions that return a trimmed CHARACTER representation of the
2463!! input variable. The functions are analogous to \a to_char but they
2464!! return representation of the input in a CHARACTER with a variable
2465!! length, which needs not to be trimmed before use. The optional
2466!! format here is not accepted and these functions are not \a
2467!! ELEMENTAL so they work only on scalar arguments.
2468!!
2469!! \param in (datetime or timedelta) value to be represented as CHARACTER
2470!!
2471!! Example of use:
2472!! \code
2473!! USE datetime_class
2474!! type(datetime) :: t
2475!! ...
2476!! WRITE(*,*)'The value provided is, '//t2c(t)'
2477!! ...
2478!! \endcode
2480 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2481END INTERFACE
2482
2483!> Operatore logico di uguaglianza tra oggetti della stessa classe.
2484!! Funziona anche per
2485!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2486!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2487!! di 1 dimensione e scalari).
2488INTERFACE OPERATOR (==)
2489 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2490 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2491END INTERFACE
2492
2493!> Operatore logico di disuguaglianza tra oggetti della stessa classe.
2494!! Funziona anche per
2495!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2496!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2497!! di 1 dimensione e scalari).
2498INTERFACE OPERATOR (/=)
2499 MODULE PROCEDURE datetime_ne, timedelta_ne
2500END INTERFACE
2501
2502!> Operatore logico maggiore tra oggetti della stessa classe.
2503!! Funziona anche per
2504!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2505!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2506!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2507!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2508!! \a timedelta "popolari" o misti.
2509INTERFACE OPERATOR (>)
2510 MODULE PROCEDURE datetime_gt, timedelta_gt
2511END INTERFACE
2512
2513!> Operatore logico minore tra oggetti della stessa classe.
2514!! Funziona anche per
2515!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2516!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2517!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2518!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2519!! \a timedelta "popolari" o misti.
2520INTERFACE OPERATOR (<)
2521 MODULE PROCEDURE datetime_lt, timedelta_lt
2522END INTERFACE
2523
2524!> Operatore logico maggiore-uguale tra oggetti della stessa classe.
2525!! Funziona anche per
2526!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2527!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2528!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2529!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2530!! \a timedelta "popolari" o misti.
2531INTERFACE OPERATOR (>=)
2532 MODULE PROCEDURE datetime_ge, timedelta_ge
2533END INTERFACE
2534
2535!> Operatore logico minore-uguale tra oggetti della stessa classe.
2536!! Funziona anche per
2537!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
2538!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con pi�
2539!! di 1 dimensione e scalari). Nel caso di valori mancanti il risultato
2540!! non � specificato. Il risultato non � altres� specificato nel caso di oggetti
2541!! \a timedelta "popolari" o misti.
2542INTERFACE OPERATOR (<=)
2543 MODULE PROCEDURE datetime_le, timedelta_le
2544END INTERFACE
2545
2546!> Operatore di somma per datetime e timedelta. Solo alcune combinazioni
2547!! sono definite:
2548!! - \a timedelta + \a timedelta = \a timedelta
2549!! - \a datetime + \a timedelta = \a datetime
2550!! .
2551!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
2552INTERFACE OPERATOR (+)
2553 MODULE PROCEDURE datetime_add, timedelta_add
2554END INTERFACE
2555
2556!> Operatore di sottrazione per datetime e timedelta. Solo alcune combinazioni
2557!! sono definite:
2558!! - \a timedelta - \a timedelta = \a timedelta
2559!! - \a datetime - \a timedelta = \a datetime
2560!! - \a datetime - \a datetime = \a timedelta
2561!! .
2562!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
2563INTERFACE OPERATOR (-)
2564 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
2565END INTERFACE
2566
2567!> Operatore di moltiplicazione di timedelta per uno scalare. Sono definite:
2568!! - \a timedelta * \a INTEGER = \a timedelta
2569!! - \a INTEGER * \a timedelta = \a timedelta
2570!! .
2571!! Funzionano anche con oggetti \a timedelta "popolari" o misti.
2572INTERFACE OPERATOR (*)
2573 MODULE PROCEDURE timedelta_mult, timedelta_tlum
2574END INTERFACE
2575
2576!> Operatore di divisione di timedelta. Sono definite:
2577!! - \a timedelta / \a INTEGER = \a timedelta
2578!! - \a timedelta / \a timedelta = \a INTEGER
2579!! .
2580!! La prima combinazione � valida per tutti i tipi di intervallo, mentre la
2581!! seconda � definita solo per intervalli "puri".
2582INTERFACE OPERATOR (/)
2583 MODULE PROCEDURE timedelta_divint, timedelta_divtd
2584END INTERFACE
2585
2586!> Operatore di resto della divisione.
2587!! Sono definite le combinazioni:
2588!! - \a MOD(\a timedelta, \a timedelta) = \a timedelta
2589!! - \a MOD(\a datetime, \a timedelta) = \a timedelta.
2590!!
2591!! Sono definite solo per intervalli "puri"
2592!! La seconda combinazione ha senso principalmente con intervalli di
2593!! 1 minuto, 1 ora o
2594!! 1 giorno, per calcolare di quanto l'oggetto \a datetime indicato dista
2595!! dal minuto, ora o giorno tondo precedente pi� vicino.
2597 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
2598END INTERFACE
2599
2600!> Operatore di valore assoluto di un intervallo.
2601!! - \a ABS(\a timedelta) = \a timedelta
2603 MODULE PROCEDURE timedelta_abs
2604END INTERFACE
2605
2606!> Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da
2607!! un file \c FORMATTED o \c UNFORMATTED.
2609 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
2610 timedelta_read_unit, timedelta_vect_read_unit
2611END INTERFACE
2612
2613!> Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su
2614!! un file \c FORMATTED o \c UNFORMATTED.
2616 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
2617 timedelta_write_unit, timedelta_vect_write_unit
2618END INTERFACE
2619
2620!> Print object
2622 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
2623END INTERFACE
2624
2625!> Missing check
2627 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
2628END INTERFACE
2629
2630#undef VOL7D_POLY_TYPE
2631#undef VOL7D_POLY_TYPES
2632#undef ENABLE_SORT
2633#define VOL7D_POLY_TYPE TYPE(datetime)
2634#define VOL7D_POLY_TYPES _datetime
2635#define ENABLE_SORT
2636#include "array_utilities_pre.F90"
2637
2638
2639#define ARRAYOF_ORIGTYPE TYPE(datetime)
2640#define ARRAYOF_TYPE arrayof_datetime
2641#define ARRAYOF_ORIGEQ 1
2642#include "arrayof_pre.F90"
2643! from arrayof
2644
2645PRIVATE
2646
2648 datetime_min, datetime_max, &
2651 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
2652 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
2654 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
2655 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
2657 count_distinct, pack_distinct, &
2658 count_distinct_sorted, pack_distinct_sorted, &
2659 count_and_pack_distinct, &
2661 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
2663PUBLIC insert_unique, append_unique
2664PUBLIC cyclicdatetime_to_conventional
2665
2666CONTAINS
2667
2668
2669! ==============
2670! == datetime ==
2671! ==============
2672
2673!> Initialize a \a datetime object according to the provided arguments
2674!! If no arguments are passed a missing object is created. Notice
2675!! that the optional parameter groups (\a year, \a month, \a hour, \a
2676!! minute, \a msec), (\a unixtime), (\a isodate), (\a simpledate) are
2677!! mutually exclusive, the results are not guaranteed if arguments of
2678!! different groups are present.
2679ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
2680 unixtime, isodate, simpledate) RESULT(this)
2681INTEGER,INTENT(IN),OPTIONAL :: year !< year a.C.; for reasons not yet investigated, only years >0 (a.C.) are allowed
2682INTEGER,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
2683INTEGER,INTENT(IN),OPTIONAL :: day !< day, default=1 if \a year is present, it can have non canonical values too
2684INTEGER,INTENT(IN),OPTIONAL :: hour !< hours, default=0 if \a year is present, it can have non canonical values too
2685INTEGER,INTENT(IN),OPTIONAL :: minute !< minutes, default=0 if \a year is present, it can have non canonical values too
2686INTEGER,INTENT(IN),OPTIONAL :: msec !< milliseconds, default=0 if \a year is present, it can have non canonical values too
2687INTEGER(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
2688CHARACTER(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
2689CHARACTER(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
2690
2691TYPE(datetime) :: this
2692INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2693CHARACTER(len=23) :: datebuf
2694
2695IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
2696 lyear = year
2697 IF (PRESENT(month)) THEN
2698 lmonth = month
2699 ELSE
2700 lmonth = 1
2701 ENDIF
2702 IF (PRESENT(day)) THEN
2703 lday = day
2704 ELSE
2705 lday = 1
2706 ENDIF
2707 IF (PRESENT(hour)) THEN
2708 lhour = hour
2709 ELSE
2710 lhour = 0
2711 ENDIF
2712 IF (PRESENT(minute)) THEN
2713 lminute = minute
2714 ELSE
2715 lminute = 0
2716 ENDIF
2717 IF (PRESENT(msec)) THEN
2718 lmsec = msec
2719 ELSE
2720 lmsec = 0
2721 ENDIF
2722
2725 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2726 else
2727 this=datetime_miss
2728 end if
2729
2730ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
2732 this%iminuti = (unixtime + unsec)*1000
2733 else
2734 this=datetime_miss
2735 end if
2736
2737ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
2738
2740 datebuf(1:23) = '0001-01-01 00:00:00.000'
2741 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
2742 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
2743 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2744 lmsec = lmsec + lsec*1000
2745 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2746 RETURN
2747
2748100 CONTINUE ! condizione di errore in isodate
2750 RETURN
2751 ELSE
2752 this = datetime_miss
2753 ENDIF
2754
2755ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
2757 datebuf(1:17) = '00010101000000000'
2758 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2759 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
2760 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2761 lmsec = lmsec + lsec*1000
2762 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2763 RETURN
2764
2765120 CONTINUE ! condizione di errore in simpledate
2767 RETURN
2768 ELSE
2769 this = datetime_miss
2770 ENDIF
2771
2772ELSE
2773 this = datetime_miss
2774ENDIF
2775
2776END FUNCTION datetime_new
2777
2778
2779!> Initialize a datetime object with the current system time.
2780FUNCTION datetime_new_now(now) RESULT(this)
2781INTEGER,INTENT(IN) :: now !< select the time for initialisation, \a datetime_utc for UTC (preferred) or \a datetime_local for local time
2782TYPE(datetime) :: this
2783
2784INTEGER :: dt(8)
2785
2787 CALL date_and_time(values=dt)
2788 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
2790 msec=dt(7)*1000+dt(8))
2791ELSE
2792 this = datetime_miss
2793ENDIF
2794
2795END FUNCTION datetime_new_now
2796
2797
2798!> Costruisce un oggetto \a datetime con i parametri opzionali forniti.
2799!! Se non viene passato nulla lo inizializza a 1/1/1.
2800!! Notare che i gruppi di parametri opzionali (\a year, \a month, \a hour,
2801!! \a minute, \a msec), (\a unixtime), (\a isodate), (\a simpledate),
2802!! (\a oraclesimdate) sono mutualmente escludentesi; \a oraclesimedate �
2803!! obsoleto, usare piuttosto \a simpledate.
2804SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
2805 unixtime, isodate, simpledate, now)
2806TYPE(datetime),INTENT(INOUT) :: this !< oggetto da inizializzare
2807INTEGER,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.)
2808INTEGER,INTENT(IN),OPTIONAL :: month !< mese, default=1 se � specificato \a year; pu� assumere anche valori <1 o >12, l'oggetto finale si aggiusta coerentemente
2809INTEGER,INTENT(IN),OPTIONAL :: day !< mese, default=1 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2810INTEGER,INTENT(IN),OPTIONAL :: hour !< ore, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2811INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2812INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi, default=0 se � specificato \a year; pu� anch'esso assumere valori fuori dai limiti canonici
2813INTEGER(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)
2814CHARACTER(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
2815CHARACTER(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
2816INTEGER,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
2817
2818IF (PRESENT(now)) THEN
2819 this = datetime_new_now(now)
2820ELSE
2821 this = datetime_new(year, month, day, hour, minute, msec, &
2822 unixtime, isodate, simpledate)
2823ENDIF
2824
2825END SUBROUTINE datetime_init
2826
2827
2828ELEMENTAL SUBROUTINE datetime_delete(this)
2829TYPE(datetime),INTENT(INOUT) :: this
2830
2831this%iminuti = illmiss
2832
2833END SUBROUTINE datetime_delete
2834
2835
2836!> Restituisce il valore di un oggetto \a datetime in una o pi�
2837!! modalit� desiderate. Qualsiasi combinazione dei parametri
2838!! opzionali � consentita. \a oraclesimedate �
2839!! obsoleto, usare piuttosto \a simpledate.
2840PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
2841 unixtime, isodate, simpledate, oraclesimdate)
2842TYPE(datetime),INTENT(IN) :: this !< oggetto di cui restituire il valore
2843INTEGER,INTENT(OUT),OPTIONAL :: year !< anno
2844INTEGER,INTENT(OUT),OPTIONAL :: month !< mese
2845INTEGER,INTENT(OUT),OPTIONAL :: day !< giorno
2846INTEGER,INTENT(OUT),OPTIONAL :: hour !< ore
2847INTEGER,INTENT(OUT),OPTIONAL :: minute !< minuti
2848INTEGER,INTENT(OUT),OPTIONAL :: msec !< millisecondi
2849INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime !< secondi a partire dal 1/1/1970
2850CHARACTER(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
2851CHARACTER(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
2852CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate !< data parziale nel formato \c AAAAMMGGhhmm
2853
2854INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2855CHARACTER(len=23) :: datebuf
2856
2857IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
2858 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
2859 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
2860
2861 IF (this == datetime_miss) THEN
2862
2863 IF (PRESENT(msec)) THEN
2864 msec = imiss
2865 ENDIF
2866 IF (PRESENT(minute)) THEN
2867 minute = imiss
2868 ENDIF
2869 IF (PRESENT(hour)) THEN
2870 hour = imiss
2871 ENDIF
2872 IF (PRESENT(day)) THEN
2873 day = imiss
2874 ENDIF
2875 IF (PRESENT(month)) THEN
2876 month = imiss
2877 ENDIF
2878 IF (PRESENT(year)) THEN
2879 year = imiss
2880 ENDIF
2881 IF (PRESENT(isodate)) THEN
2882 isodate = cmiss
2883 ENDIF
2884 IF (PRESENT(simpledate)) THEN
2885 simpledate = cmiss
2886 ENDIF
2887 IF (PRESENT(oraclesimdate)) THEN
2888!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2889!!$ 'obsoleto, usare piuttosto simpledate')
2890 oraclesimdate=cmiss
2891 ENDIF
2892 IF (PRESENT(unixtime)) THEN
2893 unixtime = illmiss
2894 ENDIF
2895
2896 ELSE
2897
2898 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2899 IF (PRESENT(msec)) THEN
2900 msec = lmsec
2901 ENDIF
2902 IF (PRESENT(minute)) THEN
2903 minute = lminute
2904 ENDIF
2905 IF (PRESENT(hour)) THEN
2906 hour = lhour
2907 ENDIF
2908 IF (PRESENT(day)) THEN
2909 day = lday
2910 ENDIF
2911 IF (PRESENT(month)) THEN
2912 month = lmonth
2913 ENDIF
2914 IF (PRESENT(year)) THEN
2915 year = lyear
2916 ENDIF
2917 IF (PRESENT(isodate)) THEN
2918 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
2919 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
2921 isodate = datebuf(1:min(len(isodate),23))
2922 ENDIF
2923 IF (PRESENT(simpledate)) THEN
2924 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
2925 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
2926 simpledate = datebuf(1:min(len(simpledate),17))
2927 ENDIF
2928 IF (PRESENT(oraclesimdate)) THEN
2929!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2930!!$ 'obsoleto, usare piuttosto simpledate')
2931 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
2932 ENDIF
2933 IF (PRESENT(unixtime)) THEN
2934 unixtime = this%iminuti/1000_int_ll-unsec
2935 ENDIF
2936
2937 ENDIF
2938ENDIF
2939
2940END SUBROUTINE datetime_getval
2941
2942
2943!> Restituisce una rappresentazione carattere stampabile di un oggetto
2944!! \a datetime.
2945elemental FUNCTION datetime_to_char(this) RESULT(char)
2946TYPE(datetime),INTENT(IN) :: this
2947
2948CHARACTER(len=23) :: char
2949
2951
2952END FUNCTION datetime_to_char
2953
2954
2955FUNCTION trim_datetime_to_char(in) RESULT(char)
2956TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
2957
2958CHARACTER(len=len_trim(datetime_to_char(in))) :: char
2959
2960char=datetime_to_char(in)
2961
2962END FUNCTION trim_datetime_to_char
2963
2964
2965
2966SUBROUTINE display_datetime(this)
2967TYPE(datetime),INTENT(in) :: this
2968
2970
2971end subroutine display_datetime
2972
2973
2974
2975SUBROUTINE display_timedelta(this)
2976TYPE(timedelta),INTENT(in) :: this
2977
2979
2980end subroutine display_timedelta
2981
2982
2983
2984ELEMENTAL FUNCTION c_e_datetime(this) result (res)
2985TYPE(datetime),INTENT(in) :: this
2986LOGICAL :: res
2987
2988res = .not. this == datetime_miss
2989
2990end FUNCTION c_e_datetime
2991
2992
2993ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
2994TYPE(datetime),INTENT(IN) :: this, that
2995LOGICAL :: res
2996
2997res = this%iminuti == that%iminuti
2998
2999END FUNCTION datetime_eq
3000
3001
3002ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3003TYPE(datetime),INTENT(IN) :: this, that
3004LOGICAL :: res
3005
3006res = .NOT.(this == that)
3007
3008END FUNCTION datetime_ne
3009
3010
3011ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3012TYPE(datetime),INTENT(IN) :: this, that
3013LOGICAL :: res
3014
3015res = this%iminuti > that%iminuti
3016
3017END FUNCTION datetime_gt
3018
3019
3020ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3021TYPE(datetime),INTENT(IN) :: this, that
3022LOGICAL :: res
3023
3024res = this%iminuti < that%iminuti
3025
3026END FUNCTION datetime_lt
3027
3028
3029ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3030TYPE(datetime),INTENT(IN) :: this, that
3031LOGICAL :: res
3032
3033IF (this == that) THEN
3034 res = .true.
3035ELSE IF (this > that) THEN
3036 res = .true.
3037ELSE
3038 res = .false.
3039ENDIF
3040
3041END FUNCTION datetime_ge
3042
3043
3044ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3045TYPE(datetime),INTENT(IN) :: this, that
3046LOGICAL :: res
3047
3048IF (this == that) THEN
3049 res = .true.
3050ELSE IF (this < that) THEN
3051 res = .true.
3052ELSE
3053 res = .false.
3054ENDIF
3055
3056END FUNCTION datetime_le
3057
3058
3059FUNCTION datetime_add(this, that) RESULT(res)
3060TYPE(datetime),INTENT(IN) :: this
3061TYPE(timedelta),INTENT(IN) :: that
3062TYPE(datetime) :: res
3063
3064INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3065
3066IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3067 res = datetime_miss
3068ELSE
3069 res%iminuti = this%iminuti + that%iminuti
3070 IF (that%month /= 0) THEN
3072 minute=lminute, msec=lmsec)
3074 hour=lhour, minute=lminute, msec=lmsec)
3075 ENDIF
3076ENDIF
3077
3078END FUNCTION datetime_add
3079
3080
3081ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3082TYPE(datetime),INTENT(IN) :: this, that
3083TYPE(timedelta) :: res
3084
3085IF (this == datetime_miss .OR. that == datetime_miss) THEN
3086 res = timedelta_miss
3087ELSE
3088 res%iminuti = this%iminuti - that%iminuti
3089 res%month = 0
3090ENDIF
3091
3092END FUNCTION datetime_subdt
3093
3094
3095FUNCTION datetime_subtd(this, that) RESULT(res)
3096TYPE(datetime),INTENT(IN) :: this
3097TYPE(timedelta),INTENT(IN) :: that
3098TYPE(datetime) :: res
3099
3100INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3101
3102IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3103 res = datetime_miss
3104ELSE
3105 res%iminuti = this%iminuti - that%iminuti
3106 IF (that%month /= 0) THEN
3108 minute=lminute, msec=lmsec)
3110 hour=lhour, minute=lminute, msec=lmsec)
3111 ENDIF
3112ENDIF
3113
3114END FUNCTION datetime_subtd
3115
3116
3117!> This method reads from a Fortran file unit the contents of the
3118!! object \a this. The record to be read must have been written with
3119!! the ::write_unit method. The method works both on formatted and
3120!! unformatted files.
3121SUBROUTINE datetime_read_unit(this, unit)
3122TYPE(datetime),INTENT(out) :: this !< object to be read
3123INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3124CALL datetime_vect_read_unit((/this/), unit)
3125
3126END SUBROUTINE datetime_read_unit
3127
3128
3129!> This method reads from a Fortran file unit the contents of the
3130!! object \a this. The record to be read must have been written with
3131!! the ::write_unit method. The method works both on formatted and
3132!! unformatted files.
3133SUBROUTINE datetime_vect_read_unit(this, unit)
3134TYPE(datetime) :: this(:) !< object to be read
3135INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3136
3137CHARACTER(len=40) :: form
3138CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3139INTEGER :: i
3140
3141ALLOCATE(dateiso(SIZE(this)))
3142INQUIRE(unit, form=form)
3143IF (form == 'FORMATTED') THEN
3144 READ(unit,'(A23,1X)')dateiso
3145ELSE
3146 READ(unit)dateiso
3147ENDIF
3148DO i = 1, SIZE(dateiso)
3150ENDDO
3151DEALLOCATE(dateiso)
3152
3153END SUBROUTINE datetime_vect_read_unit
3154
3155
3156!> This method writes on a Fortran file unit the contents of the
3157!! object \a this. The record can successively be read by the
3158!! ::read_unit method. The method works both on formatted and
3159!! unformatted files.
3160SUBROUTINE datetime_write_unit(this, unit)
3161TYPE(datetime),INTENT(in) :: this !< object to be written
3162INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3163
3164CALL datetime_vect_write_unit((/this/), unit)
3165
3166END SUBROUTINE datetime_write_unit
3167
3168
3169!> This method writes on a Fortran file unit the contents of the
3170!! object \a this. The record can successively be read by the
3171!! ::read_unit method. The method works both on formatted and
3172!! unformatted files.
3173SUBROUTINE datetime_vect_write_unit(this, unit)
3174TYPE(datetime),INTENT(in) :: this(:) !< object to be written
3175INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3176
3177CHARACTER(len=40) :: form
3178CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3179INTEGER :: i
3180
3181ALLOCATE(dateiso(SIZE(this)))
3182DO i = 1, SIZE(dateiso)
3184ENDDO
3185INQUIRE(unit, form=form)
3186IF (form == 'FORMATTED') THEN
3187 WRITE(unit,'(A23,1X)')dateiso
3188ELSE
3189 WRITE(unit)dateiso
3190ENDIF
3191DEALLOCATE(dateiso)
3192
3193END SUBROUTINE datetime_vect_write_unit
3194
3195
3196#include "arrayof_post.F90"
3197
3198
3199! ===============
3200! == timedelta ==
3201! ===============
3202!> Costruisce un oggetto \a timedelta con i parametri opzionali forniti.
3203!! Se non viene passato nulla lo inizializza a intervallo di durata nulla.
3204!! L'intervallo ottenuto � pari alla somma dei valori di tutti i parametri
3205!! forniti, ovviamente non fornire un parametro equivale a fornirlo =0.
3206!! Questa � la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
3207!! rispetto alla versione \c SUBROUTINE \c init.
3208FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3209 isodate, simpledate, oraclesimdate) RESULT (this)
3210INTEGER,INTENT(IN),OPTIONAL :: year !< anni, se presente l'oggetto diventa "popolare"
3211INTEGER,INTENT(IN),OPTIONAL :: month !< mesi, se presente l'oggetto diventa "popolare"
3212INTEGER,INTENT(IN),OPTIONAL :: day !< giorni
3213INTEGER,INTENT(IN),OPTIONAL :: hour !< ore
3214INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti
3215INTEGER,INTENT(IN),OPTIONAL :: sec !< secondi
3216INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi
3217CHARACTER(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
3218CHARACTER(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
3219CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmm, ignorando tutti gli altri parametri
3220
3221TYPE(timedelta) :: this !< oggetto da inizializzare
3222
3223CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3224 isodate, simpledate, oraclesimdate)
3225
3226END FUNCTION timedelta_new
3227
3228
3229!> Costruisce un oggetto \a timedelta con i parametri opzionali forniti.
3230!! Se non viene passato nulla lo inizializza a intervallo di durata nulla.
3231!! L'intervallo ottenuto � pari alla somma dei valori di tutti i parametri
3232!! forniti, ovviamente non fornire un parametro equivale a fornirlo =0.
3233SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3234 isodate, simpledate, oraclesimdate)
3235TYPE(timedelta),INTENT(INOUT) :: this !< oggetto da inizializzare
3236INTEGER,INTENT(IN),OPTIONAL :: year !< anni, se presente l'oggetto diventa "popolare"
3237INTEGER,INTENT(IN),OPTIONAL :: month !< mesi, se presente l'oggetto diventa "popolare"
3238INTEGER,INTENT(IN),OPTIONAL :: day !< giorni
3239INTEGER,INTENT(IN),OPTIONAL :: hour !< ore
3240INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti
3241INTEGER,INTENT(IN),OPTIONAL :: sec !< secondi
3242INTEGER,INTENT(IN),OPTIONAL :: msec !< millisecondi
3243CHARACTER(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"
3244CHARACTER(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
3245CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate !< inizializza l'oggetto ad un intervallo nel formato \c GGGGGGGGhhmm, ignorando tutti gli altri parametri
3246
3247INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3248CHARACTER(len=23) :: datebuf
3249
3250this%month = 0
3251
3252IF (PRESENT(isodate)) THEN
3253 datebuf(1:23) = '0000000000 00:00:00.000'
3254 l = len_trim(isodate)
3255! IF (l > 0) THEN
3257 IF (n > 0) THEN
3258 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3259 datebuf(12-n:12-n+l-1) = isodate(:l)
3260 ELSE
3261 datebuf(1:l) = isodate(1:l)
3262 ENDIF
3263! ENDIF
3264
3265! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3266 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3267 h, m, s, ms
3268 this%month = lmonth + 12*lyear
3269 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3270 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3271 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3272 RETURN
3273
3274200 CONTINUE ! condizione di errore in isodate
3276 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3277 CALL raise_error()
3278
3279ELSE IF (PRESENT(simpledate)) THEN
3280 datebuf(1:17) = '00000000000000000'
3281 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3282 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3283 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3284 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3285 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3286
3287220 CONTINUE ! condizione di errore in simpledate
3289 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3290 CALL raise_error()
3291 RETURN
3292
3293ELSE IF (PRESENT(oraclesimdate)) THEN
3294 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3295 'obsoleto, usare piuttosto simpledate')
3296 READ(oraclesimdate, '(I8,2I2)')d, h, m
3297 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3298 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3299
3300ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3301 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3302 .and. .not. present(msec) .and. .not. present(isodate) &
3303 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3304
3305 this=timedelta_miss
3306
3307ELSE
3308 this%iminuti = 0
3309 IF (PRESENT(year)) THEN
3311 this%month = this%month + year*12
3312 else
3313 this=timedelta_miss
3314 return
3315 end if
3316 ENDIF
3317 IF (PRESENT(month)) THEN
3319 this%month = this%month + month
3320 else
3321 this=timedelta_miss
3322 return
3323 end if
3324 ENDIF
3325 IF (PRESENT(day)) THEN
3327 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3328 else
3329 this=timedelta_miss
3330 return
3331 end if
3332 ENDIF
3333 IF (PRESENT(hour)) THEN
3335 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3336 else
3337 this=timedelta_miss
3338 return
3339 end if
3340 ENDIF
3341 IF (PRESENT(minute)) THEN
3343 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3344 else
3345 this=timedelta_miss
3346 return
3347 end if
3348 ENDIF
3349 IF (PRESENT(sec)) THEN
3351 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3352 else
3353 this=timedelta_miss
3354 return
3355 end if
3356 ENDIF
3357 IF (PRESENT(msec)) THEN
3359 this%iminuti = this%iminuti + msec
3360 else
3361 this=timedelta_miss
3362 return
3363 end if
3364 ENDIF
3365ENDIF
3366
3367
3368
3369
3370END SUBROUTINE timedelta_init
3371
3372
3373SUBROUTINE timedelta_delete(this)
3374TYPE(timedelta),INTENT(INOUT) :: this
3375
3376this%iminuti = imiss
3377this%month = 0
3378
3379END SUBROUTINE timedelta_delete
3380
3381
3382!> Restituisce il valore di un oggetto \a timedelta in una o pi�
3383!! modalit� desiderate. Qualsiasi combinazione dei parametri
3384!! opzionali � consentita. \a oraclesimedate �
3385!! obsoleto, usare piuttosto \a simpledate.
3386PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3387 day, hour, minute, sec, msec, &
3388 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3389TYPE(timedelta),INTENT(IN) :: this !< oggetto di cui restituire il valore
3390INTEGER,INTENT(OUT),OPTIONAL :: year !< anni, /=0 solo per intervalli "popolari"
3391INTEGER,INTENT(OUT),OPTIONAL :: month !< mesi modulo 12, /=0 solo per intervalli "popolari"
3392INTEGER,INTENT(OUT),OPTIONAL :: amonth !< mesi totali, /=0 solo per intervalli "popolari"
3393INTEGER,INTENT(OUT),OPTIONAL :: day !< giorni totali
3394INTEGER,INTENT(OUT),OPTIONAL :: hour !< ore modulo 24
3395INTEGER,INTENT(OUT),OPTIONAL :: minute !< minuti modulo 60
3396INTEGER,INTENT(OUT),OPTIONAL :: sec !< secondi modulo 60
3397INTEGER,INTENT(OUT),OPTIONAL :: msec !< millisecondi modulo 1000
3398INTEGER,INTENT(OUT),OPTIONAL :: ahour !< ore totali
3399INTEGER,INTENT(OUT),OPTIONAL :: aminute !< minuti totali
3400INTEGER,INTENT(OUT),OPTIONAL :: asec !< secondi totali
3401INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec !< millisecondi totali
3402CHARACTER(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
3403CHARACTER(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
3404CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate !< intervallo totale nel formato \c GGGGGGGGhhmm
3405
3406CHARACTER(len=23) :: datebuf
3407
3408IF (PRESENT(amsec)) THEN
3409 amsec = this%iminuti
3410ENDIF
3411IF (PRESENT(asec)) THEN
3412 asec = int(this%iminuti/1000_int_ll)
3413ENDIF
3414IF (PRESENT(aminute)) THEN
3415 aminute = int(this%iminuti/60000_int_ll)
3416ENDIF
3417IF (PRESENT(ahour)) THEN
3418 ahour = int(this%iminuti/3600000_int_ll)
3419ENDIF
3420IF (PRESENT(msec)) THEN
3421 msec = int(mod(this%iminuti, 1000_int_ll))
3422ENDIF
3423IF (PRESENT(sec)) THEN
3424 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3425ENDIF
3426IF (PRESENT(minute)) THEN
3427 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3428ENDIF
3429IF (PRESENT(hour)) THEN
3430 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3431ENDIF
3432IF (PRESENT(day)) THEN
3433 day = int(this%iminuti/86400000_int_ll)
3434ENDIF
3435IF (PRESENT(amonth)) THEN
3436 amonth = this%month
3437ENDIF
3438IF (PRESENT(month)) THEN
3439 month = mod(this%month-1,12)+1
3440ENDIF
3441IF (PRESENT(year)) THEN
3442 year = this%month/12
3443ENDIF
3444IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3445 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3449 isodate = datebuf(1:min(len(isodate),23))
3450
3451ENDIF
3452IF (PRESENT(simpledate)) THEN
3453 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3454 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3456 mod(this%iminuti, 1000_int_ll)
3457 simpledate = datebuf(1:min(len(simpledate),17))
3458ENDIF
3459IF (PRESENT(oraclesimdate)) THEN
3460!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3461!!$ 'obsoleto, usare piuttosto simpledate')
3462 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3464ENDIF
3465
3466END SUBROUTINE timedelta_getval
3467
3468
3469!> Restituisce una rappresentazione carattere stampabile di un oggetto
3470!! \a timedelta.
3471elemental FUNCTION timedelta_to_char(this) RESULT(char)
3472TYPE(timedelta),INTENT(IN) :: this
3473
3474CHARACTER(len=23) :: char
3475
3477
3478END FUNCTION timedelta_to_char
3479
3480
3481FUNCTION trim_timedelta_to_char(in) RESULT(char)
3482TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3483
3484CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3485
3486char=timedelta_to_char(in)
3487
3488END FUNCTION trim_timedelta_to_char
3489
3490
3491!> Restituisce il valore in millisecondi totali di un oggetto \a timedelta.
3492elemental FUNCTION timedelta_getamsec(this)
3493TYPE(timedelta),INTENT(IN) :: this !< oggetto di cui restituire il valore
3494INTEGER(kind=int_ll) :: timedelta_getamsec !< millisecondi totali
3495
3496timedelta_getamsec = this%iminuti
3497
3498END FUNCTION timedelta_getamsec
3499
3500
3501!> Depopularize a \a timedelta object.
3502!! If the object represents a "popular" or mixed interval, a fixed
3503!! interval representation is returned, by recomputing it on a
3504!! standard period (starting from 1970-01-01); if it represents
3505!! already a fixed interval, the same object is returned.
3506FUNCTION timedelta_depop(this)
3507TYPE(timedelta),INTENT(IN) :: this !< object to be depopularized
3508TYPE(timedelta) :: timedelta_depop
3509
3510TYPE(datetime) :: tmpdt
3511
3512IF (this%month == 0) THEN
3513 timedelta_depop = this
3514ELSE
3515 tmpdt = datetime_new(1970, 1, 1)
3516 timedelta_depop = (tmpdt + this) - tmpdt
3517ENDIF
3518
3519END FUNCTION timedelta_depop
3520
3521
3522elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3523TYPE(timedelta),INTENT(IN) :: this, that
3524LOGICAL :: res
3525
3526res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3527
3528END FUNCTION timedelta_eq
3529
3530
3531ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3532TYPE(timedelta),INTENT(IN) :: this, that
3533LOGICAL :: res
3534
3535res = .NOT.(this == that)
3536
3537END FUNCTION timedelta_ne
3538
3539
3540ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
3541TYPE(timedelta),INTENT(IN) :: this, that
3542LOGICAL :: res
3543
3544res = this%iminuti > that%iminuti
3545
3546END FUNCTION timedelta_gt
3547
3548
3549ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
3550TYPE(timedelta),INTENT(IN) :: this, that
3551LOGICAL :: res
3552
3553res = this%iminuti < that%iminuti
3554
3555END FUNCTION timedelta_lt
3556
3557
3558ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
3559TYPE(timedelta),INTENT(IN) :: this, that
3560LOGICAL :: res
3561
3562IF (this == that) THEN
3563 res = .true.
3564ELSE IF (this > that) THEN
3565 res = .true.
3566ELSE
3567 res = .false.
3568ENDIF
3569
3570END FUNCTION timedelta_ge
3571
3572
3573elemental FUNCTION timedelta_le(this, that) RESULT(res)
3574TYPE(timedelta),INTENT(IN) :: this, that
3575LOGICAL :: res
3576
3577IF (this == that) THEN
3578 res = .true.
3579ELSE IF (this < that) THEN
3580 res = .true.
3581ELSE
3582 res = .false.
3583ENDIF
3584
3585END FUNCTION timedelta_le
3586
3587
3588ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
3589TYPE(timedelta),INTENT(IN) :: this, that
3590TYPE(timedelta) :: res
3591
3592res%iminuti = this%iminuti + that%iminuti
3593res%month = this%month + that%month
3594
3595END FUNCTION timedelta_add
3596
3597
3598ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
3599TYPE(timedelta),INTENT(IN) :: this, that
3600TYPE(timedelta) :: res
3601
3602res%iminuti = this%iminuti - that%iminuti
3603res%month = this%month - that%month
3604
3605END FUNCTION timedelta_sub
3606
3607
3608ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
3609TYPE(timedelta),INTENT(IN) :: this
3610INTEGER,INTENT(IN) :: n
3611TYPE(timedelta) :: res
3612
3613res%iminuti = this%iminuti*n
3614res%month = this%month*n
3615
3616END FUNCTION timedelta_mult
3617
3618
3619ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
3620INTEGER,INTENT(IN) :: n
3621TYPE(timedelta),INTENT(IN) :: this
3622TYPE(timedelta) :: res
3623
3624res%iminuti = this%iminuti*n
3625res%month = this%month*n
3626
3627END FUNCTION timedelta_tlum
3628
3629
3630ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
3631TYPE(timedelta),INTENT(IN) :: this
3632INTEGER,INTENT(IN) :: n
3633TYPE(timedelta) :: res
3634
3635res%iminuti = this%iminuti/n
3636res%month = this%month/n
3637
3638END FUNCTION timedelta_divint
3639
3640
3641ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
3642TYPE(timedelta),INTENT(IN) :: this, that
3643INTEGER :: res
3644
3645res = int(this%iminuti/that%iminuti)
3646
3647END FUNCTION timedelta_divtd
3648
3649
3650elemental FUNCTION timedelta_mod(this, that) RESULT(res)
3651TYPE(timedelta),INTENT(IN) :: this, that
3652TYPE(timedelta) :: res
3653
3654res%iminuti = mod(this%iminuti, that%iminuti)
3655res%month = 0
3656
3657END FUNCTION timedelta_mod
3658
3659
3660ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
3661TYPE(datetime),INTENT(IN) :: this
3662TYPE(timedelta),INTENT(IN) :: that
3663TYPE(timedelta) :: res
3664
3665IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
3666 res = timedelta_0
3667ELSE
3668 res%iminuti = mod(this%iminuti, that%iminuti)
3669 res%month = 0
3670ENDIF
3671
3672END FUNCTION datetime_timedelta_mod
3673
3674
3675ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
3676TYPE(timedelta),INTENT(IN) :: this
3677TYPE(timedelta) :: res
3678
3679res%iminuti = abs(this%iminuti)
3680res%month = abs(this%month)
3681
3682END FUNCTION timedelta_abs
3683
3684
3685!> This method reads from a Fortran file unit the contents of the
3686!! object \a this. The record to be read must have been written with
3687!! the ::write_unit method. The method works both on formatted and
3688!! unformatted files.
3689SUBROUTINE timedelta_read_unit(this, unit)
3690TYPE(timedelta),INTENT(out) :: this !< object to be read
3691INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3692
3693CALL timedelta_vect_read_unit((/this/), unit)
3694
3695END SUBROUTINE timedelta_read_unit
3696
3697
3698!> This method reads from a Fortran file unit the contents of the
3699!! object \a this. The record to be read must have been written with
3700!! the ::write_unit method. The method works both on formatted and
3701!! unformatted files.
3702SUBROUTINE timedelta_vect_read_unit(this, unit)
3703TYPE(timedelta) :: this(:) !< object to be read
3704INTEGER, INTENT(in) :: unit !< unit from which to read, it must be an opened Fortran file unit
3705
3706CHARACTER(len=40) :: form
3707CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3708INTEGER :: i
3709
3710ALLOCATE(dateiso(SIZE(this)))
3711INQUIRE(unit, form=form)
3712IF (form == 'FORMATTED') THEN
3713 READ(unit,'(3(A23,1X))')dateiso
3714ELSE
3715 READ(unit)dateiso
3716ENDIF
3717DO i = 1, SIZE(dateiso)
3719ENDDO
3720DEALLOCATE(dateiso)
3721
3722END SUBROUTINE timedelta_vect_read_unit
3723
3724
3725!> This method writes on a Fortran file unit the contents of the
3726!! object \a this. The record can successively be read by the
3727!! ::read_unit method. The method works both on formatted and
3728!! unformatted files.
3729SUBROUTINE timedelta_write_unit(this, unit)
3730TYPE(timedelta),INTENT(in) :: this !< object to be written
3731INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3732
3733CALL timedelta_vect_write_unit((/this/), unit)
3734
3735END SUBROUTINE timedelta_write_unit
3736
3737
3738!> This method writes on a Fortran file unit the contents of the
3739!! object \a this. The record can successively be read by the
3740!! ::read_unit method. The method works both on formatted and
3741!! unformatted files.
3742SUBROUTINE timedelta_vect_write_unit(this, unit)
3743TYPE(timedelta),INTENT(in) :: this(:) !< object to be written
3744INTEGER, INTENT(in) :: unit !< unit where to write, it must be an opened Fortran file unit
3745
3746CHARACTER(len=40) :: form
3747CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3748INTEGER :: i
3749
3750ALLOCATE(dateiso(SIZE(this)))
3751DO i = 1, SIZE(dateiso)
3753ENDDO
3754INQUIRE(unit, form=form)
3755IF (form == 'FORMATTED') THEN
3756 WRITE(unit,'(3(A23,1X))')dateiso
3757ELSE
3758 WRITE(unit)dateiso
3759ENDIF
3760DEALLOCATE(dateiso)
3761
3762END SUBROUTINE timedelta_vect_write_unit
3763
3764
3765ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
3766TYPE(timedelta),INTENT(in) :: this
3767LOGICAL :: res
3768
3769res = .not. this == timedelta_miss
3770
3771end FUNCTION c_e_timedelta
3772
3773
3774elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
3775
3776!!omstart JELADATA5
3777! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3778! 1 IMINUTI)
3779!
3780! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
3781!
3782! variabili integer*4
3783! IN:
3784! IDAY,IMONTH,IYEAR, I*4
3785! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3786!
3787! OUT:
3788! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3789!!OMEND
3790
3791INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
3792INTEGER,intent(out) :: iminuti
3793
3794iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
3795
3796END SUBROUTINE jeladata5
3797
3798
3799elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
3800INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
3801INTEGER(KIND=int_ll),intent(out) :: imillisec
3802
3803imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
3804 + imsec
3805
3806END SUBROUTINE jeladata5_1
3807
3808
3809
3810elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
3811
3812!!omstart JELADATA6
3813! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3814! 1 IMINUTI)
3815!
3816! Calcola la data e l'ora corrispondente a IMINUTI dopo il
3817! 1/1/1
3818!
3819! variabili integer*4
3820! IN:
3821! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3822!
3823! OUT:
3824! IDAY,IMONTH,IYEAR, I*4
3825! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3826!!OMEND
3827
3828
3829INTEGER,intent(in) :: iminuti
3830INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
3831
3832INTEGER ::igiorno
3833
3834imin = mod(iminuti,60)
3835ihour = mod(iminuti,1440)/60
3836igiorno = iminuti/1440
3838CALL ndyin(igiorno,iday,imonth,iyear)
3839
3840END SUBROUTINE jeladata6
3841
3842
3843elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
3844INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
3845INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
3846
3847INTEGER :: igiorno
3848
3850!imin = MOD(imillisec/60000_int_ll, 60)
3851!ihour = MOD(imillisec/3600000_int_ll, 24)
3852imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
3853ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
3854igiorno = int(imillisec/86400000_int_ll)
3855!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
3856CALL ndyin(igiorno,iday,imonth,iyear)
3857
3858END SUBROUTINE jeladata6_1
3859
3860
3861elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
3862
3863!!OMSTART NDYIN
3864! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
3865! restituisce la data fornendo in input il numero di
3866! giorni dal 1/1/1
3867!
3868!!omend
3869
3870INTEGER,intent(in) :: ndays
3871INTEGER,intent(out) :: igg, imm, iaa
3872integer :: n,lndays
3873
3874lndays=ndays
3875
3876n = lndays/d400
3877lndays = lndays - n*d400
3878iaa = year0 + n*400
3879n = min(lndays/d100, 3)
3880lndays = lndays - n*d100
3881iaa = iaa + n*100
3882n = lndays/d4
3883lndays = lndays - n*d4
3884iaa = iaa + n*4
3885n = min(lndays/d1, 3)
3886lndays = lndays - n*d1
3887iaa = iaa + n
3888n = bisextilis(iaa)
3889DO imm = 1, 12
3890 IF (lndays < ianno(imm+1,n)) EXIT
3891ENDDO
3892igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
3893
3894END SUBROUTINE ndyin
3895
3896
3897integer elemental FUNCTION ndays(igg,imm,iaa)
3898
3899!!OMSTART NDAYS
3900! FUNCTION NDAYS(IGG,IMM,IAA)
3901! restituisce il numero di giorni dal 1/1/1
3902! fornendo in input la data
3903!
3904!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3905! nota bene E' SICURO !!!
3906! un anno e' bisestile se divisibile per 4
3907! un anno rimane bisestile se divisibile per 400
3908! un anno NON e' bisestile se divisibile per 100
3909!
3910!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3911!
3912!!omend
3913
3914INTEGER, intent(in) :: igg, imm, iaa
3915
3916INTEGER :: lmonth, lyear
3917
3918! Limito il mese a [1-12] e correggo l'anno coerentemente
3919lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
3920lyear = iaa + (imm - lmonth)/12
3921ndays = igg+ianno(lmonth, bisextilis(lyear))
3922ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
3923 (lyear-year0)/400
3924
3925END FUNCTION ndays
3926
3927
3928elemental FUNCTION bisextilis(annum)
3929INTEGER,INTENT(in) :: annum
3930INTEGER :: bisextilis
3931
3933 bisextilis = 2
3934ELSE
3935 bisextilis = 1
3936ENDIF
3937END FUNCTION bisextilis
3938
3939
3940ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
3941TYPE(cyclicdatetime),INTENT(IN) :: this, that
3942LOGICAL :: res
3943
3944res = .true.
3945if (this%minute /= that%minute) res=.false.
3946if (this%hour /= that%hour) res=.false.
3947if (this%day /= that%day) res=.false.
3948if (this%month /= that%month) res=.false.
3949if (this%tendaysp /= that%tendaysp) res=.false.
3950
3951END FUNCTION cyclicdatetime_eq
3952
3953
3954ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
3955TYPE(cyclicdatetime),INTENT(IN) :: this
3956TYPE(datetime),INTENT(IN) :: that
3957LOGICAL :: res
3958
3959integer :: minute,hour,day,month
3960
3962
3963res = .true.
3969 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
3970end if
3971
3972END FUNCTION cyclicdatetime_datetime_eq
3973
3974
3975ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
3976TYPE(datetime),INTENT(IN) :: this
3977TYPE(cyclicdatetime),INTENT(IN) :: that
3978LOGICAL :: res
3979
3980integer :: minute,hour,day,month
3981
3983
3984res = .true.
3989
3991 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
3992end if
3993
3994
3995END FUNCTION datetime_cyclicdatetime_eq
3996
3997ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
3998TYPE(cyclicdatetime),INTENT(in) :: this
3999LOGICAL :: res
4000
4001res = .not. this == cyclicdatetime_miss
4002
4003end FUNCTION c_e_cyclicdatetime
4004
4005
4006!> Costruisce un oggetto \a cyclicdatetime con i parametri opzionali forniti.
4007!! Se non viene passato nulla lo inizializza a missing.
4008FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4009INTEGER,INTENT(IN),OPTIONAL :: tendaysp !< ten days period in month (1, 2, 3)
4010INTEGER,INTENT(IN),OPTIONAL :: month !< mese, default=missing
4011INTEGER,INTENT(IN),OPTIONAL :: day !< mese, default=missing
4012INTEGER,INTENT(IN),OPTIONAL :: hour !< ore, default=missing
4013INTEGER,INTENT(IN),OPTIONAL :: minute !< minuti, default=missing
4014CHARACTER(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.
4015
4016integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4017
4018
4019TYPE(cyclicdatetime) :: this !< oggetto da inizializzare
4020
4021if (present(chardate)) then
4022
4023 ltendaysp=imiss
4024 lmonth=imiss
4025 lday=imiss
4026 lhour=imiss
4027 lminute=imiss
4028
4030 ! TMMGGhhmm
4031 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4032 !print*,chardate(1:1),ios,ltendaysp
4033 if (ios /= 0)ltendaysp=imiss
4034
4035 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4036 !print*,chardate(2:3),ios,lmonth
4037 if (ios /= 0)lmonth=imiss
4038
4039 read(chardate(4:5),'(i2)',iostat=ios)lday
4040 !print*,chardate(4:5),ios,lday
4041 if (ios /= 0)lday=imiss
4042
4043 read(chardate(6:7),'(i2)',iostat=ios)lhour
4044 !print*,chardate(6:7),ios,lhour
4045 if (ios /= 0)lhour=imiss
4046
4047 read(chardate(8:9),'(i2)',iostat=ios)lminute
4048 !print*,chardate(8:9),ios,lminute
4049 if (ios /= 0)lminute=imiss
4050 end if
4051
4052 this%tendaysp=ltendaysp
4053 this%month=lmonth
4054 this%day=lday
4055 this%hour=lhour
4056 this%minute=lminute
4057else
4058 this%tendaysp=optio_l(tendaysp)
4059 this%month=optio_l(month)
4060 this%day=optio_l(day)
4061 this%hour=optio_l(hour)
4062 this%minute=optio_l(minute)
4063end if
4064
4065END FUNCTION cyclicdatetime_new
4066
4067!> Restituisce una rappresentazione carattere stampabile di un oggetto
4068!! \a cyclicdatetime.
4069elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4070TYPE(cyclicdatetime),INTENT(IN) :: this
4071
4072CHARACTER(len=80) :: char
4073
4076
4077END FUNCTION cyclicdatetime_to_char
4078
4079
4080!> Restituisce una rappresentazione convenzionale in forma datetime
4081!! \a cyclicdatetime.
4082!! The following conventional code values are used to specify which data was taken into account in the computation:
4083!! year=1001 : dayly values of a specified month (depends by day and month)
4084!! year=1002 : dayly,hourly values of a specified month (depends by day and month and hour)
4085!! year=1003 : 10 day period of a specified month (depends by day(1,11,21) and month)
4086!! year=1004 : 10 day period of a specified month,hourly (depends by day(1,11,21) and month and hour)
4087!! year=1005 : mounthly values (depend by month)
4088!! year=1006 : mounthly,hourly values (depend by month and hour)
4089!! year=1007 : yearly values (no other time dependence)
4090!! year=1008 : yearly,hourly values (depend by year and hour)
4091!! 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.
4092FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4093TYPE(cyclicdatetime),INTENT(IN) :: this !< cycliddatetime to use in compute
4094
4095TYPE(datetime) :: dtc
4096
4097integer :: year,month,day,hour
4098
4099dtc = datetime_miss
4100
4101! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4103 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4104 return
4105end if
4106
4107! minute present -> not good for conventional datetime
4109! day, month and tendaysp present -> no good
4111
4113 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4115 day=(this%tendaysp-1)*10+1
4116 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4118 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4120 ! only day present -> no good
4121 return
4122end if
4123
4126 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4127end if
4128
4129
4130END FUNCTION cyclicdatetime_to_conventional
4131
4132
4133
4134FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4135TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4136
4137CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4138
4139char=cyclicdatetime_to_char(in)
4140
4141END FUNCTION trim_cyclicdatetime_to_char
4142
4143
4144
4145SUBROUTINE display_cyclicdatetime(this)
4146TYPE(cyclicdatetime),INTENT(in) :: this
4147
4149
4150end subroutine display_cyclicdatetime
4151
4152
4153#include "array_utilities_inc.F90"
4154
4156
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 |