libsim Versione 7.1.11

◆ cyclicdatetime_to_char()

elemental character(len=80) function cyclicdatetime_to_char ( type(cyclicdatetime), intent(in)  this)
private

Restituisce una rappresentazione carattere stampabile di un oggetto cyclicdatetime.

Definizione alla linea 2385 del file datetime_class.F90.

2386! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2387! authors:
2388! Davide Cesari <dcesari@arpa.emr.it>
2389! Paolo Patruno <ppatruno@arpa.emr.it>
2390
2391! This program is free software; you can redistribute it and/or
2392! modify it under the terms of the GNU General Public License as
2393! published by the Free Software Foundation; either version 2 of
2394! the License, or (at your option) any later version.
2395
2396! This program is distributed in the hope that it will be useful,
2397! but WITHOUT ANY WARRANTY; without even the implied warranty of
2398! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2399! GNU General Public License for more details.
2400
2401! You should have received a copy of the GNU General Public License
2402! along with this program. If not, see <http://www.gnu.org/licenses/>.
2403#include "config.h"
2404
2418MODULE datetime_class
2419USE kinds
2420USE log4fortran
2421USE err_handling
2425IMPLICIT NONE
2426
2427INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2428
2430TYPE datetime
2431 PRIVATE
2432 INTEGER(KIND=int_ll) :: iminuti
2433END TYPE datetime
2434
2442TYPE timedelta
2443 PRIVATE
2444 INTEGER(KIND=int_ll) :: iminuti
2445 INTEGER :: month
2446END TYPE timedelta
2447
2448
2452TYPE cyclicdatetime
2453 PRIVATE
2454 INTEGER :: minute
2455 INTEGER :: hour
2456 INTEGER :: day
2457 INTEGER :: tendaysp
2458 INTEGER :: month
2459END TYPE cyclicdatetime
2460
2461
2463TYPE(datetime), PARAMETER :: datetime_miss=datetime(illmiss)
2465TYPE(timedelta), PARAMETER :: timedelta_miss=timedelta(illmiss, 0)
2467TYPE(timedelta), PARAMETER :: timedelta_0=timedelta(0, 0)
2469INTEGER, PARAMETER :: datetime_utc=1
2471INTEGER, PARAMETER :: datetime_local=2
2473TYPE(datetime), PARAMETER :: datetime_min=datetime(-huge(1_int_ll)-1)
2475TYPE(datetime), PARAMETER :: datetime_max=datetime(huge(1_int_ll)-1)
2477TYPE(timedelta), PARAMETER :: timedelta_min=timedelta(-huge(1_int_ll)-1,0)
2479TYPE(timedelta), PARAMETER :: timedelta_max=timedelta(huge(1_int_ll)-1,0)
2481TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2482
2483
2484INTEGER(kind=dateint), PARAMETER :: &
2485 sec_in_day=86400, &
2486 sec_in_hour=3600, &
2487 sec_in_min=60, &
2488 min_in_day=1440, &
2489 min_in_hour=60, &
2490 hour_in_day=24
2491
2492INTEGER,PARAMETER :: &
2493 year0=1, & ! anno di origine per iminuti
2494 d1=365, & ! giorni/1 anno nel calendario gregoriano
2495 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2496 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2497 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2498 ianno(13,2)=reshape((/ &
2499 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2500 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2501
2502INTEGER(KIND=int_ll),PARAMETER :: &
2503 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2504
2508INTERFACE init
2509 MODULE PROCEDURE datetime_init, timedelta_init
2510END INTERFACE
2511
2514INTERFACE delete
2515 MODULE PROCEDURE datetime_delete, timedelta_delete
2516END INTERFACE
2517
2519INTERFACE getval
2520 MODULE PROCEDURE datetime_getval, timedelta_getval
2521END INTERFACE
2522
2524INTERFACE to_char
2525 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2526END INTERFACE
2527
2528
2546INTERFACE t2c
2547 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2548END INTERFACE
2549
2555INTERFACE OPERATOR (==)
2556 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2557 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2558END INTERFACE
2559
2565INTERFACE OPERATOR (/=)
2566 MODULE PROCEDURE datetime_ne, timedelta_ne
2567END INTERFACE
2568
2576INTERFACE OPERATOR (>)
2577 MODULE PROCEDURE datetime_gt, timedelta_gt
2578END INTERFACE
2579
2587INTERFACE OPERATOR (<)
2588 MODULE PROCEDURE datetime_lt, timedelta_lt
2589END INTERFACE
2590
2598INTERFACE OPERATOR (>=)
2599 MODULE PROCEDURE datetime_ge, timedelta_ge
2600END INTERFACE
2601
2609INTERFACE OPERATOR (<=)
2610 MODULE PROCEDURE datetime_le, timedelta_le
2611END INTERFACE
2612
2619INTERFACE OPERATOR (+)
2620 MODULE PROCEDURE datetime_add, timedelta_add
2621END INTERFACE
2622
2630INTERFACE OPERATOR (-)
2631 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
2632END INTERFACE
2633
2639INTERFACE OPERATOR (*)
2640 MODULE PROCEDURE timedelta_mult, timedelta_tlum
2641END INTERFACE
2642
2649INTERFACE OPERATOR (/)
2650 MODULE PROCEDURE timedelta_divint, timedelta_divtd
2651END INTERFACE
2652
2663INTERFACE mod
2664 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
2665END INTERFACE
2666
2669INTERFACE abs
2670 MODULE PROCEDURE timedelta_abs
2671END INTERFACE
2672
2675INTERFACE read_unit
2676 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
2677 timedelta_read_unit, timedelta_vect_read_unit
2678END INTERFACE
2679
2682INTERFACE write_unit
2683 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
2684 timedelta_write_unit, timedelta_vect_write_unit
2685END INTERFACE
2686
2688INTERFACE display
2689 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
2690END INTERFACE
2691
2693INTERFACE c_e
2694 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
2695END INTERFACE
2696
2697#undef VOL7D_POLY_TYPE
2698#undef VOL7D_POLY_TYPES
2699#undef ENABLE_SORT
2700#define VOL7D_POLY_TYPE TYPE(datetime)
2701#define VOL7D_POLY_TYPES _datetime
2702#define ENABLE_SORT
2703#include "array_utilities_pre.F90"
2704
2705
2706#define ARRAYOF_ORIGTYPE TYPE(datetime)
2707#define ARRAYOF_TYPE arrayof_datetime
2708#define ARRAYOF_ORIGEQ 1
2709#include "arrayof_pre.F90"
2710! from arrayof
2711
2712PRIVATE
2713
2714PUBLIC datetime, datetime_miss, datetime_utc, datetime_local, &
2715 datetime_min, datetime_max, &
2716 datetime_new, datetime_new_now, init, delete, getval, to_char, t2c, &
2718 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
2719 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
2720 OPERATOR(*), OPERATOR(/), mod, abs, &
2721 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
2722 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
2723 display, c_e, &
2724 count_distinct, pack_distinct, &
2725 count_distinct_sorted, pack_distinct_sorted, &
2726 count_and_pack_distinct, &
2727 map_distinct, map_inv_distinct, index, index_sorted, sort, &
2728 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
2729PUBLIC insert, append, remove, packarray
2730PUBLIC insert_unique, append_unique
2731PUBLIC cyclicdatetime_to_conventional
2732
2733CONTAINS
2734
2735
2736! ==============
2737! == datetime ==
2738! ==============
2739
2746ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
2747 unixtime, isodate, simpledate) RESULT(this)
2748INTEGER,INTENT(IN),OPTIONAL :: year
2749INTEGER,INTENT(IN),OPTIONAL :: month
2750INTEGER,INTENT(IN),OPTIONAL :: day
2751INTEGER,INTENT(IN),OPTIONAL :: hour
2752INTEGER,INTENT(IN),OPTIONAL :: minute
2753INTEGER,INTENT(IN),OPTIONAL :: msec
2754INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2755CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2756CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2757
2758TYPE(datetime) :: this
2759INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2760CHARACTER(len=23) :: datebuf
2761
2762IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
2763 lyear = year
2764 IF (PRESENT(month)) THEN
2765 lmonth = month
2766 ELSE
2767 lmonth = 1
2768 ENDIF
2769 IF (PRESENT(day)) THEN
2770 lday = day
2771 ELSE
2772 lday = 1
2773 ENDIF
2774 IF (PRESENT(hour)) THEN
2775 lhour = hour
2776 ELSE
2777 lhour = 0
2778 ENDIF
2779 IF (PRESENT(minute)) THEN
2780 lminute = minute
2781 ELSE
2782 lminute = 0
2783 ENDIF
2784 IF (PRESENT(msec)) THEN
2785 lmsec = msec
2786 ELSE
2787 lmsec = 0
2788 ENDIF
2789
2790 if (c_e(lday) .and. c_e(lmonth) .and. c_e(lyear) .and. c_e(lhour) &
2791 .and. c_e(lminute) .and. c_e(lmsec)) then
2792 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2793 else
2794 this=datetime_miss
2795 end if
2796
2797ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
2798 if (c_e(unixtime)) then
2799 this%iminuti = (unixtime + unsec)*1000
2800 else
2801 this=datetime_miss
2802 end if
2803
2804ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
2805
2806 IF (c_e(isodate) .AND. len_trim(isodate) > 0) THEN
2807 datebuf(1:23) = '0001-01-01 00:00:00.000'
2808 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
2809 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
2810 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2811 lmsec = lmsec + lsec*1000
2812 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2813 RETURN
2814
2815100 CONTINUE ! condizione di errore in isodate
2816 CALL delete(this)
2817 RETURN
2818 ELSE
2819 this = datetime_miss
2820 ENDIF
2821
2822ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
2823 IF (c_e(simpledate) .AND. len_trim(simpledate) > 0)THEN
2824 datebuf(1:17) = '00010101000000000'
2825 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2826 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
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
2832120 CONTINUE ! condizione di errore in simpledate
2833 CALL delete(this)
2834 RETURN
2835 ELSE
2836 this = datetime_miss
2837 ENDIF
2838
2839ELSE
2840 this = datetime_miss
2841ENDIF
2842
2843END FUNCTION datetime_new
2844
2845
2847FUNCTION datetime_new_now(now) RESULT(this)
2848INTEGER,INTENT(IN) :: now
2849TYPE(datetime) :: this
2850
2851INTEGER :: dt(8)
2852
2853IF (c_e(now)) THEN
2854 CALL date_and_time(values=dt)
2855 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
2856 CALL init(this, year=dt(1), month=dt(2), day=dt(3), hour=dt(5), minute=dt(6), &
2857 msec=dt(7)*1000+dt(8))
2858ELSE
2859 this = datetime_miss
2860ENDIF
2861
2862END FUNCTION datetime_new_now
2863
2864
2871SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
2872 unixtime, isodate, simpledate, now)
2873TYPE(datetime),INTENT(INOUT) :: this
2874INTEGER,INTENT(IN),OPTIONAL :: year
2875INTEGER,INTENT(IN),OPTIONAL :: month
2876INTEGER,INTENT(IN),OPTIONAL :: day
2877INTEGER,INTENT(IN),OPTIONAL :: hour
2878INTEGER,INTENT(IN),OPTIONAL :: minute
2879INTEGER,INTENT(IN),OPTIONAL :: msec
2880INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2881CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2882CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2883INTEGER,INTENT(IN),OPTIONAL :: now
2884
2885IF (PRESENT(now)) THEN
2886 this = datetime_new_now(now)
2887ELSE
2888 this = datetime_new(year, month, day, hour, minute, msec, &
2889 unixtime, isodate, simpledate)
2890ENDIF
2891
2892END SUBROUTINE datetime_init
2893
2894
2895ELEMENTAL SUBROUTINE datetime_delete(this)
2896TYPE(datetime),INTENT(INOUT) :: this
2897
2898this%iminuti = illmiss
2899
2900END SUBROUTINE datetime_delete
2901
2902
2907PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
2908 unixtime, isodate, simpledate, oraclesimdate)
2909TYPE(datetime),INTENT(IN) :: this
2910INTEGER,INTENT(OUT),OPTIONAL :: year
2911INTEGER,INTENT(OUT),OPTIONAL :: month
2912INTEGER,INTENT(OUT),OPTIONAL :: day
2913INTEGER,INTENT(OUT),OPTIONAL :: hour
2914INTEGER,INTENT(OUT),OPTIONAL :: minute
2915INTEGER,INTENT(OUT),OPTIONAL :: msec
2916INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime
2917CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
2918CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
2919CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
2920
2921INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2922CHARACTER(len=23) :: datebuf
2923
2924IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
2925 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
2926 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
2927
2928 IF (this == datetime_miss) THEN
2929
2930 IF (PRESENT(msec)) THEN
2931 msec = imiss
2932 ENDIF
2933 IF (PRESENT(minute)) THEN
2934 minute = imiss
2935 ENDIF
2936 IF (PRESENT(hour)) THEN
2937 hour = imiss
2938 ENDIF
2939 IF (PRESENT(day)) THEN
2940 day = imiss
2941 ENDIF
2942 IF (PRESENT(month)) THEN
2943 month = imiss
2944 ENDIF
2945 IF (PRESENT(year)) THEN
2946 year = imiss
2947 ENDIF
2948 IF (PRESENT(isodate)) THEN
2949 isodate = cmiss
2950 ENDIF
2951 IF (PRESENT(simpledate)) THEN
2952 simpledate = cmiss
2953 ENDIF
2954 IF (PRESENT(oraclesimdate)) THEN
2955!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2956!!$ 'obsoleto, usare piuttosto simpledate')
2957 oraclesimdate=cmiss
2958 ENDIF
2959 IF (PRESENT(unixtime)) THEN
2960 unixtime = illmiss
2961 ENDIF
2962
2963 ELSE
2964
2965 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2966 IF (PRESENT(msec)) THEN
2967 msec = lmsec
2968 ENDIF
2969 IF (PRESENT(minute)) THEN
2970 minute = lminute
2971 ENDIF
2972 IF (PRESENT(hour)) THEN
2973 hour = lhour
2974 ENDIF
2975 IF (PRESENT(day)) THEN
2976 day = lday
2977 ENDIF
2978 IF (PRESENT(month)) THEN
2979 month = lmonth
2980 ENDIF
2981 IF (PRESENT(year)) THEN
2982 year = lyear
2983 ENDIF
2984 IF (PRESENT(isodate)) THEN
2985 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
2986 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
2987 '.', mod(lmsec, 1000)
2988 isodate = datebuf(1:min(len(isodate),23))
2989 ENDIF
2990 IF (PRESENT(simpledate)) THEN
2991 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
2992 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
2993 simpledate = datebuf(1:min(len(simpledate),17))
2994 ENDIF
2995 IF (PRESENT(oraclesimdate)) THEN
2996!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2997!!$ 'obsoleto, usare piuttosto simpledate')
2998 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
2999 ENDIF
3000 IF (PRESENT(unixtime)) THEN
3001 unixtime = this%iminuti/1000_int_ll-unsec
3002 ENDIF
3003
3004 ENDIF
3005ENDIF
3006
3007END SUBROUTINE datetime_getval
3008
3009
3012elemental FUNCTION datetime_to_char(this) RESULT(char)
3013TYPE(datetime),INTENT(IN) :: this
3014
3015CHARACTER(len=23) :: char
3016
3017CALL getval(this, isodate=char)
3018
3019END FUNCTION datetime_to_char
3020
3021
3022FUNCTION trim_datetime_to_char(in) RESULT(char)
3023TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3024
3025CHARACTER(len=len_trim(datetime_to_char(in))) :: char
3026
3027char=datetime_to_char(in)
3028
3029END FUNCTION trim_datetime_to_char
3030
3031
3032
3033SUBROUTINE display_datetime(this)
3034TYPE(datetime),INTENT(in) :: this
3035
3036print*,"TIME: ",to_char(this)
3037
3038end subroutine display_datetime
3039
3040
3041
3042SUBROUTINE display_timedelta(this)
3043TYPE(timedelta),INTENT(in) :: this
3044
3045print*,"TIMEDELTA: ",to_char(this)
3046
3047end subroutine display_timedelta
3048
3049
3050
3051ELEMENTAL FUNCTION c_e_datetime(this) result (res)
3052TYPE(datetime),INTENT(in) :: this
3053LOGICAL :: res
3054
3055res = .not. this == datetime_miss
3056
3057end FUNCTION c_e_datetime
3058
3059
3060ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
3061TYPE(datetime),INTENT(IN) :: this, that
3062LOGICAL :: res
3063
3064res = this%iminuti == that%iminuti
3065
3066END FUNCTION datetime_eq
3067
3068
3069ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3070TYPE(datetime),INTENT(IN) :: this, that
3071LOGICAL :: res
3072
3073res = .NOT.(this == that)
3074
3075END FUNCTION datetime_ne
3076
3077
3078ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3079TYPE(datetime),INTENT(IN) :: this, that
3080LOGICAL :: res
3081
3082res = this%iminuti > that%iminuti
3083
3084END FUNCTION datetime_gt
3085
3086
3087ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3088TYPE(datetime),INTENT(IN) :: this, that
3089LOGICAL :: res
3090
3091res = this%iminuti < that%iminuti
3092
3093END FUNCTION datetime_lt
3094
3095
3096ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3097TYPE(datetime),INTENT(IN) :: this, that
3098LOGICAL :: res
3099
3100IF (this == that) THEN
3101 res = .true.
3102ELSE IF (this > that) THEN
3103 res = .true.
3104ELSE
3105 res = .false.
3106ENDIF
3107
3108END FUNCTION datetime_ge
3109
3110
3111ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3112TYPE(datetime),INTENT(IN) :: this, that
3113LOGICAL :: res
3114
3115IF (this == that) THEN
3116 res = .true.
3117ELSE IF (this < that) THEN
3118 res = .true.
3119ELSE
3120 res = .false.
3121ENDIF
3122
3123END FUNCTION datetime_le
3124
3125
3126FUNCTION datetime_add(this, that) RESULT(res)
3127TYPE(datetime),INTENT(IN) :: this
3128TYPE(timedelta),INTENT(IN) :: that
3129TYPE(datetime) :: res
3130
3131INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3132
3133IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3134 res = datetime_miss
3135ELSE
3136 res%iminuti = this%iminuti + that%iminuti
3137 IF (that%month /= 0) THEN
3138 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
3139 minute=lminute, msec=lmsec)
3140 CALL init(res, year=lyear, month=lmonth+that%month, day=lday, &
3141 hour=lhour, minute=lminute, msec=lmsec)
3142 ENDIF
3143ENDIF
3144
3145END FUNCTION datetime_add
3146
3147
3148ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3149TYPE(datetime),INTENT(IN) :: this, that
3150TYPE(timedelta) :: res
3151
3152IF (this == datetime_miss .OR. that == datetime_miss) THEN
3153 res = timedelta_miss
3154ELSE
3155 res%iminuti = this%iminuti - that%iminuti
3156 res%month = 0
3157ENDIF
3158
3159END FUNCTION datetime_subdt
3160
3161
3162FUNCTION datetime_subtd(this, that) RESULT(res)
3163TYPE(datetime),INTENT(IN) :: this
3164TYPE(timedelta),INTENT(IN) :: that
3165TYPE(datetime) :: res
3166
3167INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3168
3169IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3170 res = datetime_miss
3171ELSE
3172 res%iminuti = this%iminuti - that%iminuti
3173 IF (that%month /= 0) THEN
3174 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
3175 minute=lminute, msec=lmsec)
3176 CALL init(res, year=lyear, month=lmonth-that%month, day=lday, &
3177 hour=lhour, minute=lminute, msec=lmsec)
3178 ENDIF
3179ENDIF
3180
3181END FUNCTION datetime_subtd
3182
3183
3188SUBROUTINE datetime_read_unit(this, unit)
3189TYPE(datetime),INTENT(out) :: this
3190INTEGER, INTENT(in) :: unit
3191CALL datetime_vect_read_unit((/this/), unit)
3192
3193END SUBROUTINE datetime_read_unit
3194
3195
3200SUBROUTINE datetime_vect_read_unit(this, unit)
3201TYPE(datetime) :: this(:)
3202INTEGER, INTENT(in) :: unit
3203
3204CHARACTER(len=40) :: form
3205CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3206INTEGER :: i
3207
3208ALLOCATE(dateiso(SIZE(this)))
3209INQUIRE(unit, form=form)
3210IF (form == 'FORMATTED') THEN
3211 READ(unit,'(A23,1X)')dateiso
3212ELSE
3213 READ(unit)dateiso
3214ENDIF
3215DO i = 1, SIZE(dateiso)
3216 CALL init(this(i), isodate=dateiso(i))
3217ENDDO
3218DEALLOCATE(dateiso)
3219
3220END SUBROUTINE datetime_vect_read_unit
3221
3222
3227SUBROUTINE datetime_write_unit(this, unit)
3228TYPE(datetime),INTENT(in) :: this
3229INTEGER, INTENT(in) :: unit
3230
3231CALL datetime_vect_write_unit((/this/), unit)
3232
3233END SUBROUTINE datetime_write_unit
3234
3235
3240SUBROUTINE datetime_vect_write_unit(this, unit)
3241TYPE(datetime),INTENT(in) :: this(:)
3242INTEGER, INTENT(in) :: unit
3243
3244CHARACTER(len=40) :: form
3245CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3246INTEGER :: i
3247
3248ALLOCATE(dateiso(SIZE(this)))
3249DO i = 1, SIZE(dateiso)
3250 CALL getval(this(i), isodate=dateiso(i))
3251ENDDO
3252INQUIRE(unit, form=form)
3253IF (form == 'FORMATTED') THEN
3254 WRITE(unit,'(A23,1X)')dateiso
3255ELSE
3256 WRITE(unit)dateiso
3257ENDIF
3258DEALLOCATE(dateiso)
3259
3260END SUBROUTINE datetime_vect_write_unit
3261
3262
3263#include "arrayof_post.F90"
3264
3265
3266! ===============
3267! == timedelta ==
3268! ===============
3275FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3276 isodate, simpledate, oraclesimdate) RESULT (this)
3277INTEGER,INTENT(IN),OPTIONAL :: year
3278INTEGER,INTENT(IN),OPTIONAL :: month
3279INTEGER,INTENT(IN),OPTIONAL :: day
3280INTEGER,INTENT(IN),OPTIONAL :: hour
3281INTEGER,INTENT(IN),OPTIONAL :: minute
3282INTEGER,INTENT(IN),OPTIONAL :: sec
3283INTEGER,INTENT(IN),OPTIONAL :: msec
3284CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3285CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3286CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3287
3288TYPE(timedelta) :: this
3289
3290CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3291 isodate, simpledate, oraclesimdate)
3292
3293END FUNCTION timedelta_new
3294
3295
3300SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3301 isodate, simpledate, oraclesimdate)
3302TYPE(timedelta),INTENT(INOUT) :: this
3303INTEGER,INTENT(IN),OPTIONAL :: year
3304INTEGER,INTENT(IN),OPTIONAL :: month
3305INTEGER,INTENT(IN),OPTIONAL :: day
3306INTEGER,INTENT(IN),OPTIONAL :: hour
3307INTEGER,INTENT(IN),OPTIONAL :: minute
3308INTEGER,INTENT(IN),OPTIONAL :: sec
3309INTEGER,INTENT(IN),OPTIONAL :: msec
3310CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3311CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3312CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3313
3314INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3315CHARACTER(len=23) :: datebuf
3316
3317this%month = 0
3318
3319IF (PRESENT(isodate)) THEN
3320 datebuf(1:23) = '0000000000 00:00:00.000'
3321 l = len_trim(isodate)
3322! IF (l > 0) THEN
3323 n = index(trim(isodate), ' ') ! align blank space separator
3324 IF (n > 0) THEN
3325 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3326 datebuf(12-n:12-n+l-1) = isodate(:l)
3327 ELSE
3328 datebuf(1:l) = isodate(1:l)
3329 ENDIF
3330! ENDIF
3331
3332! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3333 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3334 h, m, s, ms
3335 this%month = lmonth + 12*lyear
3336 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3337 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3338 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3339 RETURN
3340
3341200 CONTINUE ! condizione di errore in isodate
3342 CALL delete(this)
3343 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3344 CALL raise_error()
3345
3346ELSE IF (PRESENT(simpledate)) THEN
3347 datebuf(1:17) = '00000000000000000'
3348 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3349 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3350 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3351 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3352 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3353
3354220 CONTINUE ! condizione di errore in simpledate
3355 CALL delete(this)
3356 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3357 CALL raise_error()
3358 RETURN
3359
3360ELSE IF (PRESENT(oraclesimdate)) THEN
3361 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3362 'obsoleto, usare piuttosto simpledate')
3363 READ(oraclesimdate, '(I8,2I2)')d, h, m
3364 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3365 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3366
3367ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3368 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3369 .and. .not. present(msec) .and. .not. present(isodate) &
3370 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3371
3372 this=timedelta_miss
3373
3374ELSE
3375 this%iminuti = 0
3376 IF (PRESENT(year)) THEN
3377 if (c_e(year))then
3378 this%month = this%month + year*12
3379 else
3380 this=timedelta_miss
3381 return
3382 end if
3383 ENDIF
3384 IF (PRESENT(month)) THEN
3385 if (c_e(month))then
3386 this%month = this%month + month
3387 else
3388 this=timedelta_miss
3389 return
3390 end if
3391 ENDIF
3392 IF (PRESENT(day)) THEN
3393 if (c_e(day))then
3394 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3395 else
3396 this=timedelta_miss
3397 return
3398 end if
3399 ENDIF
3400 IF (PRESENT(hour)) THEN
3401 if (c_e(hour))then
3402 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3403 else
3404 this=timedelta_miss
3405 return
3406 end if
3407 ENDIF
3408 IF (PRESENT(minute)) THEN
3409 if (c_e(minute))then
3410 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3411 else
3412 this=timedelta_miss
3413 return
3414 end if
3415 ENDIF
3416 IF (PRESENT(sec)) THEN
3417 if (c_e(sec))then
3418 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3419 else
3420 this=timedelta_miss
3421 return
3422 end if
3423 ENDIF
3424 IF (PRESENT(msec)) THEN
3425 if (c_e(msec))then
3426 this%iminuti = this%iminuti + msec
3427 else
3428 this=timedelta_miss
3429 return
3430 end if
3431 ENDIF
3432ENDIF
3433
3434
3435
3436
3437END SUBROUTINE timedelta_init
3438
3439
3440SUBROUTINE timedelta_delete(this)
3441TYPE(timedelta),INTENT(INOUT) :: this
3442
3443this%iminuti = imiss
3444this%month = 0
3445
3446END SUBROUTINE timedelta_delete
3447
3448
3453PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3454 day, hour, minute, sec, msec, &
3455 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3456TYPE(timedelta),INTENT(IN) :: this
3457INTEGER,INTENT(OUT),OPTIONAL :: year
3458INTEGER,INTENT(OUT),OPTIONAL :: month
3459INTEGER,INTENT(OUT),OPTIONAL :: amonth
3460INTEGER,INTENT(OUT),OPTIONAL :: day
3461INTEGER,INTENT(OUT),OPTIONAL :: hour
3462INTEGER,INTENT(OUT),OPTIONAL :: minute
3463INTEGER,INTENT(OUT),OPTIONAL :: sec
3464INTEGER,INTENT(OUT),OPTIONAL :: msec
3465INTEGER,INTENT(OUT),OPTIONAL :: ahour
3466INTEGER,INTENT(OUT),OPTIONAL :: aminute
3467INTEGER,INTENT(OUT),OPTIONAL :: asec
3468INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec
3469CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3470CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3471CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3472
3473CHARACTER(len=23) :: datebuf
3474
3475IF (PRESENT(amsec)) THEN
3476 amsec = this%iminuti
3477ENDIF
3478IF (PRESENT(asec)) THEN
3479 asec = int(this%iminuti/1000_int_ll)
3480ENDIF
3481IF (PRESENT(aminute)) THEN
3482 aminute = int(this%iminuti/60000_int_ll)
3483ENDIF
3484IF (PRESENT(ahour)) THEN
3485 ahour = int(this%iminuti/3600000_int_ll)
3486ENDIF
3487IF (PRESENT(msec)) THEN
3488 msec = int(mod(this%iminuti, 1000_int_ll))
3489ENDIF
3490IF (PRESENT(sec)) THEN
3491 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3492ENDIF
3493IF (PRESENT(minute)) THEN
3494 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3495ENDIF
3496IF (PRESENT(hour)) THEN
3497 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3498ENDIF
3499IF (PRESENT(day)) THEN
3500 day = int(this%iminuti/86400000_int_ll)
3501ENDIF
3502IF (PRESENT(amonth)) THEN
3503 amonth = this%month
3504ENDIF
3505IF (PRESENT(month)) THEN
3506 month = mod(this%month-1,12)+1
3507ENDIF
3508IF (PRESENT(year)) THEN
3509 year = this%month/12
3510ENDIF
3511IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3512 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3513 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), ':', &
3514 mod(this%iminuti/60000_int_ll, 60_int_ll), ':', mod(this%iminuti/1000_int_ll, 60_int_ll), &
3515 '.', mod(this%iminuti, 1000_int_ll)
3516 isodate = datebuf(1:min(len(isodate),23))
3517
3518ENDIF
3519IF (PRESENT(simpledate)) THEN
3520 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3521 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3522 mod(this%iminuti/60000_int_ll, 60_int_ll), mod(this%iminuti/1000_int_ll, 60_int_ll), &
3523 mod(this%iminuti, 1000_int_ll)
3524 simpledate = datebuf(1:min(len(simpledate),17))
3525ENDIF
3526IF (PRESENT(oraclesimdate)) THEN
3527!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3528!!$ 'obsoleto, usare piuttosto simpledate')
3529 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3530 mod(this%iminuti/3600000_int_ll, 24_int_ll), mod(this%iminuti/60000_int_ll, 60_int_ll)
3531ENDIF
3532
3533END SUBROUTINE timedelta_getval
3534
3535
3538elemental FUNCTION timedelta_to_char(this) RESULT(char)
3539TYPE(timedelta),INTENT(IN) :: this
3540
3541CHARACTER(len=23) :: char
3542
3543CALL getval(this, isodate=char)
3544
3545END FUNCTION timedelta_to_char
3546
3547
3548FUNCTION trim_timedelta_to_char(in) RESULT(char)
3549TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3550
3551CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3552
3553char=timedelta_to_char(in)
3554
3555END FUNCTION trim_timedelta_to_char
3556
3557
3559elemental FUNCTION timedelta_getamsec(this)
3560TYPE(timedelta),INTENT(IN) :: this
3561INTEGER(kind=int_ll) :: timedelta_getamsec
3562
3563timedelta_getamsec = this%iminuti
3564
3565END FUNCTION timedelta_getamsec
3566
3567
3573FUNCTION timedelta_depop(this)
3574TYPE(timedelta),INTENT(IN) :: this
3575TYPE(timedelta) :: timedelta_depop
3576
3577TYPE(datetime) :: tmpdt
3578
3579IF (this%month == 0) THEN
3580 timedelta_depop = this
3581ELSE
3582 tmpdt = datetime_new(1970, 1, 1)
3583 timedelta_depop = (tmpdt + this) - tmpdt
3584ENDIF
3585
3586END FUNCTION timedelta_depop
3587
3588
3589elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3590TYPE(timedelta),INTENT(IN) :: this, that
3591LOGICAL :: res
3592
3593res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3594
3595END FUNCTION timedelta_eq
3596
3597
3598ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3599TYPE(timedelta),INTENT(IN) :: this, that
3600LOGICAL :: res
3601
3602res = .NOT.(this == that)
3603
3604END FUNCTION timedelta_ne
3605
3606
3607ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
3608TYPE(timedelta),INTENT(IN) :: this, that
3609LOGICAL :: res
3610
3611res = this%iminuti > that%iminuti
3612
3613END FUNCTION timedelta_gt
3614
3615
3616ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
3617TYPE(timedelta),INTENT(IN) :: this, that
3618LOGICAL :: res
3619
3620res = this%iminuti < that%iminuti
3621
3622END FUNCTION timedelta_lt
3623
3624
3625ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
3626TYPE(timedelta),INTENT(IN) :: this, that
3627LOGICAL :: res
3628
3629IF (this == that) THEN
3630 res = .true.
3631ELSE IF (this > that) THEN
3632 res = .true.
3633ELSE
3634 res = .false.
3635ENDIF
3636
3637END FUNCTION timedelta_ge
3638
3639
3640elemental FUNCTION timedelta_le(this, that) RESULT(res)
3641TYPE(timedelta),INTENT(IN) :: this, that
3642LOGICAL :: res
3643
3644IF (this == that) THEN
3645 res = .true.
3646ELSE IF (this < that) THEN
3647 res = .true.
3648ELSE
3649 res = .false.
3650ENDIF
3651
3652END FUNCTION timedelta_le
3653
3654
3655ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
3656TYPE(timedelta),INTENT(IN) :: this, that
3657TYPE(timedelta) :: res
3658
3659res%iminuti = this%iminuti + that%iminuti
3660res%month = this%month + that%month
3661
3662END FUNCTION timedelta_add
3663
3664
3665ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
3666TYPE(timedelta),INTENT(IN) :: this, that
3667TYPE(timedelta) :: res
3668
3669res%iminuti = this%iminuti - that%iminuti
3670res%month = this%month - that%month
3671
3672END FUNCTION timedelta_sub
3673
3674
3675ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
3676TYPE(timedelta),INTENT(IN) :: this
3677INTEGER,INTENT(IN) :: n
3678TYPE(timedelta) :: res
3679
3680res%iminuti = this%iminuti*n
3681res%month = this%month*n
3682
3683END FUNCTION timedelta_mult
3684
3685
3686ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
3687INTEGER,INTENT(IN) :: n
3688TYPE(timedelta),INTENT(IN) :: this
3689TYPE(timedelta) :: res
3690
3691res%iminuti = this%iminuti*n
3692res%month = this%month*n
3693
3694END FUNCTION timedelta_tlum
3695
3696
3697ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
3698TYPE(timedelta),INTENT(IN) :: this
3699INTEGER,INTENT(IN) :: n
3700TYPE(timedelta) :: res
3701
3702res%iminuti = this%iminuti/n
3703res%month = this%month/n
3704
3705END FUNCTION timedelta_divint
3706
3707
3708ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
3709TYPE(timedelta),INTENT(IN) :: this, that
3710INTEGER :: res
3711
3712res = int(this%iminuti/that%iminuti)
3713
3714END FUNCTION timedelta_divtd
3715
3716
3717elemental FUNCTION timedelta_mod(this, that) RESULT(res)
3718TYPE(timedelta),INTENT(IN) :: this, that
3719TYPE(timedelta) :: res
3720
3721res%iminuti = mod(this%iminuti, that%iminuti)
3722res%month = 0
3723
3724END FUNCTION timedelta_mod
3725
3726
3727ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
3728TYPE(datetime),INTENT(IN) :: this
3729TYPE(timedelta),INTENT(IN) :: that
3730TYPE(timedelta) :: res
3731
3732IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
3733 res = timedelta_0
3734ELSE
3735 res%iminuti = mod(this%iminuti, that%iminuti)
3736 res%month = 0
3737ENDIF
3738
3739END FUNCTION datetime_timedelta_mod
3740
3741
3742ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
3743TYPE(timedelta),INTENT(IN) :: this
3744TYPE(timedelta) :: res
3745
3746res%iminuti = abs(this%iminuti)
3747res%month = abs(this%month)
3748
3749END FUNCTION timedelta_abs
3750
3751
3756SUBROUTINE timedelta_read_unit(this, unit)
3757TYPE(timedelta),INTENT(out) :: this
3758INTEGER, INTENT(in) :: unit
3759
3760CALL timedelta_vect_read_unit((/this/), unit)
3761
3762END SUBROUTINE timedelta_read_unit
3763
3764
3769SUBROUTINE timedelta_vect_read_unit(this, unit)
3770TYPE(timedelta) :: this(:)
3771INTEGER, INTENT(in) :: unit
3772
3773CHARACTER(len=40) :: form
3774CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3775INTEGER :: i
3776
3777ALLOCATE(dateiso(SIZE(this)))
3778INQUIRE(unit, form=form)
3779IF (form == 'FORMATTED') THEN
3780 READ(unit,'(3(A23,1X))')dateiso
3781ELSE
3782 READ(unit)dateiso
3783ENDIF
3784DO i = 1, SIZE(dateiso)
3785 CALL init(this(i), isodate=dateiso(i))
3786ENDDO
3787DEALLOCATE(dateiso)
3788
3789END SUBROUTINE timedelta_vect_read_unit
3790
3791
3796SUBROUTINE timedelta_write_unit(this, unit)
3797TYPE(timedelta),INTENT(in) :: this
3798INTEGER, INTENT(in) :: unit
3799
3800CALL timedelta_vect_write_unit((/this/), unit)
3801
3802END SUBROUTINE timedelta_write_unit
3803
3804
3809SUBROUTINE timedelta_vect_write_unit(this, unit)
3810TYPE(timedelta),INTENT(in) :: this(:)
3811INTEGER, INTENT(in) :: unit
3812
3813CHARACTER(len=40) :: form
3814CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3815INTEGER :: i
3816
3817ALLOCATE(dateiso(SIZE(this)))
3818DO i = 1, SIZE(dateiso)
3819 CALL getval(this(i), isodate=dateiso(i))
3820ENDDO
3821INQUIRE(unit, form=form)
3822IF (form == 'FORMATTED') THEN
3823 WRITE(unit,'(3(A23,1X))')dateiso
3824ELSE
3825 WRITE(unit)dateiso
3826ENDIF
3827DEALLOCATE(dateiso)
3828
3829END SUBROUTINE timedelta_vect_write_unit
3830
3831
3832ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
3833TYPE(timedelta),INTENT(in) :: this
3834LOGICAL :: res
3835
3836res = .not. this == timedelta_miss
3837
3838end FUNCTION c_e_timedelta
3839
3840
3841elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
3842
3843!!omstart JELADATA5
3844! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3845! 1 IMINUTI)
3846!
3847! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
3848!
3849! variabili integer*4
3850! IN:
3851! IDAY,IMONTH,IYEAR, I*4
3852! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3853!
3854! OUT:
3855! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3856!!OMEND
3857
3858INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
3859INTEGER,intent(out) :: iminuti
3860
3861iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
3862
3863END SUBROUTINE jeladata5
3864
3865
3866elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
3867INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
3868INTEGER(KIND=int_ll),intent(out) :: imillisec
3869
3870imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
3871 + imsec
3872
3873END SUBROUTINE jeladata5_1
3874
3875
3876
3877elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
3878
3879!!omstart JELADATA6
3880! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3881! 1 IMINUTI)
3882!
3883! Calcola la data e l'ora corrispondente a IMINUTI dopo il
3884! 1/1/1
3885!
3886! variabili integer*4
3887! IN:
3888! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3889!
3890! OUT:
3891! IDAY,IMONTH,IYEAR, I*4
3892! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3893!!OMEND
3894
3895
3896INTEGER,intent(in) :: iminuti
3897INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
3898
3899INTEGER ::igiorno
3900
3901imin = mod(iminuti,60)
3902ihour = mod(iminuti,1440)/60
3903igiorno = iminuti/1440
3904IF (mod(iminuti,1440) < 0) igiorno = igiorno-1
3905CALL ndyin(igiorno,iday,imonth,iyear)
3906
3907END SUBROUTINE jeladata6
3908
3909
3910elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
3911INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
3912INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
3913
3914INTEGER :: igiorno
3915
3916imsec = int(mod(imillisec, 60000_int_ll)) ! partial msec
3917!imin = MOD(imillisec/60000_int_ll, 60)
3918!ihour = MOD(imillisec/3600000_int_ll, 24)
3919imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
3920ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
3921igiorno = int(imillisec/86400000_int_ll)
3922!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
3923CALL ndyin(igiorno,iday,imonth,iyear)
3924
3925END SUBROUTINE jeladata6_1
3926
3927
3928elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
3929
3930!!OMSTART NDYIN
3931! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
3932! restituisce la data fornendo in input il numero di
3933! giorni dal 1/1/1
3934!
3935!!omend
3936
3937INTEGER,intent(in) :: ndays
3938INTEGER,intent(out) :: igg, imm, iaa
3939integer :: n,lndays
3940
3941lndays=ndays
3942
3943n = lndays/d400
3944lndays = lndays - n*d400
3945iaa = year0 + n*400
3946n = min(lndays/d100, 3)
3947lndays = lndays - n*d100
3948iaa = iaa + n*100
3949n = lndays/d4
3950lndays = lndays - n*d4
3951iaa = iaa + n*4
3952n = min(lndays/d1, 3)
3953lndays = lndays - n*d1
3954iaa = iaa + n
3955n = bisextilis(iaa)
3956DO imm = 1, 12
3957 IF (lndays < ianno(imm+1,n)) EXIT
3958ENDDO
3959igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
3960
3961END SUBROUTINE ndyin
3962
3963
3964integer elemental FUNCTION ndays(igg,imm,iaa)
3965
3966!!OMSTART NDAYS
3967! FUNCTION NDAYS(IGG,IMM,IAA)
3968! restituisce il numero di giorni dal 1/1/1
3969! fornendo in input la data
3970!
3971!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3972! nota bene E' SICURO !!!
3973! un anno e' bisestile se divisibile per 4
3974! un anno rimane bisestile se divisibile per 400
3975! un anno NON e' bisestile se divisibile per 100
3976!
3977!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3978!
3979!!omend
3980
3981INTEGER, intent(in) :: igg, imm, iaa
3982
3983INTEGER :: lmonth, lyear
3984
3985! Limito il mese a [1-12] e correggo l'anno coerentemente
3986lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
3987lyear = iaa + (imm - lmonth)/12
3988ndays = igg+ianno(lmonth, bisextilis(lyear))
3989ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
3990 (lyear-year0)/400
3991
3992END FUNCTION ndays
3993
3994
3995elemental FUNCTION bisextilis(annum)
3996INTEGER,INTENT(in) :: annum
3997INTEGER :: bisextilis
3998
3999IF (mod(annum,4) == 0 .AND. (mod(annum,400) == 0 .EQV. mod(annum,100) == 0)) THEN
4000 bisextilis = 2
4001ELSE
4002 bisextilis = 1
4003ENDIF
4004END FUNCTION bisextilis
4005
4006
4007ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
4008TYPE(cyclicdatetime),INTENT(IN) :: this, that
4009LOGICAL :: res
4010
4011res = .true.
4012if (this%minute /= that%minute) res=.false.
4013if (this%hour /= that%hour) res=.false.
4014if (this%day /= that%day) res=.false.
4015if (this%month /= that%month) res=.false.
4016if (this%tendaysp /= that%tendaysp) res=.false.
4017
4018END FUNCTION cyclicdatetime_eq
4019
4020
4021ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
4022TYPE(cyclicdatetime),INTENT(IN) :: this
4023TYPE(datetime),INTENT(IN) :: that
4024LOGICAL :: res
4025
4026integer :: minute,hour,day,month
4027
4028call getval(that,minute=minute,hour=hour,day=day,month=month)
4029
4030res = .true.
4031if (c_e(this%minute) .and. this%minute /= minute) res=.false.
4032if (c_e(this%hour) .and. this%hour /= hour) res=.false.
4033if (c_e(this%day) .and. this%day /= day) res=.false.
4034if (c_e(this%month) .and. this%month /= month) res=.false.
4035if (c_e(this%tendaysp)) then
4036 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4037end if
4038
4039END FUNCTION cyclicdatetime_datetime_eq
4040
4041
4042ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
4043TYPE(datetime),INTENT(IN) :: this
4044TYPE(cyclicdatetime),INTENT(IN) :: that
4045LOGICAL :: res
4046
4047integer :: minute,hour,day,month
4048
4049call getval(this,minute=minute,hour=hour,day=day,month=month)
4050
4051res = .true.
4052if (c_e(that%minute) .and. that%minute /= minute) res=.false.
4053if (c_e(that%hour) .and. that%hour /= hour) res=.false.
4054if (c_e(that%day) .and. that%day /= day) res=.false.
4055if (c_e(that%month) .and. that%month /= month) res=.false.
4056
4057if (c_e(that%tendaysp)) then
4058 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4059end if
4060
4061
4062END FUNCTION datetime_cyclicdatetime_eq
4063
4064ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
4065TYPE(cyclicdatetime),INTENT(in) :: this
4066LOGICAL :: res
4067
4068res = .not. this == cyclicdatetime_miss
4069
4070end FUNCTION c_e_cyclicdatetime
4071
4072
4075FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4076INTEGER,INTENT(IN),OPTIONAL :: tendaysp
4077INTEGER,INTENT(IN),OPTIONAL :: month
4078INTEGER,INTENT(IN),OPTIONAL :: day
4079INTEGER,INTENT(IN),OPTIONAL :: hour
4080INTEGER,INTENT(IN),OPTIONAL :: minute
4081CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate
4082
4083integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4084
4085
4086TYPE(cyclicdatetime) :: this
4087
4088if (present(chardate)) then
4089
4090 ltendaysp=imiss
4091 lmonth=imiss
4092 lday=imiss
4093 lhour=imiss
4094 lminute=imiss
4095
4096 if (c_e(chardate))then
4097 ! TMMGGhhmm
4098 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4099 !print*,chardate(1:1),ios,ltendaysp
4100 if (ios /= 0)ltendaysp=imiss
4101
4102 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4103 !print*,chardate(2:3),ios,lmonth
4104 if (ios /= 0)lmonth=imiss
4105
4106 read(chardate(4:5),'(i2)',iostat=ios)lday
4107 !print*,chardate(4:5),ios,lday
4108 if (ios /= 0)lday=imiss
4109
4110 read(chardate(6:7),'(i2)',iostat=ios)lhour
4111 !print*,chardate(6:7),ios,lhour
4112 if (ios /= 0)lhour=imiss
4113
4114 read(chardate(8:9),'(i2)',iostat=ios)lminute
4115 !print*,chardate(8:9),ios,lminute
4116 if (ios /= 0)lminute=imiss
4117 end if
4118
4119 this%tendaysp=ltendaysp
4120 this%month=lmonth
4121 this%day=lday
4122 this%hour=lhour
4123 this%minute=lminute
4124else
4125 this%tendaysp=optio_l(tendaysp)
4126 this%month=optio_l(month)
4127 this%day=optio_l(day)
4128 this%hour=optio_l(hour)
4129 this%minute=optio_l(minute)
4130end if
4131
4132END FUNCTION cyclicdatetime_new
4133
4136elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4137TYPE(cyclicdatetime),INTENT(IN) :: this
4138
4139CHARACTER(len=80) :: char
4140
4141char=to_char(this%tendaysp)//";"//to_char(this%month)//";"//to_char(this%day)//";"//&
4142to_char(this%hour)//";"//to_char(this%minute)
4143
4144END FUNCTION cyclicdatetime_to_char
4145
4146
4159FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4160TYPE(cyclicdatetime),INTENT(IN) :: this
4161
4162TYPE(datetime) :: dtc
4163
4164integer :: year,month,day,hour
4165
4166dtc = datetime_miss
4167
4168! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4169if ( .not. c_e(this)) then
4170 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4171 return
4172end if
4173
4174! minute present -> not good for conventional datetime
4175if (c_e(this%minute)) return
4176! day, month and tendaysp present -> no good
4177if (c_e(this%day) .and. c_e(this%month) .and. c_e(this%tendaysp)) return
4178
4179if (c_e(this%day) .and. c_e(this%month)) then
4180 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4181else if (c_e(this%tendaysp) .and. c_e(this%month)) then
4182 day=(this%tendaysp-1)*10+1
4183 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4184else if (c_e(this%month)) then
4185 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4186else if (c_e(this%day)) then
4187 ! only day present -> no good
4188 return
4189end if
4190
4191if (c_e(this%hour)) then
4192 call getval(dtc,year=year,month=month,day=day,hour=hour)
4193 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4194end if
4195
4196
4197END FUNCTION cyclicdatetime_to_conventional
4198
4199
4200
4201FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4202TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4203
4204CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4205
4206char=cyclicdatetime_to_char(in)
4207
4208END FUNCTION trim_cyclicdatetime_to_char
4209
4210
4211
4212SUBROUTINE display_cyclicdatetime(this)
4213TYPE(cyclicdatetime),INTENT(in) :: this
4214
4215print*,"CYCLICDATETIME: ",to_char(this)
4216
4217end subroutine display_cyclicdatetime
4218
4219
4220#include "array_utilities_inc.F90"
4221
4222END MODULE datetime_class
4223
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:251
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.