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