libsim Versione 7.2.1
|
◆ 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 2402 del file datetime_class.F90. 2403! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2404! authors:
2405! Davide Cesari <dcesari@arpa.emr.it>
2406! Paolo Patruno <ppatruno@arpa.emr.it>
2407
2408! This program is free software; you can redistribute it and/or
2409! modify it under the terms of the GNU General Public License as
2410! published by the Free Software Foundation; either version 2 of
2411! the License, or (at your option) any later version.
2412
2413! This program is distributed in the hope that it will be useful,
2414! but WITHOUT ANY WARRANTY; without even the implied warranty of
2415! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2416! GNU General Public License for more details.
2417
2418! You should have received a copy of the GNU General Public License
2419! along with this program. If not, see <http://www.gnu.org/licenses/>.
2420#include "config.h"
2421
2442IMPLICIT NONE
2443
2444INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2445
2448 PRIVATE
2449 INTEGER(KIND=int_ll) :: iminuti
2451
2460 PRIVATE
2461 INTEGER(KIND=int_ll) :: iminuti
2462 INTEGER :: month
2464
2465
2470 PRIVATE
2471 INTEGER :: minute
2472 INTEGER :: hour
2473 INTEGER :: day
2474 INTEGER :: tendaysp
2475 INTEGER :: month
2477
2478
2486INTEGER, PARAMETER :: datetime_utc=1
2488INTEGER, PARAMETER :: datetime_local=2
2498TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2499
2500
2501INTEGER(kind=dateint), PARAMETER :: &
2502 sec_in_day=86400, &
2503 sec_in_hour=3600, &
2504 sec_in_min=60, &
2505 min_in_day=1440, &
2506 min_in_hour=60, &
2507 hour_in_day=24
2508
2509INTEGER,PARAMETER :: &
2510 year0=1, & ! anno di origine per iminuti
2511 d1=365, & ! giorni/1 anno nel calendario gregoriano
2512 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2513 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2514 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2515 ianno(13,2)=reshape((/ &
2516 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2517 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2518
2519INTEGER(KIND=int_ll),PARAMETER :: &
2520 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2521
2526 MODULE PROCEDURE datetime_init, timedelta_init
2527END INTERFACE
2528
2532 MODULE PROCEDURE datetime_delete, timedelta_delete
2533END INTERFACE
2534
2537 MODULE PROCEDURE datetime_getval, timedelta_getval
2538END INTERFACE
2539
2542 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2543END INTERFACE
2544
2545
2564 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2565END INTERFACE
2566
2572INTERFACE OPERATOR (==)
2573 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2574 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2575END INTERFACE
2576
2582INTERFACE OPERATOR (/=)
2583 MODULE PROCEDURE datetime_ne, timedelta_ne
2584END INTERFACE
2585
2593INTERFACE OPERATOR (>)
2594 MODULE PROCEDURE datetime_gt, timedelta_gt
2595END INTERFACE
2596
2604INTERFACE OPERATOR (<)
2605 MODULE PROCEDURE datetime_lt, timedelta_lt
2606END INTERFACE
2607
2615INTERFACE OPERATOR (>=)
2616 MODULE PROCEDURE datetime_ge, timedelta_ge
2617END INTERFACE
2618
2626INTERFACE OPERATOR (<=)
2627 MODULE PROCEDURE datetime_le, timedelta_le
2628END INTERFACE
2629
2636INTERFACE OPERATOR (+)
2637 MODULE PROCEDURE datetime_add, timedelta_add
2638END INTERFACE
2639
2647INTERFACE OPERATOR (-)
2648 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
2649END INTERFACE
2650
2656INTERFACE OPERATOR (*)
2657 MODULE PROCEDURE timedelta_mult, timedelta_tlum
2658END INTERFACE
2659
2666INTERFACE OPERATOR (/)
2667 MODULE PROCEDURE timedelta_divint, timedelta_divtd
2668END INTERFACE
2669
2681 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
2682END INTERFACE
2683
2687 MODULE PROCEDURE timedelta_abs
2688END INTERFACE
2689
2693 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
2694 timedelta_read_unit, timedelta_vect_read_unit
2695END INTERFACE
2696
2700 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
2701 timedelta_write_unit, timedelta_vect_write_unit
2702END INTERFACE
2703
2706 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
2707END INTERFACE
2708
2711 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
2712END INTERFACE
2713
2714#undef VOL7D_POLY_TYPE
2715#undef VOL7D_POLY_TYPES
2716#undef ENABLE_SORT
2717#define VOL7D_POLY_TYPE TYPE(datetime)
2718#define VOL7D_POLY_TYPES _datetime
2719#define ENABLE_SORT
2720#include "array_utilities_pre.F90"
2721
2722
2723#define ARRAYOF_ORIGTYPE TYPE(datetime)
2724#define ARRAYOF_TYPE arrayof_datetime
2725#define ARRAYOF_ORIGEQ 1
2726#include "arrayof_pre.F90"
2727! from arrayof
2728
2729PRIVATE
2730
2732 datetime_min, datetime_max, &
2735 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
2736 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
2738 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
2739 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
2741 count_distinct, pack_distinct, &
2742 count_distinct_sorted, pack_distinct_sorted, &
2743 count_and_pack_distinct, &
2745 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
2747PUBLIC insert_unique, append_unique
2748PUBLIC cyclicdatetime_to_conventional
2749
2750CONTAINS
2751
2752
2753! ==============
2754! == datetime ==
2755! ==============
2756
2763ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
2764 unixtime, isodate, simpledate) RESULT(this)
2765INTEGER,INTENT(IN),OPTIONAL :: year
2766INTEGER,INTENT(IN),OPTIONAL :: month
2767INTEGER,INTENT(IN),OPTIONAL :: day
2768INTEGER,INTENT(IN),OPTIONAL :: hour
2769INTEGER,INTENT(IN),OPTIONAL :: minute
2770INTEGER,INTENT(IN),OPTIONAL :: msec
2771INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2772CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2773CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2774
2775TYPE(datetime) :: this
2776INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2777CHARACTER(len=23) :: datebuf
2778
2779IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
2780 lyear = year
2781 IF (PRESENT(month)) THEN
2782 lmonth = month
2783 ELSE
2784 lmonth = 1
2785 ENDIF
2786 IF (PRESENT(day)) THEN
2787 lday = day
2788 ELSE
2789 lday = 1
2790 ENDIF
2791 IF (PRESENT(hour)) THEN
2792 lhour = hour
2793 ELSE
2794 lhour = 0
2795 ENDIF
2796 IF (PRESENT(minute)) THEN
2797 lminute = minute
2798 ELSE
2799 lminute = 0
2800 ENDIF
2801 IF (PRESENT(msec)) THEN
2802 lmsec = msec
2803 ELSE
2804 lmsec = 0
2805 ENDIF
2806
2809 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2810 else
2811 this=datetime_miss
2812 end if
2813
2814ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
2816 this%iminuti = (unixtime + unsec)*1000
2817 else
2818 this=datetime_miss
2819 end if
2820
2821ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
2822
2824 datebuf(1:23) = '0001-01-01 00:00:00.000'
2825 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
2826 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
2827 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2828 lmsec = lmsec + lsec*1000
2829 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2830 RETURN
2831
2832100 CONTINUE ! condizione di errore in isodate
2834 RETURN
2835 ELSE
2836 this = datetime_miss
2837 ENDIF
2838
2839ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
2841 datebuf(1:17) = '00010101000000000'
2842 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2843 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
2844 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2845 lmsec = lmsec + lsec*1000
2846 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2847 RETURN
2848
2849120 CONTINUE ! condizione di errore in simpledate
2851 RETURN
2852 ELSE
2853 this = datetime_miss
2854 ENDIF
2855
2856ELSE
2857 this = datetime_miss
2858ENDIF
2859
2860END FUNCTION datetime_new
2861
2862
2864FUNCTION datetime_new_now(now) RESULT(this)
2865INTEGER,INTENT(IN) :: now
2866TYPE(datetime) :: this
2867
2868INTEGER :: dt(8)
2869
2871 CALL date_and_time(values=dt)
2872 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
2874 msec=dt(7)*1000+dt(8))
2875ELSE
2876 this = datetime_miss
2877ENDIF
2878
2879END FUNCTION datetime_new_now
2880
2881
2888SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
2889 unixtime, isodate, simpledate, now)
2890TYPE(datetime),INTENT(INOUT) :: this
2891INTEGER,INTENT(IN),OPTIONAL :: year
2892INTEGER,INTENT(IN),OPTIONAL :: month
2893INTEGER,INTENT(IN),OPTIONAL :: day
2894INTEGER,INTENT(IN),OPTIONAL :: hour
2895INTEGER,INTENT(IN),OPTIONAL :: minute
2896INTEGER,INTENT(IN),OPTIONAL :: msec
2897INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2898CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2899CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2900INTEGER,INTENT(IN),OPTIONAL :: now
2901
2902IF (PRESENT(now)) THEN
2903 this = datetime_new_now(now)
2904ELSE
2905 this = datetime_new(year, month, day, hour, minute, msec, &
2906 unixtime, isodate, simpledate)
2907ENDIF
2908
2909END SUBROUTINE datetime_init
2910
2911
2912ELEMENTAL SUBROUTINE datetime_delete(this)
2913TYPE(datetime),INTENT(INOUT) :: this
2914
2915this%iminuti = illmiss
2916
2917END SUBROUTINE datetime_delete
2918
2919
2924PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
2925 unixtime, isodate, simpledate, oraclesimdate)
2926TYPE(datetime),INTENT(IN) :: this
2927INTEGER,INTENT(OUT),OPTIONAL :: year
2928INTEGER,INTENT(OUT),OPTIONAL :: month
2929INTEGER,INTENT(OUT),OPTIONAL :: day
2930INTEGER,INTENT(OUT),OPTIONAL :: hour
2931INTEGER,INTENT(OUT),OPTIONAL :: minute
2932INTEGER,INTENT(OUT),OPTIONAL :: msec
2933INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime
2934CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
2935CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
2936CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
2937
2938INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2939CHARACTER(len=23) :: datebuf
2940
2941IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
2942 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
2943 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
2944
2945 IF (this == datetime_miss) THEN
2946
2947 IF (PRESENT(msec)) THEN
2948 msec = imiss
2949 ENDIF
2950 IF (PRESENT(minute)) THEN
2951 minute = imiss
2952 ENDIF
2953 IF (PRESENT(hour)) THEN
2954 hour = imiss
2955 ENDIF
2956 IF (PRESENT(day)) THEN
2957 day = imiss
2958 ENDIF
2959 IF (PRESENT(month)) THEN
2960 month = imiss
2961 ENDIF
2962 IF (PRESENT(year)) THEN
2963 year = imiss
2964 ENDIF
2965 IF (PRESENT(isodate)) THEN
2966 isodate = cmiss
2967 ENDIF
2968 IF (PRESENT(simpledate)) THEN
2969 simpledate = cmiss
2970 ENDIF
2971 IF (PRESENT(oraclesimdate)) THEN
2972!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2973!!$ 'obsoleto, usare piuttosto simpledate')
2974 oraclesimdate=cmiss
2975 ENDIF
2976 IF (PRESENT(unixtime)) THEN
2977 unixtime = illmiss
2978 ENDIF
2979
2980 ELSE
2981
2982 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2983 IF (PRESENT(msec)) THEN
2984 msec = lmsec
2985 ENDIF
2986 IF (PRESENT(minute)) THEN
2987 minute = lminute
2988 ENDIF
2989 IF (PRESENT(hour)) THEN
2990 hour = lhour
2991 ENDIF
2992 IF (PRESENT(day)) THEN
2993 day = lday
2994 ENDIF
2995 IF (PRESENT(month)) THEN
2996 month = lmonth
2997 ENDIF
2998 IF (PRESENT(year)) THEN
2999 year = lyear
3000 ENDIF
3001 IF (PRESENT(isodate)) THEN
3002 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3003 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
3005 isodate = datebuf(1:min(len(isodate),23))
3006 ENDIF
3007 IF (PRESENT(simpledate)) THEN
3008 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
3009 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
3010 simpledate = datebuf(1:min(len(simpledate),17))
3011 ENDIF
3012 IF (PRESENT(oraclesimdate)) THEN
3013!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3014!!$ 'obsoleto, usare piuttosto simpledate')
3015 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
3016 ENDIF
3017 IF (PRESENT(unixtime)) THEN
3018 unixtime = this%iminuti/1000_int_ll-unsec
3019 ENDIF
3020
3021 ENDIF
3022ENDIF
3023
3024END SUBROUTINE datetime_getval
3025
3026
3029elemental FUNCTION datetime_to_char(this) RESULT(char)
3030TYPE(datetime),INTENT(IN) :: this
3031
3032CHARACTER(len=23) :: char
3033
3035
3036END FUNCTION datetime_to_char
3037
3038
3039FUNCTION trim_datetime_to_char(in) RESULT(char)
3040TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3041
3042CHARACTER(len=len_trim(datetime_to_char(in))) :: char
3043
3044char=datetime_to_char(in)
3045
3046END FUNCTION trim_datetime_to_char
3047
3048
3049
3050SUBROUTINE display_datetime(this)
3051TYPE(datetime),INTENT(in) :: this
3052
3054
3055end subroutine display_datetime
3056
3057
3058
3059SUBROUTINE display_timedelta(this)
3060TYPE(timedelta),INTENT(in) :: this
3061
3063
3064end subroutine display_timedelta
3065
3066
3067
3068ELEMENTAL FUNCTION c_e_datetime(this) result (res)
3069TYPE(datetime),INTENT(in) :: this
3070LOGICAL :: res
3071
3072res = .not. this == datetime_miss
3073
3074end FUNCTION c_e_datetime
3075
3076
3077ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
3078TYPE(datetime),INTENT(IN) :: this, that
3079LOGICAL :: res
3080
3081res = this%iminuti == that%iminuti
3082
3083END FUNCTION datetime_eq
3084
3085
3086ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3087TYPE(datetime),INTENT(IN) :: this, that
3088LOGICAL :: res
3089
3090res = .NOT.(this == that)
3091
3092END FUNCTION datetime_ne
3093
3094
3095ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3096TYPE(datetime),INTENT(IN) :: this, that
3097LOGICAL :: res
3098
3099res = this%iminuti > that%iminuti
3100
3101END FUNCTION datetime_gt
3102
3103
3104ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3105TYPE(datetime),INTENT(IN) :: this, that
3106LOGICAL :: res
3107
3108res = this%iminuti < that%iminuti
3109
3110END FUNCTION datetime_lt
3111
3112
3113ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3114TYPE(datetime),INTENT(IN) :: this, that
3115LOGICAL :: res
3116
3117IF (this == that) THEN
3118 res = .true.
3119ELSE IF (this > that) THEN
3120 res = .true.
3121ELSE
3122 res = .false.
3123ENDIF
3124
3125END FUNCTION datetime_ge
3126
3127
3128ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3129TYPE(datetime),INTENT(IN) :: this, that
3130LOGICAL :: res
3131
3132IF (this == that) THEN
3133 res = .true.
3134ELSE IF (this < that) THEN
3135 res = .true.
3136ELSE
3137 res = .false.
3138ENDIF
3139
3140END FUNCTION datetime_le
3141
3142
3143FUNCTION datetime_add(this, that) RESULT(res)
3144TYPE(datetime),INTENT(IN) :: this
3145TYPE(timedelta),INTENT(IN) :: that
3146TYPE(datetime) :: res
3147
3148INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3149
3150IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3151 res = datetime_miss
3152ELSE
3153 res%iminuti = this%iminuti + that%iminuti
3154 IF (that%month /= 0) THEN
3156 minute=lminute, msec=lmsec)
3158 hour=lhour, minute=lminute, msec=lmsec)
3159 ENDIF
3160ENDIF
3161
3162END FUNCTION datetime_add
3163
3164
3165ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3166TYPE(datetime),INTENT(IN) :: this, that
3167TYPE(timedelta) :: res
3168
3169IF (this == datetime_miss .OR. that == datetime_miss) THEN
3170 res = timedelta_miss
3171ELSE
3172 res%iminuti = this%iminuti - that%iminuti
3173 res%month = 0
3174ENDIF
3175
3176END FUNCTION datetime_subdt
3177
3178
3179FUNCTION datetime_subtd(this, that) RESULT(res)
3180TYPE(datetime),INTENT(IN) :: this
3181TYPE(timedelta),INTENT(IN) :: that
3182TYPE(datetime) :: res
3183
3184INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3185
3186IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3187 res = datetime_miss
3188ELSE
3189 res%iminuti = this%iminuti - that%iminuti
3190 IF (that%month /= 0) THEN
3192 minute=lminute, msec=lmsec)
3194 hour=lhour, minute=lminute, msec=lmsec)
3195 ENDIF
3196ENDIF
3197
3198END FUNCTION datetime_subtd
3199
3200
3205SUBROUTINE datetime_read_unit(this, unit)
3206TYPE(datetime),INTENT(out) :: this
3207INTEGER, INTENT(in) :: unit
3208CALL datetime_vect_read_unit((/this/), unit)
3209
3210END SUBROUTINE datetime_read_unit
3211
3212
3217SUBROUTINE datetime_vect_read_unit(this, unit)
3218TYPE(datetime) :: this(:)
3219INTEGER, INTENT(in) :: unit
3220
3221CHARACTER(len=40) :: form
3222CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3223INTEGER :: i
3224
3225ALLOCATE(dateiso(SIZE(this)))
3226INQUIRE(unit, form=form)
3227IF (form == 'FORMATTED') THEN
3228 READ(unit,'(A23,1X)')dateiso
3229ELSE
3230 READ(unit)dateiso
3231ENDIF
3232DO i = 1, SIZE(dateiso)
3234ENDDO
3235DEALLOCATE(dateiso)
3236
3237END SUBROUTINE datetime_vect_read_unit
3238
3239
3244SUBROUTINE datetime_write_unit(this, unit)
3245TYPE(datetime),INTENT(in) :: this
3246INTEGER, INTENT(in) :: unit
3247
3248CALL datetime_vect_write_unit((/this/), unit)
3249
3250END SUBROUTINE datetime_write_unit
3251
3252
3257SUBROUTINE datetime_vect_write_unit(this, unit)
3258TYPE(datetime),INTENT(in) :: this(:)
3259INTEGER, INTENT(in) :: unit
3260
3261CHARACTER(len=40) :: form
3262CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3263INTEGER :: i
3264
3265ALLOCATE(dateiso(SIZE(this)))
3266DO i = 1, SIZE(dateiso)
3268ENDDO
3269INQUIRE(unit, form=form)
3270IF (form == 'FORMATTED') THEN
3271 WRITE(unit,'(A23,1X)')dateiso
3272ELSE
3273 WRITE(unit)dateiso
3274ENDIF
3275DEALLOCATE(dateiso)
3276
3277END SUBROUTINE datetime_vect_write_unit
3278
3279
3280#include "arrayof_post.F90"
3281
3282
3283! ===============
3284! == timedelta ==
3285! ===============
3292FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3293 isodate, simpledate, oraclesimdate) RESULT (this)
3294INTEGER,INTENT(IN),OPTIONAL :: year
3295INTEGER,INTENT(IN),OPTIONAL :: month
3296INTEGER,INTENT(IN),OPTIONAL :: day
3297INTEGER,INTENT(IN),OPTIONAL :: hour
3298INTEGER,INTENT(IN),OPTIONAL :: minute
3299INTEGER,INTENT(IN),OPTIONAL :: sec
3300INTEGER,INTENT(IN),OPTIONAL :: msec
3301CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3302CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3303CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3304
3305TYPE(timedelta) :: this
3306
3307CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3308 isodate, simpledate, oraclesimdate)
3309
3310END FUNCTION timedelta_new
3311
3312
3317SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3318 isodate, simpledate, oraclesimdate)
3319TYPE(timedelta),INTENT(INOUT) :: this
3320INTEGER,INTENT(IN),OPTIONAL :: year
3321INTEGER,INTENT(IN),OPTIONAL :: month
3322INTEGER,INTENT(IN),OPTIONAL :: day
3323INTEGER,INTENT(IN),OPTIONAL :: hour
3324INTEGER,INTENT(IN),OPTIONAL :: minute
3325INTEGER,INTENT(IN),OPTIONAL :: sec
3326INTEGER,INTENT(IN),OPTIONAL :: msec
3327CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3328CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3329CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3330
3331INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3332CHARACTER(len=23) :: datebuf
3333
3334this%month = 0
3335
3336IF (PRESENT(isodate)) THEN
3337 datebuf(1:23) = '0000000000 00:00:00.000'
3338 l = len_trim(isodate)
3339! IF (l > 0) THEN
3341 IF (n > 0) THEN
3342 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3343 datebuf(12-n:12-n+l-1) = isodate(:l)
3344 ELSE
3345 datebuf(1:l) = isodate(1:l)
3346 ENDIF
3347! ENDIF
3348
3349! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3350 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3351 h, m, s, ms
3352 this%month = lmonth + 12*lyear
3353 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3354 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3355 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3356 RETURN
3357
3358200 CONTINUE ! condizione di errore in isodate
3360 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3361 CALL raise_error()
3362
3363ELSE IF (PRESENT(simpledate)) THEN
3364 datebuf(1:17) = '00000000000000000'
3365 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3366 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3367 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3368 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3369 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3370
3371220 CONTINUE ! condizione di errore in simpledate
3373 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3374 CALL raise_error()
3375 RETURN
3376
3377ELSE IF (PRESENT(oraclesimdate)) THEN
3378 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3379 'obsoleto, usare piuttosto simpledate')
3380 READ(oraclesimdate, '(I8,2I2)')d, h, m
3381 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3382 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3383
3384ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3385 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3386 .and. .not. present(msec) .and. .not. present(isodate) &
3387 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3388
3389 this=timedelta_miss
3390
3391ELSE
3392 this%iminuti = 0
3393 IF (PRESENT(year)) THEN
3395 this%month = this%month + year*12
3396 else
3397 this=timedelta_miss
3398 return
3399 end if
3400 ENDIF
3401 IF (PRESENT(month)) THEN
3403 this%month = this%month + month
3404 else
3405 this=timedelta_miss
3406 return
3407 end if
3408 ENDIF
3409 IF (PRESENT(day)) THEN
3411 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3412 else
3413 this=timedelta_miss
3414 return
3415 end if
3416 ENDIF
3417 IF (PRESENT(hour)) THEN
3419 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3420 else
3421 this=timedelta_miss
3422 return
3423 end if
3424 ENDIF
3425 IF (PRESENT(minute)) THEN
3427 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3428 else
3429 this=timedelta_miss
3430 return
3431 end if
3432 ENDIF
3433 IF (PRESENT(sec)) THEN
3435 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3436 else
3437 this=timedelta_miss
3438 return
3439 end if
3440 ENDIF
3441 IF (PRESENT(msec)) THEN
3443 this%iminuti = this%iminuti + msec
3444 else
3445 this=timedelta_miss
3446 return
3447 end if
3448 ENDIF
3449ENDIF
3450
3451
3452
3453
3454END SUBROUTINE timedelta_init
3455
3456
3457SUBROUTINE timedelta_delete(this)
3458TYPE(timedelta),INTENT(INOUT) :: this
3459
3460this%iminuti = imiss
3461this%month = 0
3462
3463END SUBROUTINE timedelta_delete
3464
3465
3470PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3471 day, hour, minute, sec, msec, &
3472 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3473TYPE(timedelta),INTENT(IN) :: this
3474INTEGER,INTENT(OUT),OPTIONAL :: year
3475INTEGER,INTENT(OUT),OPTIONAL :: month
3476INTEGER,INTENT(OUT),OPTIONAL :: amonth
3477INTEGER,INTENT(OUT),OPTIONAL :: day
3478INTEGER,INTENT(OUT),OPTIONAL :: hour
3479INTEGER,INTENT(OUT),OPTIONAL :: minute
3480INTEGER,INTENT(OUT),OPTIONAL :: sec
3481INTEGER,INTENT(OUT),OPTIONAL :: msec
3482INTEGER,INTENT(OUT),OPTIONAL :: ahour
3483INTEGER,INTENT(OUT),OPTIONAL :: aminute
3484INTEGER,INTENT(OUT),OPTIONAL :: asec
3485INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec
3486CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3487CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3488CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3489
3490CHARACTER(len=23) :: datebuf
3491
3492IF (PRESENT(amsec)) THEN
3493 amsec = this%iminuti
3494ENDIF
3495IF (PRESENT(asec)) THEN
3496 asec = int(this%iminuti/1000_int_ll)
3497ENDIF
3498IF (PRESENT(aminute)) THEN
3499 aminute = int(this%iminuti/60000_int_ll)
3500ENDIF
3501IF (PRESENT(ahour)) THEN
3502 ahour = int(this%iminuti/3600000_int_ll)
3503ENDIF
3504IF (PRESENT(msec)) THEN
3505 msec = int(mod(this%iminuti, 1000_int_ll))
3506ENDIF
3507IF (PRESENT(sec)) THEN
3508 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3509ENDIF
3510IF (PRESENT(minute)) THEN
3511 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3512ENDIF
3513IF (PRESENT(hour)) THEN
3514 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3515ENDIF
3516IF (PRESENT(day)) THEN
3517 day = int(this%iminuti/86400000_int_ll)
3518ENDIF
3519IF (PRESENT(amonth)) THEN
3520 amonth = this%month
3521ENDIF
3522IF (PRESENT(month)) THEN
3523 month = mod(this%month-1,12)+1
3524ENDIF
3525IF (PRESENT(year)) THEN
3526 year = this%month/12
3527ENDIF
3528IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3529 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3533 isodate = datebuf(1:min(len(isodate),23))
3534
3535ENDIF
3536IF (PRESENT(simpledate)) THEN
3537 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3538 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3540 mod(this%iminuti, 1000_int_ll)
3541 simpledate = datebuf(1:min(len(simpledate),17))
3542ENDIF
3543IF (PRESENT(oraclesimdate)) THEN
3544!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3545!!$ 'obsoleto, usare piuttosto simpledate')
3546 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3548ENDIF
3549
3550END SUBROUTINE timedelta_getval
3551
3552
3555elemental FUNCTION timedelta_to_char(this) RESULT(char)
3556TYPE(timedelta),INTENT(IN) :: this
3557
3558CHARACTER(len=23) :: char
3559
3561
3562END FUNCTION timedelta_to_char
3563
3564
3565FUNCTION trim_timedelta_to_char(in) RESULT(char)
3566TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3567
3568CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3569
3570char=timedelta_to_char(in)
3571
3572END FUNCTION trim_timedelta_to_char
3573
3574
3576elemental FUNCTION timedelta_getamsec(this)
3577TYPE(timedelta),INTENT(IN) :: this
3578INTEGER(kind=int_ll) :: timedelta_getamsec
3579
3580timedelta_getamsec = this%iminuti
3581
3582END FUNCTION timedelta_getamsec
3583
3584
3590FUNCTION timedelta_depop(this)
3591TYPE(timedelta),INTENT(IN) :: this
3592TYPE(timedelta) :: timedelta_depop
3593
3594TYPE(datetime) :: tmpdt
3595
3596IF (this%month == 0) THEN
3597 timedelta_depop = this
3598ELSE
3599 tmpdt = datetime_new(1970, 1, 1)
3600 timedelta_depop = (tmpdt + this) - tmpdt
3601ENDIF
3602
3603END FUNCTION timedelta_depop
3604
3605
3606elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3607TYPE(timedelta),INTENT(IN) :: this, that
3608LOGICAL :: res
3609
3610res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3611
3612END FUNCTION timedelta_eq
3613
3614
3615ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3616TYPE(timedelta),INTENT(IN) :: this, that
3617LOGICAL :: res
3618
3619res = .NOT.(this == that)
3620
3621END FUNCTION timedelta_ne
3622
3623
3624ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
3625TYPE(timedelta),INTENT(IN) :: this, that
3626LOGICAL :: res
3627
3628res = this%iminuti > that%iminuti
3629
3630END FUNCTION timedelta_gt
3631
3632
3633ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
3634TYPE(timedelta),INTENT(IN) :: this, that
3635LOGICAL :: res
3636
3637res = this%iminuti < that%iminuti
3638
3639END FUNCTION timedelta_lt
3640
3641
3642ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
3643TYPE(timedelta),INTENT(IN) :: this, that
3644LOGICAL :: res
3645
3646IF (this == that) THEN
3647 res = .true.
3648ELSE IF (this > that) THEN
3649 res = .true.
3650ELSE
3651 res = .false.
3652ENDIF
3653
3654END FUNCTION timedelta_ge
3655
3656
3657elemental FUNCTION timedelta_le(this, that) RESULT(res)
3658TYPE(timedelta),INTENT(IN) :: this, that
3659LOGICAL :: res
3660
3661IF (this == that) THEN
3662 res = .true.
3663ELSE IF (this < that) THEN
3664 res = .true.
3665ELSE
3666 res = .false.
3667ENDIF
3668
3669END FUNCTION timedelta_le
3670
3671
3672ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
3673TYPE(timedelta),INTENT(IN) :: this, that
3674TYPE(timedelta) :: res
3675
3676res%iminuti = this%iminuti + that%iminuti
3677res%month = this%month + that%month
3678
3679END FUNCTION timedelta_add
3680
3681
3682ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
3683TYPE(timedelta),INTENT(IN) :: this, that
3684TYPE(timedelta) :: res
3685
3686res%iminuti = this%iminuti - that%iminuti
3687res%month = this%month - that%month
3688
3689END FUNCTION timedelta_sub
3690
3691
3692ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
3693TYPE(timedelta),INTENT(IN) :: this
3694INTEGER,INTENT(IN) :: n
3695TYPE(timedelta) :: res
3696
3697res%iminuti = this%iminuti*n
3698res%month = this%month*n
3699
3700END FUNCTION timedelta_mult
3701
3702
3703ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
3704INTEGER,INTENT(IN) :: n
3705TYPE(timedelta),INTENT(IN) :: this
3706TYPE(timedelta) :: res
3707
3708res%iminuti = this%iminuti*n
3709res%month = this%month*n
3710
3711END FUNCTION timedelta_tlum
3712
3713
3714ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
3715TYPE(timedelta),INTENT(IN) :: this
3716INTEGER,INTENT(IN) :: n
3717TYPE(timedelta) :: res
3718
3719res%iminuti = this%iminuti/n
3720res%month = this%month/n
3721
3722END FUNCTION timedelta_divint
3723
3724
3725ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
3726TYPE(timedelta),INTENT(IN) :: this, that
3727INTEGER :: res
3728
3729res = int(this%iminuti/that%iminuti)
3730
3731END FUNCTION timedelta_divtd
3732
3733
3734elemental FUNCTION timedelta_mod(this, that) RESULT(res)
3735TYPE(timedelta),INTENT(IN) :: this, that
3736TYPE(timedelta) :: res
3737
3738res%iminuti = mod(this%iminuti, that%iminuti)
3739res%month = 0
3740
3741END FUNCTION timedelta_mod
3742
3743
3744ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
3745TYPE(datetime),INTENT(IN) :: this
3746TYPE(timedelta),INTENT(IN) :: that
3747TYPE(timedelta) :: res
3748
3749IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
3750 res = timedelta_0
3751ELSE
3752 res%iminuti = mod(this%iminuti, that%iminuti)
3753 res%month = 0
3754ENDIF
3755
3756END FUNCTION datetime_timedelta_mod
3757
3758
3759ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
3760TYPE(timedelta),INTENT(IN) :: this
3761TYPE(timedelta) :: res
3762
3763res%iminuti = abs(this%iminuti)
3764res%month = abs(this%month)
3765
3766END FUNCTION timedelta_abs
3767
3768
3773SUBROUTINE timedelta_read_unit(this, unit)
3774TYPE(timedelta),INTENT(out) :: this
3775INTEGER, INTENT(in) :: unit
3776
3777CALL timedelta_vect_read_unit((/this/), unit)
3778
3779END SUBROUTINE timedelta_read_unit
3780
3781
3786SUBROUTINE timedelta_vect_read_unit(this, unit)
3787TYPE(timedelta) :: this(:)
3788INTEGER, INTENT(in) :: unit
3789
3790CHARACTER(len=40) :: form
3791CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3792INTEGER :: i
3793
3794ALLOCATE(dateiso(SIZE(this)))
3795INQUIRE(unit, form=form)
3796IF (form == 'FORMATTED') THEN
3797 READ(unit,'(3(A23,1X))')dateiso
3798ELSE
3799 READ(unit)dateiso
3800ENDIF
3801DO i = 1, SIZE(dateiso)
3803ENDDO
3804DEALLOCATE(dateiso)
3805
3806END SUBROUTINE timedelta_vect_read_unit
3807
3808
3813SUBROUTINE timedelta_write_unit(this, unit)
3814TYPE(timedelta),INTENT(in) :: this
3815INTEGER, INTENT(in) :: unit
3816
3817CALL timedelta_vect_write_unit((/this/), unit)
3818
3819END SUBROUTINE timedelta_write_unit
3820
3821
3826SUBROUTINE timedelta_vect_write_unit(this, unit)
3827TYPE(timedelta),INTENT(in) :: this(:)
3828INTEGER, INTENT(in) :: unit
3829
3830CHARACTER(len=40) :: form
3831CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3832INTEGER :: i
3833
3834ALLOCATE(dateiso(SIZE(this)))
3835DO i = 1, SIZE(dateiso)
3837ENDDO
3838INQUIRE(unit, form=form)
3839IF (form == 'FORMATTED') THEN
3840 WRITE(unit,'(3(A23,1X))')dateiso
3841ELSE
3842 WRITE(unit)dateiso
3843ENDIF
3844DEALLOCATE(dateiso)
3845
3846END SUBROUTINE timedelta_vect_write_unit
3847
3848
3849ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
3850TYPE(timedelta),INTENT(in) :: this
3851LOGICAL :: res
3852
3853res = .not. this == timedelta_miss
3854
3855end FUNCTION c_e_timedelta
3856
3857
3858elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
3859
3860!!omstart JELADATA5
3861! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3862! 1 IMINUTI)
3863!
3864! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
3865!
3866! variabili integer*4
3867! IN:
3868! IDAY,IMONTH,IYEAR, I*4
3869! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3870!
3871! OUT:
3872! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3873!!OMEND
3874
3875INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
3876INTEGER,intent(out) :: iminuti
3877
3878iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
3879
3880END SUBROUTINE jeladata5
3881
3882
3883elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
3884INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
3885INTEGER(KIND=int_ll),intent(out) :: imillisec
3886
3887imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
3888 + imsec
3889
3890END SUBROUTINE jeladata5_1
3891
3892
3893
3894elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
3895
3896!!omstart JELADATA6
3897! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3898! 1 IMINUTI)
3899!
3900! Calcola la data e l'ora corrispondente a IMINUTI dopo il
3901! 1/1/1
3902!
3903! variabili integer*4
3904! IN:
3905! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3906!
3907! OUT:
3908! IDAY,IMONTH,IYEAR, I*4
3909! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3910!!OMEND
3911
3912
3913INTEGER,intent(in) :: iminuti
3914INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
3915
3916INTEGER ::igiorno
3917
3918imin = mod(iminuti,60)
3919ihour = mod(iminuti,1440)/60
3920igiorno = iminuti/1440
3922CALL ndyin(igiorno,iday,imonth,iyear)
3923
3924END SUBROUTINE jeladata6
3925
3926
3927elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
3928INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
3929INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
3930
3931INTEGER :: igiorno
3932
3934!imin = MOD(imillisec/60000_int_ll, 60)
3935!ihour = MOD(imillisec/3600000_int_ll, 24)
3936imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
3937ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
3938igiorno = int(imillisec/86400000_int_ll)
3939!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
3940CALL ndyin(igiorno,iday,imonth,iyear)
3941
3942END SUBROUTINE jeladata6_1
3943
3944
3945elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
3946
3947!!OMSTART NDYIN
3948! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
3949! restituisce la data fornendo in input il numero di
3950! giorni dal 1/1/1
3951!
3952!!omend
3953
3954INTEGER,intent(in) :: ndays
3955INTEGER,intent(out) :: igg, imm, iaa
3956integer :: n,lndays
3957
3958lndays=ndays
3959
3960n = lndays/d400
3961lndays = lndays - n*d400
3962iaa = year0 + n*400
3963n = min(lndays/d100, 3)
3964lndays = lndays - n*d100
3965iaa = iaa + n*100
3966n = lndays/d4
3967lndays = lndays - n*d4
3968iaa = iaa + n*4
3969n = min(lndays/d1, 3)
3970lndays = lndays - n*d1
3971iaa = iaa + n
3972n = bisextilis(iaa)
3973DO imm = 1, 12
3974 IF (lndays < ianno(imm+1,n)) EXIT
3975ENDDO
3976igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
3977
3978END SUBROUTINE ndyin
3979
3980
3981integer elemental FUNCTION ndays(igg,imm,iaa)
3982
3983!!OMSTART NDAYS
3984! FUNCTION NDAYS(IGG,IMM,IAA)
3985! restituisce il numero di giorni dal 1/1/1
3986! fornendo in input la data
3987!
3988!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3989! nota bene E' SICURO !!!
3990! un anno e' bisestile se divisibile per 4
3991! un anno rimane bisestile se divisibile per 400
3992! un anno NON e' bisestile se divisibile per 100
3993!
3994!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3995!
3996!!omend
3997
3998INTEGER, intent(in) :: igg, imm, iaa
3999
4000INTEGER :: lmonth, lyear
4001
4002! Limito il mese a [1-12] e correggo l'anno coerentemente
4003lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
4004lyear = iaa + (imm - lmonth)/12
4005ndays = igg+ianno(lmonth, bisextilis(lyear))
4006ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
4007 (lyear-year0)/400
4008
4009END FUNCTION ndays
4010
4011
4012elemental FUNCTION bisextilis(annum)
4013INTEGER,INTENT(in) :: annum
4014INTEGER :: bisextilis
4015
4017 bisextilis = 2
4018ELSE
4019 bisextilis = 1
4020ENDIF
4021END FUNCTION bisextilis
4022
4023
4024ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
4025TYPE(cyclicdatetime),INTENT(IN) :: this, that
4026LOGICAL :: res
4027
4028res = .true.
4029if (this%minute /= that%minute) res=.false.
4030if (this%hour /= that%hour) res=.false.
4031if (this%day /= that%day) res=.false.
4032if (this%month /= that%month) res=.false.
4033if (this%tendaysp /= that%tendaysp) res=.false.
4034
4035END FUNCTION cyclicdatetime_eq
4036
4037
4038ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
4039TYPE(cyclicdatetime),INTENT(IN) :: this
4040TYPE(datetime),INTENT(IN) :: that
4041LOGICAL :: res
4042
4043integer :: minute,hour,day,month
4044
4046
4047res = .true.
4053 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4054end if
4055
4056END FUNCTION cyclicdatetime_datetime_eq
4057
4058
4059ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
4060TYPE(datetime),INTENT(IN) :: this
4061TYPE(cyclicdatetime),INTENT(IN) :: that
4062LOGICAL :: res
4063
4064integer :: minute,hour,day,month
4065
4067
4068res = .true.
4073
4075 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4076end if
4077
4078
4079END FUNCTION datetime_cyclicdatetime_eq
4080
4081ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
4082TYPE(cyclicdatetime),INTENT(in) :: this
4083LOGICAL :: res
4084
4085res = .not. this == cyclicdatetime_miss
4086
4087end FUNCTION c_e_cyclicdatetime
4088
4089
4092FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4093INTEGER,INTENT(IN),OPTIONAL :: tendaysp
4094INTEGER,INTENT(IN),OPTIONAL :: month
4095INTEGER,INTENT(IN),OPTIONAL :: day
4096INTEGER,INTENT(IN),OPTIONAL :: hour
4097INTEGER,INTENT(IN),OPTIONAL :: minute
4098CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate
4099
4100integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4101
4102
4103TYPE(cyclicdatetime) :: this
4104
4105if (present(chardate)) then
4106
4107 ltendaysp=imiss
4108 lmonth=imiss
4109 lday=imiss
4110 lhour=imiss
4111 lminute=imiss
4112
4114 ! TMMGGhhmm
4115 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4116 !print*,chardate(1:1),ios,ltendaysp
4117 if (ios /= 0)ltendaysp=imiss
4118
4119 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4120 !print*,chardate(2:3),ios,lmonth
4121 if (ios /= 0)lmonth=imiss
4122
4123 read(chardate(4:5),'(i2)',iostat=ios)lday
4124 !print*,chardate(4:5),ios,lday
4125 if (ios /= 0)lday=imiss
4126
4127 read(chardate(6:7),'(i2)',iostat=ios)lhour
4128 !print*,chardate(6:7),ios,lhour
4129 if (ios /= 0)lhour=imiss
4130
4131 read(chardate(8:9),'(i2)',iostat=ios)lminute
4132 !print*,chardate(8:9),ios,lminute
4133 if (ios /= 0)lminute=imiss
4134 end if
4135
4136 this%tendaysp=ltendaysp
4137 this%month=lmonth
4138 this%day=lday
4139 this%hour=lhour
4140 this%minute=lminute
4141else
4142 this%tendaysp=optio_l(tendaysp)
4143 this%month=optio_l(month)
4144 this%day=optio_l(day)
4145 this%hour=optio_l(hour)
4146 this%minute=optio_l(minute)
4147end if
4148
4149END FUNCTION cyclicdatetime_new
4150
4153elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4154TYPE(cyclicdatetime),INTENT(IN) :: this
4155
4156CHARACTER(len=80) :: char
4157
4160
4161END FUNCTION cyclicdatetime_to_char
4162
4163
4176FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4177TYPE(cyclicdatetime),INTENT(IN) :: this
4178
4179TYPE(datetime) :: dtc
4180
4181integer :: year,month,day,hour
4182
4183dtc = datetime_miss
4184
4185! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4187 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4188 return
4189end if
4190
4191! minute present -> not good for conventional datetime
4193! day, month and tendaysp present -> no good
4195
4197 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4199 day=(this%tendaysp-1)*10+1
4200 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4202 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4204 ! only day present -> no good
4205 return
4206end if
4207
4210 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4211end if
4212
4213
4214END FUNCTION cyclicdatetime_to_conventional
4215
4216
4217
4218FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4219TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4220
4221CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4222
4223char=cyclicdatetime_to_char(in)
4224
4225END FUNCTION trim_cyclicdatetime_to_char
4226
4227
4228
4229SUBROUTINE display_cyclicdatetime(this)
4230TYPE(cyclicdatetime),INTENT(in) :: this
4231
4233
4234end subroutine display_cyclicdatetime
4235
4236
4237#include "array_utilities_inc.F90"
4238
4240
Quick method to append an element to the array. Definition datetime_class.F90:616 Restituiscono il valore dell'oggetto nella forma desiderata. Definition datetime_class.F90:322 Costruttori per le classi datetime e timedelta. Definition datetime_class.F90:311 Method for inserting elements of the array at a desired position. Definition datetime_class.F90:607 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition datetime_class.F90:639 Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o... Definition datetime_class.F90:478 Method for removing elements of the array at a desired position. Definition datetime_class.F90:622 Functions that return a trimmed CHARACTER representation of the input variable. Definition datetime_class.F90:349 Restituiscono il valore dell'oggetto in forma di stringa stampabile. Definition datetime_class.F90:327 Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ... Definition datetime_class.F90:485 Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 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:255 Class for expressing an absolute time value. Definition datetime_class.F90:233 Class for expressing a relative time interval. Definition datetime_class.F90:245 |