libsim Versione 7.1.11
|
◆ cyclicdatetime_to_conventional()
Restituisce una rappresentazione convenzionale in forma datetime cyclicdatetime. The following conventional code values are used to specify which data was taken into account in the computation: year=1001 : dayly values of a specified month (depends by day and month) year=1002 : dayly,hourly values of a specified month (depends by day and month and hour) year=1003 : 10 day period of a specified month (depends by day(1,11,21) and month) year=1004 : 10 day period of a specified month,hourly (depends by day(1,11,21) and month and hour) year=1005 : mounthly values (depend by month) year=1006 : mounthly,hourly values (depend by month and hour) year=1007 : yearly values (no other time dependence) year=1008 : yearly,hourly values (depend by year and hour) The other conventional month hour and minute should be 01 when they are not significative, day should be 1 or, if year=1003 or year=1004 is used, 1,11 or 21.
Definizione alla linea 2408 del file datetime_class.F90. 2409! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2410! authors:
2411! Davide Cesari <dcesari@arpa.emr.it>
2412! Paolo Patruno <ppatruno@arpa.emr.it>
2413
2414! This program is free software; you can redistribute it and/or
2415! modify it under the terms of the GNU General Public License as
2416! published by the Free Software Foundation; either version 2 of
2417! the License, or (at your option) any later version.
2418
2419! This program is distributed in the hope that it will be useful,
2420! but WITHOUT ANY WARRANTY; without even the implied warranty of
2421! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2422! GNU General Public License for more details.
2423
2424! You should have received a copy of the GNU General Public License
2425! along with this program. If not, see <http://www.gnu.org/licenses/>.
2426#include "config.h"
2427
2448IMPLICIT NONE
2449
2450INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2451
2454 PRIVATE
2455 INTEGER(KIND=int_ll) :: iminuti
2457
2466 PRIVATE
2467 INTEGER(KIND=int_ll) :: iminuti
2468 INTEGER :: month
2470
2471
2476 PRIVATE
2477 INTEGER :: minute
2478 INTEGER :: hour
2479 INTEGER :: day
2480 INTEGER :: tendaysp
2481 INTEGER :: month
2483
2484
2492INTEGER, PARAMETER :: datetime_utc=1
2494INTEGER, PARAMETER :: datetime_local=2
2504TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2505
2506
2507INTEGER(kind=dateint), PARAMETER :: &
2508 sec_in_day=86400, &
2509 sec_in_hour=3600, &
2510 sec_in_min=60, &
2511 min_in_day=1440, &
2512 min_in_hour=60, &
2513 hour_in_day=24
2514
2515INTEGER,PARAMETER :: &
2516 year0=1, & ! anno di origine per iminuti
2517 d1=365, & ! giorni/1 anno nel calendario gregoriano
2518 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2519 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2520 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2521 ianno(13,2)=reshape((/ &
2522 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2523 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2524
2525INTEGER(KIND=int_ll),PARAMETER :: &
2526 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2527
2532 MODULE PROCEDURE datetime_init, timedelta_init
2533END INTERFACE
2534
2538 MODULE PROCEDURE datetime_delete, timedelta_delete
2539END INTERFACE
2540
2543 MODULE PROCEDURE datetime_getval, timedelta_getval
2544END INTERFACE
2545
2548 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2549END INTERFACE
2550
2551
2570 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2571END INTERFACE
2572
2578INTERFACE OPERATOR (==)
2579 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2580 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2581END INTERFACE
2582
2588INTERFACE OPERATOR (/=)
2589 MODULE PROCEDURE datetime_ne, timedelta_ne
2590END INTERFACE
2591
2599INTERFACE OPERATOR (>)
2600 MODULE PROCEDURE datetime_gt, timedelta_gt
2601END INTERFACE
2602
2610INTERFACE OPERATOR (<)
2611 MODULE PROCEDURE datetime_lt, timedelta_lt
2612END INTERFACE
2613
2621INTERFACE OPERATOR (>=)
2622 MODULE PROCEDURE datetime_ge, timedelta_ge
2623END INTERFACE
2624
2632INTERFACE OPERATOR (<=)
2633 MODULE PROCEDURE datetime_le, timedelta_le
2634END INTERFACE
2635
2642INTERFACE OPERATOR (+)
2643 MODULE PROCEDURE datetime_add, timedelta_add
2644END INTERFACE
2645
2653INTERFACE OPERATOR (-)
2654 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
2655END INTERFACE
2656
2662INTERFACE OPERATOR (*)
2663 MODULE PROCEDURE timedelta_mult, timedelta_tlum
2664END INTERFACE
2665
2672INTERFACE OPERATOR (/)
2673 MODULE PROCEDURE timedelta_divint, timedelta_divtd
2674END INTERFACE
2675
2687 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
2688END INTERFACE
2689
2693 MODULE PROCEDURE timedelta_abs
2694END INTERFACE
2695
2699 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
2700 timedelta_read_unit, timedelta_vect_read_unit
2701END INTERFACE
2702
2706 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
2707 timedelta_write_unit, timedelta_vect_write_unit
2708END INTERFACE
2709
2712 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
2713END INTERFACE
2714
2717 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
2718END INTERFACE
2719
2720#undef VOL7D_POLY_TYPE
2721#undef VOL7D_POLY_TYPES
2722#undef ENABLE_SORT
2723#define VOL7D_POLY_TYPE TYPE(datetime)
2724#define VOL7D_POLY_TYPES _datetime
2725#define ENABLE_SORT
2726#include "array_utilities_pre.F90"
2727
2728
2729#define ARRAYOF_ORIGTYPE TYPE(datetime)
2730#define ARRAYOF_TYPE arrayof_datetime
2731#define ARRAYOF_ORIGEQ 1
2732#include "arrayof_pre.F90"
2733! from arrayof
2734
2735PRIVATE
2736
2738 datetime_min, datetime_max, &
2741 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
2742 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
2744 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
2745 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
2747 count_distinct, pack_distinct, &
2748 count_distinct_sorted, pack_distinct_sorted, &
2749 count_and_pack_distinct, &
2751 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
2753PUBLIC insert_unique, append_unique
2754PUBLIC cyclicdatetime_to_conventional
2755
2756CONTAINS
2757
2758
2759! ==============
2760! == datetime ==
2761! ==============
2762
2769ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
2770 unixtime, isodate, simpledate) RESULT(this)
2771INTEGER,INTENT(IN),OPTIONAL :: year
2772INTEGER,INTENT(IN),OPTIONAL :: month
2773INTEGER,INTENT(IN),OPTIONAL :: day
2774INTEGER,INTENT(IN),OPTIONAL :: hour
2775INTEGER,INTENT(IN),OPTIONAL :: minute
2776INTEGER,INTENT(IN),OPTIONAL :: msec
2777INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2778CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2779CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2780
2781TYPE(datetime) :: this
2782INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2783CHARACTER(len=23) :: datebuf
2784
2785IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
2786 lyear = year
2787 IF (PRESENT(month)) THEN
2788 lmonth = month
2789 ELSE
2790 lmonth = 1
2791 ENDIF
2792 IF (PRESENT(day)) THEN
2793 lday = day
2794 ELSE
2795 lday = 1
2796 ENDIF
2797 IF (PRESENT(hour)) THEN
2798 lhour = hour
2799 ELSE
2800 lhour = 0
2801 ENDIF
2802 IF (PRESENT(minute)) THEN
2803 lminute = minute
2804 ELSE
2805 lminute = 0
2806 ENDIF
2807 IF (PRESENT(msec)) THEN
2808 lmsec = msec
2809 ELSE
2810 lmsec = 0
2811 ENDIF
2812
2815 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2816 else
2817 this=datetime_miss
2818 end if
2819
2820ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
2822 this%iminuti = (unixtime + unsec)*1000
2823 else
2824 this=datetime_miss
2825 end if
2826
2827ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
2828
2830 datebuf(1:23) = '0001-01-01 00:00:00.000'
2831 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
2832 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
2833 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2834 lmsec = lmsec + lsec*1000
2835 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2836 RETURN
2837
2838100 CONTINUE ! condizione di errore in isodate
2840 RETURN
2841 ELSE
2842 this = datetime_miss
2843 ENDIF
2844
2845ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
2847 datebuf(1:17) = '00010101000000000'
2848 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2849 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
2850 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2851 lmsec = lmsec + lsec*1000
2852 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2853 RETURN
2854
2855120 CONTINUE ! condizione di errore in simpledate
2857 RETURN
2858 ELSE
2859 this = datetime_miss
2860 ENDIF
2861
2862ELSE
2863 this = datetime_miss
2864ENDIF
2865
2866END FUNCTION datetime_new
2867
2868
2870FUNCTION datetime_new_now(now) RESULT(this)
2871INTEGER,INTENT(IN) :: now
2872TYPE(datetime) :: this
2873
2874INTEGER :: dt(8)
2875
2877 CALL date_and_time(values=dt)
2878 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
2880 msec=dt(7)*1000+dt(8))
2881ELSE
2882 this = datetime_miss
2883ENDIF
2884
2885END FUNCTION datetime_new_now
2886
2887
2894SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
2895 unixtime, isodate, simpledate, now)
2896TYPE(datetime),INTENT(INOUT) :: this
2897INTEGER,INTENT(IN),OPTIONAL :: year
2898INTEGER,INTENT(IN),OPTIONAL :: month
2899INTEGER,INTENT(IN),OPTIONAL :: day
2900INTEGER,INTENT(IN),OPTIONAL :: hour
2901INTEGER,INTENT(IN),OPTIONAL :: minute
2902INTEGER,INTENT(IN),OPTIONAL :: msec
2903INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2904CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2905CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2906INTEGER,INTENT(IN),OPTIONAL :: now
2907
2908IF (PRESENT(now)) THEN
2909 this = datetime_new_now(now)
2910ELSE
2911 this = datetime_new(year, month, day, hour, minute, msec, &
2912 unixtime, isodate, simpledate)
2913ENDIF
2914
2915END SUBROUTINE datetime_init
2916
2917
2918ELEMENTAL SUBROUTINE datetime_delete(this)
2919TYPE(datetime),INTENT(INOUT) :: this
2920
2921this%iminuti = illmiss
2922
2923END SUBROUTINE datetime_delete
2924
2925
2930PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
2931 unixtime, isodate, simpledate, oraclesimdate)
2932TYPE(datetime),INTENT(IN) :: this
2933INTEGER,INTENT(OUT),OPTIONAL :: year
2934INTEGER,INTENT(OUT),OPTIONAL :: month
2935INTEGER,INTENT(OUT),OPTIONAL :: day
2936INTEGER,INTENT(OUT),OPTIONAL :: hour
2937INTEGER,INTENT(OUT),OPTIONAL :: minute
2938INTEGER,INTENT(OUT),OPTIONAL :: msec
2939INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime
2940CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
2941CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
2942CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
2943
2944INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2945CHARACTER(len=23) :: datebuf
2946
2947IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
2948 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
2949 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
2950
2951 IF (this == datetime_miss) THEN
2952
2953 IF (PRESENT(msec)) THEN
2954 msec = imiss
2955 ENDIF
2956 IF (PRESENT(minute)) THEN
2957 minute = imiss
2958 ENDIF
2959 IF (PRESENT(hour)) THEN
2960 hour = imiss
2961 ENDIF
2962 IF (PRESENT(day)) THEN
2963 day = imiss
2964 ENDIF
2965 IF (PRESENT(month)) THEN
2966 month = imiss
2967 ENDIF
2968 IF (PRESENT(year)) THEN
2969 year = imiss
2970 ENDIF
2971 IF (PRESENT(isodate)) THEN
2972 isodate = cmiss
2973 ENDIF
2974 IF (PRESENT(simpledate)) THEN
2975 simpledate = cmiss
2976 ENDIF
2977 IF (PRESENT(oraclesimdate)) THEN
2978!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2979!!$ 'obsoleto, usare piuttosto simpledate')
2980 oraclesimdate=cmiss
2981 ENDIF
2982 IF (PRESENT(unixtime)) THEN
2983 unixtime = illmiss
2984 ENDIF
2985
2986 ELSE
2987
2988 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2989 IF (PRESENT(msec)) THEN
2990 msec = lmsec
2991 ENDIF
2992 IF (PRESENT(minute)) THEN
2993 minute = lminute
2994 ENDIF
2995 IF (PRESENT(hour)) THEN
2996 hour = lhour
2997 ENDIF
2998 IF (PRESENT(day)) THEN
2999 day = lday
3000 ENDIF
3001 IF (PRESENT(month)) THEN
3002 month = lmonth
3003 ENDIF
3004 IF (PRESENT(year)) THEN
3005 year = lyear
3006 ENDIF
3007 IF (PRESENT(isodate)) THEN
3008 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3009 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
3011 isodate = datebuf(1:min(len(isodate),23))
3012 ENDIF
3013 IF (PRESENT(simpledate)) THEN
3014 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
3015 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
3016 simpledate = datebuf(1:min(len(simpledate),17))
3017 ENDIF
3018 IF (PRESENT(oraclesimdate)) THEN
3019!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3020!!$ 'obsoleto, usare piuttosto simpledate')
3021 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
3022 ENDIF
3023 IF (PRESENT(unixtime)) THEN
3024 unixtime = this%iminuti/1000_int_ll-unsec
3025 ENDIF
3026
3027 ENDIF
3028ENDIF
3029
3030END SUBROUTINE datetime_getval
3031
3032
3035elemental FUNCTION datetime_to_char(this) RESULT(char)
3036TYPE(datetime),INTENT(IN) :: this
3037
3038CHARACTER(len=23) :: char
3039
3041
3042END FUNCTION datetime_to_char
3043
3044
3045FUNCTION trim_datetime_to_char(in) RESULT(char)
3046TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3047
3048CHARACTER(len=len_trim(datetime_to_char(in))) :: char
3049
3050char=datetime_to_char(in)
3051
3052END FUNCTION trim_datetime_to_char
3053
3054
3055
3056SUBROUTINE display_datetime(this)
3057TYPE(datetime),INTENT(in) :: this
3058
3060
3061end subroutine display_datetime
3062
3063
3064
3065SUBROUTINE display_timedelta(this)
3066TYPE(timedelta),INTENT(in) :: this
3067
3069
3070end subroutine display_timedelta
3071
3072
3073
3074ELEMENTAL FUNCTION c_e_datetime(this) result (res)
3075TYPE(datetime),INTENT(in) :: this
3076LOGICAL :: res
3077
3078res = .not. this == datetime_miss
3079
3080end FUNCTION c_e_datetime
3081
3082
3083ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
3084TYPE(datetime),INTENT(IN) :: this, that
3085LOGICAL :: res
3086
3087res = this%iminuti == that%iminuti
3088
3089END FUNCTION datetime_eq
3090
3091
3092ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3093TYPE(datetime),INTENT(IN) :: this, that
3094LOGICAL :: res
3095
3096res = .NOT.(this == that)
3097
3098END FUNCTION datetime_ne
3099
3100
3101ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3102TYPE(datetime),INTENT(IN) :: this, that
3103LOGICAL :: res
3104
3105res = this%iminuti > that%iminuti
3106
3107END FUNCTION datetime_gt
3108
3109
3110ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3111TYPE(datetime),INTENT(IN) :: this, that
3112LOGICAL :: res
3113
3114res = this%iminuti < that%iminuti
3115
3116END FUNCTION datetime_lt
3117
3118
3119ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3120TYPE(datetime),INTENT(IN) :: this, that
3121LOGICAL :: res
3122
3123IF (this == that) THEN
3124 res = .true.
3125ELSE IF (this > that) THEN
3126 res = .true.
3127ELSE
3128 res = .false.
3129ENDIF
3130
3131END FUNCTION datetime_ge
3132
3133
3134ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3135TYPE(datetime),INTENT(IN) :: this, that
3136LOGICAL :: res
3137
3138IF (this == that) THEN
3139 res = .true.
3140ELSE IF (this < that) THEN
3141 res = .true.
3142ELSE
3143 res = .false.
3144ENDIF
3145
3146END FUNCTION datetime_le
3147
3148
3149FUNCTION datetime_add(this, that) RESULT(res)
3150TYPE(datetime),INTENT(IN) :: this
3151TYPE(timedelta),INTENT(IN) :: that
3152TYPE(datetime) :: res
3153
3154INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3155
3156IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3157 res = datetime_miss
3158ELSE
3159 res%iminuti = this%iminuti + that%iminuti
3160 IF (that%month /= 0) THEN
3162 minute=lminute, msec=lmsec)
3164 hour=lhour, minute=lminute, msec=lmsec)
3165 ENDIF
3166ENDIF
3167
3168END FUNCTION datetime_add
3169
3170
3171ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3172TYPE(datetime),INTENT(IN) :: this, that
3173TYPE(timedelta) :: res
3174
3175IF (this == datetime_miss .OR. that == datetime_miss) THEN
3176 res = timedelta_miss
3177ELSE
3178 res%iminuti = this%iminuti - that%iminuti
3179 res%month = 0
3180ENDIF
3181
3182END FUNCTION datetime_subdt
3183
3184
3185FUNCTION datetime_subtd(this, that) RESULT(res)
3186TYPE(datetime),INTENT(IN) :: this
3187TYPE(timedelta),INTENT(IN) :: that
3188TYPE(datetime) :: res
3189
3190INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3191
3192IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3193 res = datetime_miss
3194ELSE
3195 res%iminuti = this%iminuti - that%iminuti
3196 IF (that%month /= 0) THEN
3198 minute=lminute, msec=lmsec)
3200 hour=lhour, minute=lminute, msec=lmsec)
3201 ENDIF
3202ENDIF
3203
3204END FUNCTION datetime_subtd
3205
3206
3211SUBROUTINE datetime_read_unit(this, unit)
3212TYPE(datetime),INTENT(out) :: this
3213INTEGER, INTENT(in) :: unit
3214CALL datetime_vect_read_unit((/this/), unit)
3215
3216END SUBROUTINE datetime_read_unit
3217
3218
3223SUBROUTINE datetime_vect_read_unit(this, unit)
3224TYPE(datetime) :: this(:)
3225INTEGER, INTENT(in) :: unit
3226
3227CHARACTER(len=40) :: form
3228CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3229INTEGER :: i
3230
3231ALLOCATE(dateiso(SIZE(this)))
3232INQUIRE(unit, form=form)
3233IF (form == 'FORMATTED') THEN
3234 READ(unit,'(A23,1X)')dateiso
3235ELSE
3236 READ(unit)dateiso
3237ENDIF
3238DO i = 1, SIZE(dateiso)
3240ENDDO
3241DEALLOCATE(dateiso)
3242
3243END SUBROUTINE datetime_vect_read_unit
3244
3245
3250SUBROUTINE datetime_write_unit(this, unit)
3251TYPE(datetime),INTENT(in) :: this
3252INTEGER, INTENT(in) :: unit
3253
3254CALL datetime_vect_write_unit((/this/), unit)
3255
3256END SUBROUTINE datetime_write_unit
3257
3258
3263SUBROUTINE datetime_vect_write_unit(this, unit)
3264TYPE(datetime),INTENT(in) :: this(:)
3265INTEGER, INTENT(in) :: unit
3266
3267CHARACTER(len=40) :: form
3268CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3269INTEGER :: i
3270
3271ALLOCATE(dateiso(SIZE(this)))
3272DO i = 1, SIZE(dateiso)
3274ENDDO
3275INQUIRE(unit, form=form)
3276IF (form == 'FORMATTED') THEN
3277 WRITE(unit,'(A23,1X)')dateiso
3278ELSE
3279 WRITE(unit)dateiso
3280ENDIF
3281DEALLOCATE(dateiso)
3282
3283END SUBROUTINE datetime_vect_write_unit
3284
3285
3286#include "arrayof_post.F90"
3287
3288
3289! ===============
3290! == timedelta ==
3291! ===============
3298FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3299 isodate, simpledate, oraclesimdate) RESULT (this)
3300INTEGER,INTENT(IN),OPTIONAL :: year
3301INTEGER,INTENT(IN),OPTIONAL :: month
3302INTEGER,INTENT(IN),OPTIONAL :: day
3303INTEGER,INTENT(IN),OPTIONAL :: hour
3304INTEGER,INTENT(IN),OPTIONAL :: minute
3305INTEGER,INTENT(IN),OPTIONAL :: sec
3306INTEGER,INTENT(IN),OPTIONAL :: msec
3307CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3308CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3309CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3310
3311TYPE(timedelta) :: this
3312
3313CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3314 isodate, simpledate, oraclesimdate)
3315
3316END FUNCTION timedelta_new
3317
3318
3323SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3324 isodate, simpledate, oraclesimdate)
3325TYPE(timedelta),INTENT(INOUT) :: this
3326INTEGER,INTENT(IN),OPTIONAL :: year
3327INTEGER,INTENT(IN),OPTIONAL :: month
3328INTEGER,INTENT(IN),OPTIONAL :: day
3329INTEGER,INTENT(IN),OPTIONAL :: hour
3330INTEGER,INTENT(IN),OPTIONAL :: minute
3331INTEGER,INTENT(IN),OPTIONAL :: sec
3332INTEGER,INTENT(IN),OPTIONAL :: msec
3333CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3334CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3335CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3336
3337INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3338CHARACTER(len=23) :: datebuf
3339
3340this%month = 0
3341
3342IF (PRESENT(isodate)) THEN
3343 datebuf(1:23) = '0000000000 00:00:00.000'
3344 l = len_trim(isodate)
3345! IF (l > 0) THEN
3347 IF (n > 0) THEN
3348 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3349 datebuf(12-n:12-n+l-1) = isodate(:l)
3350 ELSE
3351 datebuf(1:l) = isodate(1:l)
3352 ENDIF
3353! ENDIF
3354
3355! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3356 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3357 h, m, s, ms
3358 this%month = lmonth + 12*lyear
3359 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3360 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3361 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3362 RETURN
3363
3364200 CONTINUE ! condizione di errore in isodate
3366 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3367 CALL raise_error()
3368
3369ELSE IF (PRESENT(simpledate)) THEN
3370 datebuf(1:17) = '00000000000000000'
3371 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3372 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3373 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3374 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3375 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3376
3377220 CONTINUE ! condizione di errore in simpledate
3379 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3380 CALL raise_error()
3381 RETURN
3382
3383ELSE IF (PRESENT(oraclesimdate)) THEN
3384 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3385 'obsoleto, usare piuttosto simpledate')
3386 READ(oraclesimdate, '(I8,2I2)')d, h, m
3387 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3388 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3389
3390ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3391 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3392 .and. .not. present(msec) .and. .not. present(isodate) &
3393 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3394
3395 this=timedelta_miss
3396
3397ELSE
3398 this%iminuti = 0
3399 IF (PRESENT(year)) THEN
3401 this%month = this%month + year*12
3402 else
3403 this=timedelta_miss
3404 return
3405 end if
3406 ENDIF
3407 IF (PRESENT(month)) THEN
3409 this%month = this%month + month
3410 else
3411 this=timedelta_miss
3412 return
3413 end if
3414 ENDIF
3415 IF (PRESENT(day)) THEN
3417 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3418 else
3419 this=timedelta_miss
3420 return
3421 end if
3422 ENDIF
3423 IF (PRESENT(hour)) THEN
3425 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3426 else
3427 this=timedelta_miss
3428 return
3429 end if
3430 ENDIF
3431 IF (PRESENT(minute)) THEN
3433 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3434 else
3435 this=timedelta_miss
3436 return
3437 end if
3438 ENDIF
3439 IF (PRESENT(sec)) THEN
3441 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3442 else
3443 this=timedelta_miss
3444 return
3445 end if
3446 ENDIF
3447 IF (PRESENT(msec)) THEN
3449 this%iminuti = this%iminuti + msec
3450 else
3451 this=timedelta_miss
3452 return
3453 end if
3454 ENDIF
3455ENDIF
3456
3457
3458
3459
3460END SUBROUTINE timedelta_init
3461
3462
3463SUBROUTINE timedelta_delete(this)
3464TYPE(timedelta),INTENT(INOUT) :: this
3465
3466this%iminuti = imiss
3467this%month = 0
3468
3469END SUBROUTINE timedelta_delete
3470
3471
3476PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3477 day, hour, minute, sec, msec, &
3478 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3479TYPE(timedelta),INTENT(IN) :: this
3480INTEGER,INTENT(OUT),OPTIONAL :: year
3481INTEGER,INTENT(OUT),OPTIONAL :: month
3482INTEGER,INTENT(OUT),OPTIONAL :: amonth
3483INTEGER,INTENT(OUT),OPTIONAL :: day
3484INTEGER,INTENT(OUT),OPTIONAL :: hour
3485INTEGER,INTENT(OUT),OPTIONAL :: minute
3486INTEGER,INTENT(OUT),OPTIONAL :: sec
3487INTEGER,INTENT(OUT),OPTIONAL :: msec
3488INTEGER,INTENT(OUT),OPTIONAL :: ahour
3489INTEGER,INTENT(OUT),OPTIONAL :: aminute
3490INTEGER,INTENT(OUT),OPTIONAL :: asec
3491INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec
3492CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3493CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3494CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3495
3496CHARACTER(len=23) :: datebuf
3497
3498IF (PRESENT(amsec)) THEN
3499 amsec = this%iminuti
3500ENDIF
3501IF (PRESENT(asec)) THEN
3502 asec = int(this%iminuti/1000_int_ll)
3503ENDIF
3504IF (PRESENT(aminute)) THEN
3505 aminute = int(this%iminuti/60000_int_ll)
3506ENDIF
3507IF (PRESENT(ahour)) THEN
3508 ahour = int(this%iminuti/3600000_int_ll)
3509ENDIF
3510IF (PRESENT(msec)) THEN
3511 msec = int(mod(this%iminuti, 1000_int_ll))
3512ENDIF
3513IF (PRESENT(sec)) THEN
3514 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3515ENDIF
3516IF (PRESENT(minute)) THEN
3517 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3518ENDIF
3519IF (PRESENT(hour)) THEN
3520 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3521ENDIF
3522IF (PRESENT(day)) THEN
3523 day = int(this%iminuti/86400000_int_ll)
3524ENDIF
3525IF (PRESENT(amonth)) THEN
3526 amonth = this%month
3527ENDIF
3528IF (PRESENT(month)) THEN
3529 month = mod(this%month-1,12)+1
3530ENDIF
3531IF (PRESENT(year)) THEN
3532 year = this%month/12
3533ENDIF
3534IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3535 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3539 isodate = datebuf(1:min(len(isodate),23))
3540
3541ENDIF
3542IF (PRESENT(simpledate)) THEN
3543 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3544 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3546 mod(this%iminuti, 1000_int_ll)
3547 simpledate = datebuf(1:min(len(simpledate),17))
3548ENDIF
3549IF (PRESENT(oraclesimdate)) THEN
3550!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3551!!$ 'obsoleto, usare piuttosto simpledate')
3552 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3554ENDIF
3555
3556END SUBROUTINE timedelta_getval
3557
3558
3561elemental FUNCTION timedelta_to_char(this) RESULT(char)
3562TYPE(timedelta),INTENT(IN) :: this
3563
3564CHARACTER(len=23) :: char
3565
3567
3568END FUNCTION timedelta_to_char
3569
3570
3571FUNCTION trim_timedelta_to_char(in) RESULT(char)
3572TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3573
3574CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3575
3576char=timedelta_to_char(in)
3577
3578END FUNCTION trim_timedelta_to_char
3579
3580
3582elemental FUNCTION timedelta_getamsec(this)
3583TYPE(timedelta),INTENT(IN) :: this
3584INTEGER(kind=int_ll) :: timedelta_getamsec
3585
3586timedelta_getamsec = this%iminuti
3587
3588END FUNCTION timedelta_getamsec
3589
3590
3596FUNCTION timedelta_depop(this)
3597TYPE(timedelta),INTENT(IN) :: this
3598TYPE(timedelta) :: timedelta_depop
3599
3600TYPE(datetime) :: tmpdt
3601
3602IF (this%month == 0) THEN
3603 timedelta_depop = this
3604ELSE
3605 tmpdt = datetime_new(1970, 1, 1)
3606 timedelta_depop = (tmpdt + this) - tmpdt
3607ENDIF
3608
3609END FUNCTION timedelta_depop
3610
3611
3612elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3613TYPE(timedelta),INTENT(IN) :: this, that
3614LOGICAL :: res
3615
3616res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3617
3618END FUNCTION timedelta_eq
3619
3620
3621ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3622TYPE(timedelta),INTENT(IN) :: this, that
3623LOGICAL :: res
3624
3625res = .NOT.(this == that)
3626
3627END FUNCTION timedelta_ne
3628
3629
3630ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
3631TYPE(timedelta),INTENT(IN) :: this, that
3632LOGICAL :: res
3633
3634res = this%iminuti > that%iminuti
3635
3636END FUNCTION timedelta_gt
3637
3638
3639ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
3640TYPE(timedelta),INTENT(IN) :: this, that
3641LOGICAL :: res
3642
3643res = this%iminuti < that%iminuti
3644
3645END FUNCTION timedelta_lt
3646
3647
3648ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
3649TYPE(timedelta),INTENT(IN) :: this, that
3650LOGICAL :: res
3651
3652IF (this == that) THEN
3653 res = .true.
3654ELSE IF (this > that) THEN
3655 res = .true.
3656ELSE
3657 res = .false.
3658ENDIF
3659
3660END FUNCTION timedelta_ge
3661
3662
3663elemental FUNCTION timedelta_le(this, that) RESULT(res)
3664TYPE(timedelta),INTENT(IN) :: this, that
3665LOGICAL :: res
3666
3667IF (this == that) THEN
3668 res = .true.
3669ELSE IF (this < that) THEN
3670 res = .true.
3671ELSE
3672 res = .false.
3673ENDIF
3674
3675END FUNCTION timedelta_le
3676
3677
3678ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
3679TYPE(timedelta),INTENT(IN) :: this, that
3680TYPE(timedelta) :: res
3681
3682res%iminuti = this%iminuti + that%iminuti
3683res%month = this%month + that%month
3684
3685END FUNCTION timedelta_add
3686
3687
3688ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
3689TYPE(timedelta),INTENT(IN) :: this, that
3690TYPE(timedelta) :: res
3691
3692res%iminuti = this%iminuti - that%iminuti
3693res%month = this%month - that%month
3694
3695END FUNCTION timedelta_sub
3696
3697
3698ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
3699TYPE(timedelta),INTENT(IN) :: this
3700INTEGER,INTENT(IN) :: n
3701TYPE(timedelta) :: res
3702
3703res%iminuti = this%iminuti*n
3704res%month = this%month*n
3705
3706END FUNCTION timedelta_mult
3707
3708
3709ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
3710INTEGER,INTENT(IN) :: n
3711TYPE(timedelta),INTENT(IN) :: this
3712TYPE(timedelta) :: res
3713
3714res%iminuti = this%iminuti*n
3715res%month = this%month*n
3716
3717END FUNCTION timedelta_tlum
3718
3719
3720ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
3721TYPE(timedelta),INTENT(IN) :: this
3722INTEGER,INTENT(IN) :: n
3723TYPE(timedelta) :: res
3724
3725res%iminuti = this%iminuti/n
3726res%month = this%month/n
3727
3728END FUNCTION timedelta_divint
3729
3730
3731ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
3732TYPE(timedelta),INTENT(IN) :: this, that
3733INTEGER :: res
3734
3735res = int(this%iminuti/that%iminuti)
3736
3737END FUNCTION timedelta_divtd
3738
3739
3740elemental FUNCTION timedelta_mod(this, that) RESULT(res)
3741TYPE(timedelta),INTENT(IN) :: this, that
3742TYPE(timedelta) :: res
3743
3744res%iminuti = mod(this%iminuti, that%iminuti)
3745res%month = 0
3746
3747END FUNCTION timedelta_mod
3748
3749
3750ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
3751TYPE(datetime),INTENT(IN) :: this
3752TYPE(timedelta),INTENT(IN) :: that
3753TYPE(timedelta) :: res
3754
3755IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
3756 res = timedelta_0
3757ELSE
3758 res%iminuti = mod(this%iminuti, that%iminuti)
3759 res%month = 0
3760ENDIF
3761
3762END FUNCTION datetime_timedelta_mod
3763
3764
3765ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
3766TYPE(timedelta),INTENT(IN) :: this
3767TYPE(timedelta) :: res
3768
3769res%iminuti = abs(this%iminuti)
3770res%month = abs(this%month)
3771
3772END FUNCTION timedelta_abs
3773
3774
3779SUBROUTINE timedelta_read_unit(this, unit)
3780TYPE(timedelta),INTENT(out) :: this
3781INTEGER, INTENT(in) :: unit
3782
3783CALL timedelta_vect_read_unit((/this/), unit)
3784
3785END SUBROUTINE timedelta_read_unit
3786
3787
3792SUBROUTINE timedelta_vect_read_unit(this, unit)
3793TYPE(timedelta) :: this(:)
3794INTEGER, INTENT(in) :: unit
3795
3796CHARACTER(len=40) :: form
3797CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3798INTEGER :: i
3799
3800ALLOCATE(dateiso(SIZE(this)))
3801INQUIRE(unit, form=form)
3802IF (form == 'FORMATTED') THEN
3803 READ(unit,'(3(A23,1X))')dateiso
3804ELSE
3805 READ(unit)dateiso
3806ENDIF
3807DO i = 1, SIZE(dateiso)
3809ENDDO
3810DEALLOCATE(dateiso)
3811
3812END SUBROUTINE timedelta_vect_read_unit
3813
3814
3819SUBROUTINE timedelta_write_unit(this, unit)
3820TYPE(timedelta),INTENT(in) :: this
3821INTEGER, INTENT(in) :: unit
3822
3823CALL timedelta_vect_write_unit((/this/), unit)
3824
3825END SUBROUTINE timedelta_write_unit
3826
3827
3832SUBROUTINE timedelta_vect_write_unit(this, unit)
3833TYPE(timedelta),INTENT(in) :: this(:)
3834INTEGER, INTENT(in) :: unit
3835
3836CHARACTER(len=40) :: form
3837CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3838INTEGER :: i
3839
3840ALLOCATE(dateiso(SIZE(this)))
3841DO i = 1, SIZE(dateiso)
3843ENDDO
3844INQUIRE(unit, form=form)
3845IF (form == 'FORMATTED') THEN
3846 WRITE(unit,'(3(A23,1X))')dateiso
3847ELSE
3848 WRITE(unit)dateiso
3849ENDIF
3850DEALLOCATE(dateiso)
3851
3852END SUBROUTINE timedelta_vect_write_unit
3853
3854
3855ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
3856TYPE(timedelta),INTENT(in) :: this
3857LOGICAL :: res
3858
3859res = .not. this == timedelta_miss
3860
3861end FUNCTION c_e_timedelta
3862
3863
3864elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
3865
3866!!omstart JELADATA5
3867! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3868! 1 IMINUTI)
3869!
3870! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
3871!
3872! variabili integer*4
3873! IN:
3874! IDAY,IMONTH,IYEAR, I*4
3875! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3876!
3877! OUT:
3878! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3879!!OMEND
3880
3881INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
3882INTEGER,intent(out) :: iminuti
3883
3884iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
3885
3886END SUBROUTINE jeladata5
3887
3888
3889elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
3890INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
3891INTEGER(KIND=int_ll),intent(out) :: imillisec
3892
3893imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
3894 + imsec
3895
3896END SUBROUTINE jeladata5_1
3897
3898
3899
3900elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
3901
3902!!omstart JELADATA6
3903! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3904! 1 IMINUTI)
3905!
3906! Calcola la data e l'ora corrispondente a IMINUTI dopo il
3907! 1/1/1
3908!
3909! variabili integer*4
3910! IN:
3911! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3912!
3913! OUT:
3914! IDAY,IMONTH,IYEAR, I*4
3915! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3916!!OMEND
3917
3918
3919INTEGER,intent(in) :: iminuti
3920INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
3921
3922INTEGER ::igiorno
3923
3924imin = mod(iminuti,60)
3925ihour = mod(iminuti,1440)/60
3926igiorno = iminuti/1440
3928CALL ndyin(igiorno,iday,imonth,iyear)
3929
3930END SUBROUTINE jeladata6
3931
3932
3933elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
3934INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
3935INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
3936
3937INTEGER :: igiorno
3938
3940!imin = MOD(imillisec/60000_int_ll, 60)
3941!ihour = MOD(imillisec/3600000_int_ll, 24)
3942imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
3943ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
3944igiorno = int(imillisec/86400000_int_ll)
3945!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
3946CALL ndyin(igiorno,iday,imonth,iyear)
3947
3948END SUBROUTINE jeladata6_1
3949
3950
3951elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
3952
3953!!OMSTART NDYIN
3954! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
3955! restituisce la data fornendo in input il numero di
3956! giorni dal 1/1/1
3957!
3958!!omend
3959
3960INTEGER,intent(in) :: ndays
3961INTEGER,intent(out) :: igg, imm, iaa
3962integer :: n,lndays
3963
3964lndays=ndays
3965
3966n = lndays/d400
3967lndays = lndays - n*d400
3968iaa = year0 + n*400
3969n = min(lndays/d100, 3)
3970lndays = lndays - n*d100
3971iaa = iaa + n*100
3972n = lndays/d4
3973lndays = lndays - n*d4
3974iaa = iaa + n*4
3975n = min(lndays/d1, 3)
3976lndays = lndays - n*d1
3977iaa = iaa + n
3978n = bisextilis(iaa)
3979DO imm = 1, 12
3980 IF (lndays < ianno(imm+1,n)) EXIT
3981ENDDO
3982igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
3983
3984END SUBROUTINE ndyin
3985
3986
3987integer elemental FUNCTION ndays(igg,imm,iaa)
3988
3989!!OMSTART NDAYS
3990! FUNCTION NDAYS(IGG,IMM,IAA)
3991! restituisce il numero di giorni dal 1/1/1
3992! fornendo in input la data
3993!
3994!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3995! nota bene E' SICURO !!!
3996! un anno e' bisestile se divisibile per 4
3997! un anno rimane bisestile se divisibile per 400
3998! un anno NON e' bisestile se divisibile per 100
3999!
4000!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4001!
4002!!omend
4003
4004INTEGER, intent(in) :: igg, imm, iaa
4005
4006INTEGER :: lmonth, lyear
4007
4008! Limito il mese a [1-12] e correggo l'anno coerentemente
4009lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
4010lyear = iaa + (imm - lmonth)/12
4011ndays = igg+ianno(lmonth, bisextilis(lyear))
4012ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
4013 (lyear-year0)/400
4014
4015END FUNCTION ndays
4016
4017
4018elemental FUNCTION bisextilis(annum)
4019INTEGER,INTENT(in) :: annum
4020INTEGER :: bisextilis
4021
4023 bisextilis = 2
4024ELSE
4025 bisextilis = 1
4026ENDIF
4027END FUNCTION bisextilis
4028
4029
4030ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
4031TYPE(cyclicdatetime),INTENT(IN) :: this, that
4032LOGICAL :: res
4033
4034res = .true.
4035if (this%minute /= that%minute) res=.false.
4036if (this%hour /= that%hour) res=.false.
4037if (this%day /= that%day) res=.false.
4038if (this%month /= that%month) res=.false.
4039if (this%tendaysp /= that%tendaysp) res=.false.
4040
4041END FUNCTION cyclicdatetime_eq
4042
4043
4044ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
4045TYPE(cyclicdatetime),INTENT(IN) :: this
4046TYPE(datetime),INTENT(IN) :: that
4047LOGICAL :: res
4048
4049integer :: minute,hour,day,month
4050
4052
4053res = .true.
4059 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4060end if
4061
4062END FUNCTION cyclicdatetime_datetime_eq
4063
4064
4065ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
4066TYPE(datetime),INTENT(IN) :: this
4067TYPE(cyclicdatetime),INTENT(IN) :: that
4068LOGICAL :: res
4069
4070integer :: minute,hour,day,month
4071
4073
4074res = .true.
4079
4081 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4082end if
4083
4084
4085END FUNCTION datetime_cyclicdatetime_eq
4086
4087ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
4088TYPE(cyclicdatetime),INTENT(in) :: this
4089LOGICAL :: res
4090
4091res = .not. this == cyclicdatetime_miss
4092
4093end FUNCTION c_e_cyclicdatetime
4094
4095
4098FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4099INTEGER,INTENT(IN),OPTIONAL :: tendaysp
4100INTEGER,INTENT(IN),OPTIONAL :: month
4101INTEGER,INTENT(IN),OPTIONAL :: day
4102INTEGER,INTENT(IN),OPTIONAL :: hour
4103INTEGER,INTENT(IN),OPTIONAL :: minute
4104CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate
4105
4106integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4107
4108
4109TYPE(cyclicdatetime) :: this
4110
4111if (present(chardate)) then
4112
4113 ltendaysp=imiss
4114 lmonth=imiss
4115 lday=imiss
4116 lhour=imiss
4117 lminute=imiss
4118
4120 ! TMMGGhhmm
4121 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4122 !print*,chardate(1:1),ios,ltendaysp
4123 if (ios /= 0)ltendaysp=imiss
4124
4125 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4126 !print*,chardate(2:3),ios,lmonth
4127 if (ios /= 0)lmonth=imiss
4128
4129 read(chardate(4:5),'(i2)',iostat=ios)lday
4130 !print*,chardate(4:5),ios,lday
4131 if (ios /= 0)lday=imiss
4132
4133 read(chardate(6:7),'(i2)',iostat=ios)lhour
4134 !print*,chardate(6:7),ios,lhour
4135 if (ios /= 0)lhour=imiss
4136
4137 read(chardate(8:9),'(i2)',iostat=ios)lminute
4138 !print*,chardate(8:9),ios,lminute
4139 if (ios /= 0)lminute=imiss
4140 end if
4141
4142 this%tendaysp=ltendaysp
4143 this%month=lmonth
4144 this%day=lday
4145 this%hour=lhour
4146 this%minute=lminute
4147else
4148 this%tendaysp=optio_l(tendaysp)
4149 this%month=optio_l(month)
4150 this%day=optio_l(day)
4151 this%hour=optio_l(hour)
4152 this%minute=optio_l(minute)
4153end if
4154
4155END FUNCTION cyclicdatetime_new
4156
4159elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4160TYPE(cyclicdatetime),INTENT(IN) :: this
4161
4162CHARACTER(len=80) :: char
4163
4166
4167END FUNCTION cyclicdatetime_to_char
4168
4169
4182FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4183TYPE(cyclicdatetime),INTENT(IN) :: this
4184
4185TYPE(datetime) :: dtc
4186
4187integer :: year,month,day,hour
4188
4189dtc = datetime_miss
4190
4191! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4193 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4194 return
4195end if
4196
4197! minute present -> not good for conventional datetime
4199! day, month and tendaysp present -> no good
4201
4203 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4205 day=(this%tendaysp-1)*10+1
4206 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4208 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4210 ! only day present -> no good
4211 return
4212end if
4213
4216 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4217end if
4218
4219
4220END FUNCTION cyclicdatetime_to_conventional
4221
4222
4223
4224FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4225TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4226
4227CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4228
4229char=cyclicdatetime_to_char(in)
4230
4231END FUNCTION trim_cyclicdatetime_to_char
4232
4233
4234
4235SUBROUTINE display_cyclicdatetime(this)
4236TYPE(cyclicdatetime),INTENT(in) :: this
4237
4239
4240end subroutine display_cyclicdatetime
4241
4242
4243#include "array_utilities_inc.F90"
4244
4246
Quick method to append an element to the array. Definition: datetime_class.F90:622 Restituiscono il valore dell'oggetto nella forma desiderata. Definition: datetime_class.F90:328 Costruttori per le classi datetime e timedelta. Definition: datetime_class.F90:317 Method for inserting elements of the array at a desired position. Definition: datetime_class.F90:613 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: datetime_class.F90:645 Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o... Definition: datetime_class.F90:484 Method for removing elements of the array at a desired position. Definition: datetime_class.F90:628 Functions that return a trimmed CHARACTER representation of the input variable. Definition: datetime_class.F90:355 Restituiscono il valore dell'oggetto in forma di stringa stampabile. Definition: datetime_class.F90:333 Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ... Definition: datetime_class.F90:491 Definition of constants to be used for declaring variables of a desired type. Definition: kinds.F90:251 Definitions of constants and functions for working with missing values. Definition: missing_values.f90:50 Module for quickly interpreting the OPTIONAL parameters passed to a subprogram. Definition: optional_values.f90:28 Class for expressing a cyclic datetime. Definition: datetime_class.F90:261 Class for expressing an absolute time value. Definition: datetime_class.F90:239 Class for expressing a relative time interval. Definition: datetime_class.F90:251 |