libsim Versione 7.2.1

◆ 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 2379 del file datetime_class.F90.

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

Generated with Doxygen.