libsim Versione 7.1.11

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

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

Generated with Doxygen.