libsim Versione 7.2.6

◆ cyclicdatetime_to_conventional()

type(datetime) function, public cyclicdatetime_to_conventional ( type(cyclicdatetime), intent(in) this)

Restituisce una rappresentazione convenzionale in forma datetime cyclicdatetime.

The following conventional code values are used to specify which data was taken into account in the computation: year=1001 : dayly values of a specified month (depends by day and month) year=1002 : dayly,hourly values of a specified month (depends by day and month and hour) year=1003 : 10 day period of a specified month (depends by day(1,11,21) and month) year=1004 : 10 day period of a specified month,hourly (depends by day(1,11,21) and month and hour) year=1005 : mounthly values (depend by month) year=1006 : mounthly,hourly values (depend by month and hour) year=1007 : yearly values (no other time dependence) year=1008 : yearly,hourly values (depend by year and hour) 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.

Parametri
[in]thiscycliddatetime to use in compute

Definizione alla linea 2402 del file datetime_class.F90.

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