libsim Versione 7.2.0

◆ cyclicdatetime_new()

type(cyclicdatetime) function, public cyclicdatetime_new ( integer, intent(in), optional  tendaysp,
integer, intent(in), optional  month,
integer, intent(in), optional  day,
integer, intent(in), optional  hour,
integer, intent(in), optional  minute,
character(len=9), intent(in), optional  chardate 
)

Costruisce un oggetto cyclicdatetime con i parametri opzionali forniti.

Se non viene passato nulla lo inizializza a missing.

Parametri
[in]tendayspten days period in month (1, 2, 3)
[in]monthmese, default=missing
[in]daymese, default=missing
[in]hourore, default=missing
[in]minuteminuti, default=missing
[in]chardateinizializza l'oggetto ad una data espressa nel formato TMMGGhhmm where any doubled char should be // for missing. This parameter have priority on others also if set to missing.
Restituisce
oggetto da inizializzare

Definizione alla linea 2318 del file datetime_class.F90.

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