libsim Versione 7.1.11

◆ timedelta_vect_write_unit()

subroutine timedelta_vect_write_unit ( type(timedelta), dimension(:), intent(in)  this,
integer, intent(in)  unit 
)

This method writes on a Fortran file unit the contents of the object this.

The record can successively be read by the ::read_unit method. The method works both on formatted and unformatted files.

Parametri
[in]thisobject to be written
[in]unitunit where to write, it must be an opened Fortran file unit

Definizione alla linea 2058 del file datetime_class.F90.

2059! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2060! authors:
2061! Davide Cesari <dcesari@arpa.emr.it>
2062! Paolo Patruno <ppatruno@arpa.emr.it>
2063
2064! This program is free software; you can redistribute it and/or
2065! modify it under the terms of the GNU General Public License as
2066! published by the Free Software Foundation; either version 2 of
2067! the License, or (at your option) any later version.
2068
2069! This program is distributed in the hope that it will be useful,
2070! but WITHOUT ANY WARRANTY; without even the implied warranty of
2071! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2072! GNU General Public License for more details.
2073
2074! You should have received a copy of the GNU General Public License
2075! along with this program. If not, see <http://www.gnu.org/licenses/>.
2076#include "config.h"
2077
2091MODULE datetime_class
2092USE kinds
2093USE log4fortran
2094USE err_handling
2098IMPLICIT NONE
2099
2100INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2101
2103TYPE datetime
2104 PRIVATE
2105 INTEGER(KIND=int_ll) :: iminuti
2106END TYPE datetime
2107
2115TYPE timedelta
2116 PRIVATE
2117 INTEGER(KIND=int_ll) :: iminuti
2118 INTEGER :: month
2119END TYPE timedelta
2120
2121
2125TYPE cyclicdatetime
2126 PRIVATE
2127 INTEGER :: minute
2128 INTEGER :: hour
2129 INTEGER :: day
2130 INTEGER :: tendaysp
2131 INTEGER :: month
2132END TYPE cyclicdatetime
2133
2134
2136TYPE(datetime), PARAMETER :: datetime_miss=datetime(illmiss)
2138TYPE(timedelta), PARAMETER :: timedelta_miss=timedelta(illmiss, 0)
2140TYPE(timedelta), PARAMETER :: timedelta_0=timedelta(0, 0)
2142INTEGER, PARAMETER :: datetime_utc=1
2144INTEGER, PARAMETER :: datetime_local=2
2146TYPE(datetime), PARAMETER :: datetime_min=datetime(-huge(1_int_ll)-1)
2148TYPE(datetime), PARAMETER :: datetime_max=datetime(huge(1_int_ll)-1)
2150TYPE(timedelta), PARAMETER :: timedelta_min=timedelta(-huge(1_int_ll)-1,0)
2152TYPE(timedelta), PARAMETER :: timedelta_max=timedelta(huge(1_int_ll)-1,0)
2154TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2155
2156
2157INTEGER(kind=dateint), PARAMETER :: &
2158 sec_in_day=86400, &
2159 sec_in_hour=3600, &
2160 sec_in_min=60, &
2161 min_in_day=1440, &
2162 min_in_hour=60, &
2163 hour_in_day=24
2164
2165INTEGER,PARAMETER :: &
2166 year0=1, & ! anno di origine per iminuti
2167 d1=365, & ! giorni/1 anno nel calendario gregoriano
2168 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2169 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2170 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2171 ianno(13,2)=reshape((/ &
2172 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2173 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2174
2175INTEGER(KIND=int_ll),PARAMETER :: &
2176 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2177
2181INTERFACE init
2182 MODULE PROCEDURE datetime_init, timedelta_init
2183END INTERFACE
2184
2187INTERFACE delete
2188 MODULE PROCEDURE datetime_delete, timedelta_delete
2189END INTERFACE
2190
2192INTERFACE getval
2193 MODULE PROCEDURE datetime_getval, timedelta_getval
2194END INTERFACE
2195
2197INTERFACE to_char
2198 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
2199END INTERFACE
2200
2201
2219INTERFACE t2c
2220 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
2221END INTERFACE
2222
2228INTERFACE OPERATOR (==)
2229 MODULE PROCEDURE datetime_eq, timedelta_eq, &
2230 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
2231END INTERFACE
2232
2238INTERFACE OPERATOR (/=)
2239 MODULE PROCEDURE datetime_ne, timedelta_ne
2240END INTERFACE
2241
2249INTERFACE OPERATOR (>)
2250 MODULE PROCEDURE datetime_gt, timedelta_gt
2251END INTERFACE
2252
2260INTERFACE OPERATOR (<)
2261 MODULE PROCEDURE datetime_lt, timedelta_lt
2262END INTERFACE
2263
2271INTERFACE OPERATOR (>=)
2272 MODULE PROCEDURE datetime_ge, timedelta_ge
2273END INTERFACE
2274
2282INTERFACE OPERATOR (<=)
2283 MODULE PROCEDURE datetime_le, timedelta_le
2284END INTERFACE
2285
2292INTERFACE OPERATOR (+)
2293 MODULE PROCEDURE datetime_add, timedelta_add
2294END INTERFACE
2295
2303INTERFACE OPERATOR (-)
2304 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
2305END INTERFACE
2306
2312INTERFACE OPERATOR (*)
2313 MODULE PROCEDURE timedelta_mult, timedelta_tlum
2314END INTERFACE
2315
2322INTERFACE OPERATOR (/)
2323 MODULE PROCEDURE timedelta_divint, timedelta_divtd
2324END INTERFACE
2325
2336INTERFACE mod
2337 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
2338END INTERFACE
2339
2342INTERFACE abs
2343 MODULE PROCEDURE timedelta_abs
2344END INTERFACE
2345
2348INTERFACE read_unit
2349 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
2350 timedelta_read_unit, timedelta_vect_read_unit
2351END INTERFACE
2352
2355INTERFACE write_unit
2356 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
2357 timedelta_write_unit, timedelta_vect_write_unit
2358END INTERFACE
2359
2361INTERFACE display
2362 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
2363END INTERFACE
2364
2366INTERFACE c_e
2367 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
2368END INTERFACE
2369
2370#undef VOL7D_POLY_TYPE
2371#undef VOL7D_POLY_TYPES
2372#undef ENABLE_SORT
2373#define VOL7D_POLY_TYPE TYPE(datetime)
2374#define VOL7D_POLY_TYPES _datetime
2375#define ENABLE_SORT
2376#include "array_utilities_pre.F90"
2377
2378
2379#define ARRAYOF_ORIGTYPE TYPE(datetime)
2380#define ARRAYOF_TYPE arrayof_datetime
2381#define ARRAYOF_ORIGEQ 1
2382#include "arrayof_pre.F90"
2383! from arrayof
2384
2385PRIVATE
2386
2387PUBLIC datetime, datetime_miss, datetime_utc, datetime_local, &
2388 datetime_min, datetime_max, &
2389 datetime_new, datetime_new_now, init, delete, getval, to_char, t2c, &
2391 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
2392 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
2393 OPERATOR(*), OPERATOR(/), mod, abs, &
2394 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
2395 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
2396 display, c_e, &
2397 count_distinct, pack_distinct, &
2398 count_distinct_sorted, pack_distinct_sorted, &
2399 count_and_pack_distinct, &
2400 map_distinct, map_inv_distinct, index, index_sorted, sort, &
2401 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
2402PUBLIC insert, append, remove, packarray
2403PUBLIC insert_unique, append_unique
2404PUBLIC cyclicdatetime_to_conventional
2405
2406CONTAINS
2407
2408
2409! ==============
2410! == datetime ==
2411! ==============
2412
2419ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
2420 unixtime, isodate, simpledate) RESULT(this)
2421INTEGER,INTENT(IN),OPTIONAL :: year
2422INTEGER,INTENT(IN),OPTIONAL :: month
2423INTEGER,INTENT(IN),OPTIONAL :: day
2424INTEGER,INTENT(IN),OPTIONAL :: hour
2425INTEGER,INTENT(IN),OPTIONAL :: minute
2426INTEGER,INTENT(IN),OPTIONAL :: msec
2427INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2428CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2429CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2430
2431TYPE(datetime) :: this
2432INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2433CHARACTER(len=23) :: datebuf
2434
2435IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
2436 lyear = year
2437 IF (PRESENT(month)) THEN
2438 lmonth = month
2439 ELSE
2440 lmonth = 1
2441 ENDIF
2442 IF (PRESENT(day)) THEN
2443 lday = day
2444 ELSE
2445 lday = 1
2446 ENDIF
2447 IF (PRESENT(hour)) THEN
2448 lhour = hour
2449 ELSE
2450 lhour = 0
2451 ENDIF
2452 IF (PRESENT(minute)) THEN
2453 lminute = minute
2454 ELSE
2455 lminute = 0
2456 ENDIF
2457 IF (PRESENT(msec)) THEN
2458 lmsec = msec
2459 ELSE
2460 lmsec = 0
2461 ENDIF
2462
2463 if (c_e(lday) .and. c_e(lmonth) .and. c_e(lyear) .and. c_e(lhour) &
2464 .and. c_e(lminute) .and. c_e(lmsec)) then
2465 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2466 else
2467 this=datetime_miss
2468 end if
2469
2470ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
2471 if (c_e(unixtime)) then
2472 this%iminuti = (unixtime + unsec)*1000
2473 else
2474 this=datetime_miss
2475 end if
2476
2477ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
2478
2479 IF (c_e(isodate) .AND. len_trim(isodate) > 0) THEN
2480 datebuf(1:23) = '0001-01-01 00:00:00.000'
2481 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
2482 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
2483 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2484 lmsec = lmsec + lsec*1000
2485 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2486 RETURN
2487
2488100 CONTINUE ! condizione di errore in isodate
2489 CALL delete(this)
2490 RETURN
2491 ELSE
2492 this = datetime_miss
2493 ENDIF
2494
2495ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
2496 IF (c_e(simpledate) .AND. len_trim(simpledate) > 0)THEN
2497 datebuf(1:17) = '00010101000000000'
2498 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
2499 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
2500 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
2501 lmsec = lmsec + lsec*1000
2502 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2503 RETURN
2504
2505120 CONTINUE ! condizione di errore in simpledate
2506 CALL delete(this)
2507 RETURN
2508 ELSE
2509 this = datetime_miss
2510 ENDIF
2511
2512ELSE
2513 this = datetime_miss
2514ENDIF
2515
2516END FUNCTION datetime_new
2517
2518
2520FUNCTION datetime_new_now(now) RESULT(this)
2521INTEGER,INTENT(IN) :: now
2522TYPE(datetime) :: this
2523
2524INTEGER :: dt(8)
2525
2526IF (c_e(now)) THEN
2527 CALL date_and_time(values=dt)
2528 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
2529 CALL init(this, year=dt(1), month=dt(2), day=dt(3), hour=dt(5), minute=dt(6), &
2530 msec=dt(7)*1000+dt(8))
2531ELSE
2532 this = datetime_miss
2533ENDIF
2534
2535END FUNCTION datetime_new_now
2536
2537
2544SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
2545 unixtime, isodate, simpledate, now)
2546TYPE(datetime),INTENT(INOUT) :: this
2547INTEGER,INTENT(IN),OPTIONAL :: year
2548INTEGER,INTENT(IN),OPTIONAL :: month
2549INTEGER,INTENT(IN),OPTIONAL :: day
2550INTEGER,INTENT(IN),OPTIONAL :: hour
2551INTEGER,INTENT(IN),OPTIONAL :: minute
2552INTEGER,INTENT(IN),OPTIONAL :: msec
2553INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
2554CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2555CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2556INTEGER,INTENT(IN),OPTIONAL :: now
2557
2558IF (PRESENT(now)) THEN
2559 this = datetime_new_now(now)
2560ELSE
2561 this = datetime_new(year, month, day, hour, minute, msec, &
2562 unixtime, isodate, simpledate)
2563ENDIF
2564
2565END SUBROUTINE datetime_init
2566
2567
2568ELEMENTAL SUBROUTINE datetime_delete(this)
2569TYPE(datetime),INTENT(INOUT) :: this
2570
2571this%iminuti = illmiss
2572
2573END SUBROUTINE datetime_delete
2574
2575
2580PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
2581 unixtime, isodate, simpledate, oraclesimdate)
2582TYPE(datetime),INTENT(IN) :: this
2583INTEGER,INTENT(OUT),OPTIONAL :: year
2584INTEGER,INTENT(OUT),OPTIONAL :: month
2585INTEGER,INTENT(OUT),OPTIONAL :: day
2586INTEGER,INTENT(OUT),OPTIONAL :: hour
2587INTEGER,INTENT(OUT),OPTIONAL :: minute
2588INTEGER,INTENT(OUT),OPTIONAL :: msec
2589INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime
2590CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
2591CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
2592CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
2593
2594INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2595CHARACTER(len=23) :: datebuf
2596
2597IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
2598 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
2599 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
2600
2601 IF (this == datetime_miss) THEN
2602
2603 IF (PRESENT(msec)) THEN
2604 msec = imiss
2605 ENDIF
2606 IF (PRESENT(minute)) THEN
2607 minute = imiss
2608 ENDIF
2609 IF (PRESENT(hour)) THEN
2610 hour = imiss
2611 ENDIF
2612 IF (PRESENT(day)) THEN
2613 day = imiss
2614 ENDIF
2615 IF (PRESENT(month)) THEN
2616 month = imiss
2617 ENDIF
2618 IF (PRESENT(year)) THEN
2619 year = imiss
2620 ENDIF
2621 IF (PRESENT(isodate)) THEN
2622 isodate = cmiss
2623 ENDIF
2624 IF (PRESENT(simpledate)) THEN
2625 simpledate = cmiss
2626 ENDIF
2627 IF (PRESENT(oraclesimdate)) THEN
2628!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2629!!$ 'obsoleto, usare piuttosto simpledate')
2630 oraclesimdate=cmiss
2631 ENDIF
2632 IF (PRESENT(unixtime)) THEN
2633 unixtime = illmiss
2634 ENDIF
2635
2636 ELSE
2637
2638 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
2639 IF (PRESENT(msec)) THEN
2640 msec = lmsec
2641 ENDIF
2642 IF (PRESENT(minute)) THEN
2643 minute = lminute
2644 ENDIF
2645 IF (PRESENT(hour)) THEN
2646 hour = lhour
2647 ENDIF
2648 IF (PRESENT(day)) THEN
2649 day = lday
2650 ENDIF
2651 IF (PRESENT(month)) THEN
2652 month = lmonth
2653 ENDIF
2654 IF (PRESENT(year)) THEN
2655 year = lyear
2656 ENDIF
2657 IF (PRESENT(isodate)) THEN
2658 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
2659 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
2660 '.', mod(lmsec, 1000)
2661 isodate = datebuf(1:min(len(isodate),23))
2662 ENDIF
2663 IF (PRESENT(simpledate)) THEN
2664 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
2665 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
2666 simpledate = datebuf(1:min(len(simpledate),17))
2667 ENDIF
2668 IF (PRESENT(oraclesimdate)) THEN
2669!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
2670!!$ 'obsoleto, usare piuttosto simpledate')
2671 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
2672 ENDIF
2673 IF (PRESENT(unixtime)) THEN
2674 unixtime = this%iminuti/1000_int_ll-unsec
2675 ENDIF
2676
2677 ENDIF
2678ENDIF
2679
2680END SUBROUTINE datetime_getval
2681
2682
2685elemental FUNCTION datetime_to_char(this) RESULT(char)
2686TYPE(datetime),INTENT(IN) :: this
2687
2688CHARACTER(len=23) :: char
2689
2690CALL getval(this, isodate=char)
2691
2692END FUNCTION datetime_to_char
2693
2694
2695FUNCTION trim_datetime_to_char(in) RESULT(char)
2696TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
2697
2698CHARACTER(len=len_trim(datetime_to_char(in))) :: char
2699
2700char=datetime_to_char(in)
2701
2702END FUNCTION trim_datetime_to_char
2703
2704
2705
2706SUBROUTINE display_datetime(this)
2707TYPE(datetime),INTENT(in) :: this
2708
2709print*,"TIME: ",to_char(this)
2710
2711end subroutine display_datetime
2712
2713
2714
2715SUBROUTINE display_timedelta(this)
2716TYPE(timedelta),INTENT(in) :: this
2717
2718print*,"TIMEDELTA: ",to_char(this)
2719
2720end subroutine display_timedelta
2721
2722
2723
2724ELEMENTAL FUNCTION c_e_datetime(this) result (res)
2725TYPE(datetime),INTENT(in) :: this
2726LOGICAL :: res
2727
2728res = .not. this == datetime_miss
2729
2730end FUNCTION c_e_datetime
2731
2732
2733ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
2734TYPE(datetime),INTENT(IN) :: this, that
2735LOGICAL :: res
2736
2737res = this%iminuti == that%iminuti
2738
2739END FUNCTION datetime_eq
2740
2741
2742ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
2743TYPE(datetime),INTENT(IN) :: this, that
2744LOGICAL :: res
2745
2746res = .NOT.(this == that)
2747
2748END FUNCTION datetime_ne
2749
2750
2751ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
2752TYPE(datetime),INTENT(IN) :: this, that
2753LOGICAL :: res
2754
2755res = this%iminuti > that%iminuti
2756
2757END FUNCTION datetime_gt
2758
2759
2760ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
2761TYPE(datetime),INTENT(IN) :: this, that
2762LOGICAL :: res
2763
2764res = this%iminuti < that%iminuti
2765
2766END FUNCTION datetime_lt
2767
2768
2769ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
2770TYPE(datetime),INTENT(IN) :: this, that
2771LOGICAL :: res
2772
2773IF (this == that) THEN
2774 res = .true.
2775ELSE IF (this > that) THEN
2776 res = .true.
2777ELSE
2778 res = .false.
2779ENDIF
2780
2781END FUNCTION datetime_ge
2782
2783
2784ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
2785TYPE(datetime),INTENT(IN) :: this, that
2786LOGICAL :: res
2787
2788IF (this == that) THEN
2789 res = .true.
2790ELSE IF (this < that) THEN
2791 res = .true.
2792ELSE
2793 res = .false.
2794ENDIF
2795
2796END FUNCTION datetime_le
2797
2798
2799FUNCTION datetime_add(this, that) RESULT(res)
2800TYPE(datetime),INTENT(IN) :: this
2801TYPE(timedelta),INTENT(IN) :: that
2802TYPE(datetime) :: res
2803
2804INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2805
2806IF (this == datetime_miss .OR. that == timedelta_miss) THEN
2807 res = datetime_miss
2808ELSE
2809 res%iminuti = this%iminuti + that%iminuti
2810 IF (that%month /= 0) THEN
2811 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
2812 minute=lminute, msec=lmsec)
2813 CALL init(res, year=lyear, month=lmonth+that%month, day=lday, &
2814 hour=lhour, minute=lminute, msec=lmsec)
2815 ENDIF
2816ENDIF
2817
2818END FUNCTION datetime_add
2819
2820
2821ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
2822TYPE(datetime),INTENT(IN) :: this, that
2823TYPE(timedelta) :: res
2824
2825IF (this == datetime_miss .OR. that == datetime_miss) THEN
2826 res = timedelta_miss
2827ELSE
2828 res%iminuti = this%iminuti - that%iminuti
2829 res%month = 0
2830ENDIF
2831
2832END FUNCTION datetime_subdt
2833
2834
2835FUNCTION datetime_subtd(this, that) RESULT(res)
2836TYPE(datetime),INTENT(IN) :: this
2837TYPE(timedelta),INTENT(IN) :: that
2838TYPE(datetime) :: res
2839
2840INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
2841
2842IF (this == datetime_miss .OR. that == timedelta_miss) THEN
2843 res = datetime_miss
2844ELSE
2845 res%iminuti = this%iminuti - that%iminuti
2846 IF (that%month /= 0) THEN
2847 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
2848 minute=lminute, msec=lmsec)
2849 CALL init(res, year=lyear, month=lmonth-that%month, day=lday, &
2850 hour=lhour, minute=lminute, msec=lmsec)
2851 ENDIF
2852ENDIF
2853
2854END FUNCTION datetime_subtd
2855
2856
2861SUBROUTINE datetime_read_unit(this, unit)
2862TYPE(datetime),INTENT(out) :: this
2863INTEGER, INTENT(in) :: unit
2864CALL datetime_vect_read_unit((/this/), unit)
2865
2866END SUBROUTINE datetime_read_unit
2867
2868
2873SUBROUTINE datetime_vect_read_unit(this, unit)
2874TYPE(datetime) :: this(:)
2875INTEGER, INTENT(in) :: unit
2876
2877CHARACTER(len=40) :: form
2878CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
2879INTEGER :: i
2880
2881ALLOCATE(dateiso(SIZE(this)))
2882INQUIRE(unit, form=form)
2883IF (form == 'FORMATTED') THEN
2884 READ(unit,'(A23,1X)')dateiso
2885ELSE
2886 READ(unit)dateiso
2887ENDIF
2888DO i = 1, SIZE(dateiso)
2889 CALL init(this(i), isodate=dateiso(i))
2890ENDDO
2891DEALLOCATE(dateiso)
2892
2893END SUBROUTINE datetime_vect_read_unit
2894
2895
2900SUBROUTINE datetime_write_unit(this, unit)
2901TYPE(datetime),INTENT(in) :: this
2902INTEGER, INTENT(in) :: unit
2903
2904CALL datetime_vect_write_unit((/this/), unit)
2905
2906END SUBROUTINE datetime_write_unit
2907
2908
2913SUBROUTINE datetime_vect_write_unit(this, unit)
2914TYPE(datetime),INTENT(in) :: this(:)
2915INTEGER, INTENT(in) :: unit
2916
2917CHARACTER(len=40) :: form
2918CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
2919INTEGER :: i
2920
2921ALLOCATE(dateiso(SIZE(this)))
2922DO i = 1, SIZE(dateiso)
2923 CALL getval(this(i), isodate=dateiso(i))
2924ENDDO
2925INQUIRE(unit, form=form)
2926IF (form == 'FORMATTED') THEN
2927 WRITE(unit,'(A23,1X)')dateiso
2928ELSE
2929 WRITE(unit)dateiso
2930ENDIF
2931DEALLOCATE(dateiso)
2932
2933END SUBROUTINE datetime_vect_write_unit
2934
2935
2936#include "arrayof_post.F90"
2937
2938
2939! ===============
2940! == timedelta ==
2941! ===============
2948FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
2949 isodate, simpledate, oraclesimdate) RESULT (this)
2950INTEGER,INTENT(IN),OPTIONAL :: year
2951INTEGER,INTENT(IN),OPTIONAL :: month
2952INTEGER,INTENT(IN),OPTIONAL :: day
2953INTEGER,INTENT(IN),OPTIONAL :: hour
2954INTEGER,INTENT(IN),OPTIONAL :: minute
2955INTEGER,INTENT(IN),OPTIONAL :: sec
2956INTEGER,INTENT(IN),OPTIONAL :: msec
2957CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2958CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2959CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
2960
2961TYPE(timedelta) :: this
2962
2963CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
2964 isodate, simpledate, oraclesimdate)
2965
2966END FUNCTION timedelta_new
2967
2968
2973SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
2974 isodate, simpledate, oraclesimdate)
2975TYPE(timedelta),INTENT(INOUT) :: this
2976INTEGER,INTENT(IN),OPTIONAL :: year
2977INTEGER,INTENT(IN),OPTIONAL :: month
2978INTEGER,INTENT(IN),OPTIONAL :: day
2979INTEGER,INTENT(IN),OPTIONAL :: hour
2980INTEGER,INTENT(IN),OPTIONAL :: minute
2981INTEGER,INTENT(IN),OPTIONAL :: sec
2982INTEGER,INTENT(IN),OPTIONAL :: msec
2983CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
2984CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
2985CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
2986
2987INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
2988CHARACTER(len=23) :: datebuf
2989
2990this%month = 0
2991
2992IF (PRESENT(isodate)) THEN
2993 datebuf(1:23) = '0000000000 00:00:00.000'
2994 l = len_trim(isodate)
2995! IF (l > 0) THEN
2996 n = index(trim(isodate), ' ') ! align blank space separator
2997 IF (n > 0) THEN
2998 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
2999 datebuf(12-n:12-n+l-1) = isodate(:l)
3000 ELSE
3001 datebuf(1:l) = isodate(1:l)
3002 ENDIF
3003! ENDIF
3004
3005! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3006 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3007 h, m, s, ms
3008 this%month = lmonth + 12*lyear
3009 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3010 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3011 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3012 RETURN
3013
3014200 CONTINUE ! condizione di errore in isodate
3015 CALL delete(this)
3016 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3017 CALL raise_error()
3018
3019ELSE IF (PRESENT(simpledate)) THEN
3020 datebuf(1:17) = '00000000000000000'
3021 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3022 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3023 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3024 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3025 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3026
3027220 CONTINUE ! condizione di errore in simpledate
3028 CALL delete(this)
3029 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3030 CALL raise_error()
3031 RETURN
3032
3033ELSE IF (PRESENT(oraclesimdate)) THEN
3034 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3035 'obsoleto, usare piuttosto simpledate')
3036 READ(oraclesimdate, '(I8,2I2)')d, h, m
3037 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3038 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3039
3040ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3041 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3042 .and. .not. present(msec) .and. .not. present(isodate) &
3043 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3044
3045 this=timedelta_miss
3046
3047ELSE
3048 this%iminuti = 0
3049 IF (PRESENT(year)) THEN
3050 if (c_e(year))then
3051 this%month = this%month + year*12
3052 else
3053 this=timedelta_miss
3054 return
3055 end if
3056 ENDIF
3057 IF (PRESENT(month)) THEN
3058 if (c_e(month))then
3059 this%month = this%month + month
3060 else
3061 this=timedelta_miss
3062 return
3063 end if
3064 ENDIF
3065 IF (PRESENT(day)) THEN
3066 if (c_e(day))then
3067 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3068 else
3069 this=timedelta_miss
3070 return
3071 end if
3072 ENDIF
3073 IF (PRESENT(hour)) THEN
3074 if (c_e(hour))then
3075 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3076 else
3077 this=timedelta_miss
3078 return
3079 end if
3080 ENDIF
3081 IF (PRESENT(minute)) THEN
3082 if (c_e(minute))then
3083 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3084 else
3085 this=timedelta_miss
3086 return
3087 end if
3088 ENDIF
3089 IF (PRESENT(sec)) THEN
3090 if (c_e(sec))then
3091 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3092 else
3093 this=timedelta_miss
3094 return
3095 end if
3096 ENDIF
3097 IF (PRESENT(msec)) THEN
3098 if (c_e(msec))then
3099 this%iminuti = this%iminuti + msec
3100 else
3101 this=timedelta_miss
3102 return
3103 end if
3104 ENDIF
3105ENDIF
3106
3107
3108
3109
3110END SUBROUTINE timedelta_init
3111
3112
3113SUBROUTINE timedelta_delete(this)
3114TYPE(timedelta),INTENT(INOUT) :: this
3115
3116this%iminuti = imiss
3117this%month = 0
3118
3119END SUBROUTINE timedelta_delete
3120
3121
3126PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3127 day, hour, minute, sec, msec, &
3128 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3129TYPE(timedelta),INTENT(IN) :: this
3130INTEGER,INTENT(OUT),OPTIONAL :: year
3131INTEGER,INTENT(OUT),OPTIONAL :: month
3132INTEGER,INTENT(OUT),OPTIONAL :: amonth
3133INTEGER,INTENT(OUT),OPTIONAL :: day
3134INTEGER,INTENT(OUT),OPTIONAL :: hour
3135INTEGER,INTENT(OUT),OPTIONAL :: minute
3136INTEGER,INTENT(OUT),OPTIONAL :: sec
3137INTEGER,INTENT(OUT),OPTIONAL :: msec
3138INTEGER,INTENT(OUT),OPTIONAL :: ahour
3139INTEGER,INTENT(OUT),OPTIONAL :: aminute
3140INTEGER,INTENT(OUT),OPTIONAL :: asec
3141INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec
3142CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3143CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3144CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3145
3146CHARACTER(len=23) :: datebuf
3147
3148IF (PRESENT(amsec)) THEN
3149 amsec = this%iminuti
3150ENDIF
3151IF (PRESENT(asec)) THEN
3152 asec = int(this%iminuti/1000_int_ll)
3153ENDIF
3154IF (PRESENT(aminute)) THEN
3155 aminute = int(this%iminuti/60000_int_ll)
3156ENDIF
3157IF (PRESENT(ahour)) THEN
3158 ahour = int(this%iminuti/3600000_int_ll)
3159ENDIF
3160IF (PRESENT(msec)) THEN
3161 msec = int(mod(this%iminuti, 1000_int_ll))
3162ENDIF
3163IF (PRESENT(sec)) THEN
3164 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3165ENDIF
3166IF (PRESENT(minute)) THEN
3167 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3168ENDIF
3169IF (PRESENT(hour)) THEN
3170 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3171ENDIF
3172IF (PRESENT(day)) THEN
3173 day = int(this%iminuti/86400000_int_ll)
3174ENDIF
3175IF (PRESENT(amonth)) THEN
3176 amonth = this%month
3177ENDIF
3178IF (PRESENT(month)) THEN
3179 month = mod(this%month-1,12)+1
3180ENDIF
3181IF (PRESENT(year)) THEN
3182 year = this%month/12
3183ENDIF
3184IF (PRESENT(isodate)) THEN ! Non standard, inventato!
3185 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3186 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), ':', &
3187 mod(this%iminuti/60000_int_ll, 60_int_ll), ':', mod(this%iminuti/1000_int_ll, 60_int_ll), &
3188 '.', mod(this%iminuti, 1000_int_ll)
3189 isodate = datebuf(1:min(len(isodate),23))
3190
3191ENDIF
3192IF (PRESENT(simpledate)) THEN
3193 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
3194 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
3195 mod(this%iminuti/60000_int_ll, 60_int_ll), mod(this%iminuti/1000_int_ll, 60_int_ll), &
3196 mod(this%iminuti, 1000_int_ll)
3197 simpledate = datebuf(1:min(len(simpledate),17))
3198ENDIF
3199IF (PRESENT(oraclesimdate)) THEN
3200!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
3201!!$ 'obsoleto, usare piuttosto simpledate')
3202 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
3203 mod(this%iminuti/3600000_int_ll, 24_int_ll), mod(this%iminuti/60000_int_ll, 60_int_ll)
3204ENDIF
3205
3206END SUBROUTINE timedelta_getval
3207
3208
3211elemental FUNCTION timedelta_to_char(this) RESULT(char)
3212TYPE(timedelta),INTENT(IN) :: this
3213
3214CHARACTER(len=23) :: char
3215
3216CALL getval(this, isodate=char)
3217
3218END FUNCTION timedelta_to_char
3219
3220
3221FUNCTION trim_timedelta_to_char(in) RESULT(char)
3222TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
3223
3224CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
3225
3226char=timedelta_to_char(in)
3227
3228END FUNCTION trim_timedelta_to_char
3229
3230
3232elemental FUNCTION timedelta_getamsec(this)
3233TYPE(timedelta),INTENT(IN) :: this
3234INTEGER(kind=int_ll) :: timedelta_getamsec
3235
3236timedelta_getamsec = this%iminuti
3237
3238END FUNCTION timedelta_getamsec
3239
3240
3246FUNCTION timedelta_depop(this)
3247TYPE(timedelta),INTENT(IN) :: this
3248TYPE(timedelta) :: timedelta_depop
3249
3250TYPE(datetime) :: tmpdt
3251
3252IF (this%month == 0) THEN
3253 timedelta_depop = this
3254ELSE
3255 tmpdt = datetime_new(1970, 1, 1)
3256 timedelta_depop = (tmpdt + this) - tmpdt
3257ENDIF
3258
3259END FUNCTION timedelta_depop
3260
3261
3262elemental FUNCTION timedelta_eq(this, that) RESULT(res)
3263TYPE(timedelta),INTENT(IN) :: this, that
3264LOGICAL :: res
3265
3266res = (this%iminuti == that%iminuti .AND. this%month == that%month)
3267
3268END FUNCTION timedelta_eq
3269
3270
3271ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
3272TYPE(timedelta),INTENT(IN) :: this, that
3273LOGICAL :: res
3274
3275res = .NOT.(this == that)
3276
3277END FUNCTION timedelta_ne
3278
3279
3280ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
3281TYPE(timedelta),INTENT(IN) :: this, that
3282LOGICAL :: res
3283
3284res = this%iminuti > that%iminuti
3285
3286END FUNCTION timedelta_gt
3287
3288
3289ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
3290TYPE(timedelta),INTENT(IN) :: this, that
3291LOGICAL :: res
3292
3293res = this%iminuti < that%iminuti
3294
3295END FUNCTION timedelta_lt
3296
3297
3298ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
3299TYPE(timedelta),INTENT(IN) :: this, that
3300LOGICAL :: res
3301
3302IF (this == that) THEN
3303 res = .true.
3304ELSE IF (this > that) THEN
3305 res = .true.
3306ELSE
3307 res = .false.
3308ENDIF
3309
3310END FUNCTION timedelta_ge
3311
3312
3313elemental FUNCTION timedelta_le(this, that) RESULT(res)
3314TYPE(timedelta),INTENT(IN) :: this, that
3315LOGICAL :: res
3316
3317IF (this == that) THEN
3318 res = .true.
3319ELSE IF (this < that) THEN
3320 res = .true.
3321ELSE
3322 res = .false.
3323ENDIF
3324
3325END FUNCTION timedelta_le
3326
3327
3328ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
3329TYPE(timedelta),INTENT(IN) :: this, that
3330TYPE(timedelta) :: res
3331
3332res%iminuti = this%iminuti + that%iminuti
3333res%month = this%month + that%month
3334
3335END FUNCTION timedelta_add
3336
3337
3338ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
3339TYPE(timedelta),INTENT(IN) :: this, that
3340TYPE(timedelta) :: res
3341
3342res%iminuti = this%iminuti - that%iminuti
3343res%month = this%month - that%month
3344
3345END FUNCTION timedelta_sub
3346
3347
3348ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
3349TYPE(timedelta),INTENT(IN) :: this
3350INTEGER,INTENT(IN) :: n
3351TYPE(timedelta) :: res
3352
3353res%iminuti = this%iminuti*n
3354res%month = this%month*n
3355
3356END FUNCTION timedelta_mult
3357
3358
3359ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
3360INTEGER,INTENT(IN) :: n
3361TYPE(timedelta),INTENT(IN) :: this
3362TYPE(timedelta) :: res
3363
3364res%iminuti = this%iminuti*n
3365res%month = this%month*n
3366
3367END FUNCTION timedelta_tlum
3368
3369
3370ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
3371TYPE(timedelta),INTENT(IN) :: this
3372INTEGER,INTENT(IN) :: n
3373TYPE(timedelta) :: res
3374
3375res%iminuti = this%iminuti/n
3376res%month = this%month/n
3377
3378END FUNCTION timedelta_divint
3379
3380
3381ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
3382TYPE(timedelta),INTENT(IN) :: this, that
3383INTEGER :: res
3384
3385res = int(this%iminuti/that%iminuti)
3386
3387END FUNCTION timedelta_divtd
3388
3389
3390elemental FUNCTION timedelta_mod(this, that) RESULT(res)
3391TYPE(timedelta),INTENT(IN) :: this, that
3392TYPE(timedelta) :: res
3393
3394res%iminuti = mod(this%iminuti, that%iminuti)
3395res%month = 0
3396
3397END FUNCTION timedelta_mod
3398
3399
3400ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
3401TYPE(datetime),INTENT(IN) :: this
3402TYPE(timedelta),INTENT(IN) :: that
3403TYPE(timedelta) :: res
3404
3405IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
3406 res = timedelta_0
3407ELSE
3408 res%iminuti = mod(this%iminuti, that%iminuti)
3409 res%month = 0
3410ENDIF
3411
3412END FUNCTION datetime_timedelta_mod
3413
3414
3415ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
3416TYPE(timedelta),INTENT(IN) :: this
3417TYPE(timedelta) :: res
3418
3419res%iminuti = abs(this%iminuti)
3420res%month = abs(this%month)
3421
3422END FUNCTION timedelta_abs
3423
3424
3429SUBROUTINE timedelta_read_unit(this, unit)
3430TYPE(timedelta),INTENT(out) :: this
3431INTEGER, INTENT(in) :: unit
3432
3433CALL timedelta_vect_read_unit((/this/), unit)
3434
3435END SUBROUTINE timedelta_read_unit
3436
3437
3442SUBROUTINE timedelta_vect_read_unit(this, unit)
3443TYPE(timedelta) :: this(:)
3444INTEGER, INTENT(in) :: unit
3445
3446CHARACTER(len=40) :: form
3447CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3448INTEGER :: i
3449
3450ALLOCATE(dateiso(SIZE(this)))
3451INQUIRE(unit, form=form)
3452IF (form == 'FORMATTED') THEN
3453 READ(unit,'(3(A23,1X))')dateiso
3454ELSE
3455 READ(unit)dateiso
3456ENDIF
3457DO i = 1, SIZE(dateiso)
3458 CALL init(this(i), isodate=dateiso(i))
3459ENDDO
3460DEALLOCATE(dateiso)
3461
3462END SUBROUTINE timedelta_vect_read_unit
3463
3464
3469SUBROUTINE timedelta_write_unit(this, unit)
3470TYPE(timedelta),INTENT(in) :: this
3471INTEGER, INTENT(in) :: unit
3472
3473CALL timedelta_vect_write_unit((/this/), unit)
3474
3475END SUBROUTINE timedelta_write_unit
3476
3477
3482SUBROUTINE timedelta_vect_write_unit(this, unit)
3483TYPE(timedelta),INTENT(in) :: this(:)
3484INTEGER, INTENT(in) :: unit
3485
3486CHARACTER(len=40) :: form
3487CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3488INTEGER :: i
3489
3490ALLOCATE(dateiso(SIZE(this)))
3491DO i = 1, SIZE(dateiso)
3492 CALL getval(this(i), isodate=dateiso(i))
3493ENDDO
3494INQUIRE(unit, form=form)
3495IF (form == 'FORMATTED') THEN
3496 WRITE(unit,'(3(A23,1X))')dateiso
3497ELSE
3498 WRITE(unit)dateiso
3499ENDIF
3500DEALLOCATE(dateiso)
3501
3502END SUBROUTINE timedelta_vect_write_unit
3503
3504
3505ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
3506TYPE(timedelta),INTENT(in) :: this
3507LOGICAL :: res
3508
3509res = .not. this == timedelta_miss
3510
3511end FUNCTION c_e_timedelta
3512
3513
3514elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
3515
3516!!omstart JELADATA5
3517! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3518! 1 IMINUTI)
3519!
3520! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
3521!
3522! variabili integer*4
3523! IN:
3524! IDAY,IMONTH,IYEAR, I*4
3525! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3526!
3527! OUT:
3528! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3529!!OMEND
3530
3531INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
3532INTEGER,intent(out) :: iminuti
3533
3534iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
3535
3536END SUBROUTINE jeladata5
3537
3538
3539elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
3540INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
3541INTEGER(KIND=int_ll),intent(out) :: imillisec
3542
3543imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
3544 + imsec
3545
3546END SUBROUTINE jeladata5_1
3547
3548
3549
3550elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
3551
3552!!omstart JELADATA6
3553! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
3554! 1 IMINUTI)
3555!
3556! Calcola la data e l'ora corrispondente a IMINUTI dopo il
3557! 1/1/1
3558!
3559! variabili integer*4
3560! IN:
3561! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
3562!
3563! OUT:
3564! IDAY,IMONTH,IYEAR, I*4
3565! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
3566!!OMEND
3567
3568
3569INTEGER,intent(in) :: iminuti
3570INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
3571
3572INTEGER ::igiorno
3573
3574imin = mod(iminuti,60)
3575ihour = mod(iminuti,1440)/60
3576igiorno = iminuti/1440
3577IF (mod(iminuti,1440) < 0) igiorno = igiorno-1
3578CALL ndyin(igiorno,iday,imonth,iyear)
3579
3580END SUBROUTINE jeladata6
3581
3582
3583elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
3584INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
3585INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
3586
3587INTEGER :: igiorno
3588
3589imsec = int(mod(imillisec, 60000_int_ll)) ! partial msec
3590!imin = MOD(imillisec/60000_int_ll, 60)
3591!ihour = MOD(imillisec/3600000_int_ll, 24)
3592imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
3593ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
3594igiorno = int(imillisec/86400000_int_ll)
3595!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
3596CALL ndyin(igiorno,iday,imonth,iyear)
3597
3598END SUBROUTINE jeladata6_1
3599
3600
3601elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
3602
3603!!OMSTART NDYIN
3604! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
3605! restituisce la data fornendo in input il numero di
3606! giorni dal 1/1/1
3607!
3608!!omend
3609
3610INTEGER,intent(in) :: ndays
3611INTEGER,intent(out) :: igg, imm, iaa
3612integer :: n,lndays
3613
3614lndays=ndays
3615
3616n = lndays/d400
3617lndays = lndays - n*d400
3618iaa = year0 + n*400
3619n = min(lndays/d100, 3)
3620lndays = lndays - n*d100
3621iaa = iaa + n*100
3622n = lndays/d4
3623lndays = lndays - n*d4
3624iaa = iaa + n*4
3625n = min(lndays/d1, 3)
3626lndays = lndays - n*d1
3627iaa = iaa + n
3628n = bisextilis(iaa)
3629DO imm = 1, 12
3630 IF (lndays < ianno(imm+1,n)) EXIT
3631ENDDO
3632igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
3633
3634END SUBROUTINE ndyin
3635
3636
3637integer elemental FUNCTION ndays(igg,imm,iaa)
3638
3639!!OMSTART NDAYS
3640! FUNCTION NDAYS(IGG,IMM,IAA)
3641! restituisce il numero di giorni dal 1/1/1
3642! fornendo in input la data
3643!
3644!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3645! nota bene E' SICURO !!!
3646! un anno e' bisestile se divisibile per 4
3647! un anno rimane bisestile se divisibile per 400
3648! un anno NON e' bisestile se divisibile per 100
3649!
3650!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3651!
3652!!omend
3653
3654INTEGER, intent(in) :: igg, imm, iaa
3655
3656INTEGER :: lmonth, lyear
3657
3658! Limito il mese a [1-12] e correggo l'anno coerentemente
3659lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
3660lyear = iaa + (imm - lmonth)/12
3661ndays = igg+ianno(lmonth, bisextilis(lyear))
3662ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
3663 (lyear-year0)/400
3664
3665END FUNCTION ndays
3666
3667
3668elemental FUNCTION bisextilis(annum)
3669INTEGER,INTENT(in) :: annum
3670INTEGER :: bisextilis
3671
3672IF (mod(annum,4) == 0 .AND. (mod(annum,400) == 0 .EQV. mod(annum,100) == 0)) THEN
3673 bisextilis = 2
3674ELSE
3675 bisextilis = 1
3676ENDIF
3677END FUNCTION bisextilis
3678
3679
3680ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
3681TYPE(cyclicdatetime),INTENT(IN) :: this, that
3682LOGICAL :: res
3683
3684res = .true.
3685if (this%minute /= that%minute) res=.false.
3686if (this%hour /= that%hour) res=.false.
3687if (this%day /= that%day) res=.false.
3688if (this%month /= that%month) res=.false.
3689if (this%tendaysp /= that%tendaysp) res=.false.
3690
3691END FUNCTION cyclicdatetime_eq
3692
3693
3694ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
3695TYPE(cyclicdatetime),INTENT(IN) :: this
3696TYPE(datetime),INTENT(IN) :: that
3697LOGICAL :: res
3698
3699integer :: minute,hour,day,month
3700
3701call getval(that,minute=minute,hour=hour,day=day,month=month)
3702
3703res = .true.
3704if (c_e(this%minute) .and. this%minute /= minute) res=.false.
3705if (c_e(this%hour) .and. this%hour /= hour) res=.false.
3706if (c_e(this%day) .and. this%day /= day) res=.false.
3707if (c_e(this%month) .and. this%month /= month) res=.false.
3708if (c_e(this%tendaysp)) then
3709 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
3710end if
3711
3712END FUNCTION cyclicdatetime_datetime_eq
3713
3714
3715ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
3716TYPE(datetime),INTENT(IN) :: this
3717TYPE(cyclicdatetime),INTENT(IN) :: that
3718LOGICAL :: res
3719
3720integer :: minute,hour,day,month
3721
3722call getval(this,minute=minute,hour=hour,day=day,month=month)
3723
3724res = .true.
3725if (c_e(that%minute) .and. that%minute /= minute) res=.false.
3726if (c_e(that%hour) .and. that%hour /= hour) res=.false.
3727if (c_e(that%day) .and. that%day /= day) res=.false.
3728if (c_e(that%month) .and. that%month /= month) res=.false.
3729
3730if (c_e(that%tendaysp)) then
3731 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
3732end if
3733
3734
3735END FUNCTION datetime_cyclicdatetime_eq
3736
3737ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
3738TYPE(cyclicdatetime),INTENT(in) :: this
3739LOGICAL :: res
3740
3741res = .not. this == cyclicdatetime_miss
3742
3743end FUNCTION c_e_cyclicdatetime
3744
3745
3748FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
3749INTEGER,INTENT(IN),OPTIONAL :: tendaysp
3750INTEGER,INTENT(IN),OPTIONAL :: month
3751INTEGER,INTENT(IN),OPTIONAL :: day
3752INTEGER,INTENT(IN),OPTIONAL :: hour
3753INTEGER,INTENT(IN),OPTIONAL :: minute
3754CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate
3755
3756integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
3757
3758
3759TYPE(cyclicdatetime) :: this
3760
3761if (present(chardate)) then
3762
3763 ltendaysp=imiss
3764 lmonth=imiss
3765 lday=imiss
3766 lhour=imiss
3767 lminute=imiss
3768
3769 if (c_e(chardate))then
3770 ! TMMGGhhmm
3771 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
3772 !print*,chardate(1:1),ios,ltendaysp
3773 if (ios /= 0)ltendaysp=imiss
3774
3775 read(chardate(2:3),'(i2)',iostat=ios)lmonth
3776 !print*,chardate(2:3),ios,lmonth
3777 if (ios /= 0)lmonth=imiss
3778
3779 read(chardate(4:5),'(i2)',iostat=ios)lday
3780 !print*,chardate(4:5),ios,lday
3781 if (ios /= 0)lday=imiss
3782
3783 read(chardate(6:7),'(i2)',iostat=ios)lhour
3784 !print*,chardate(6:7),ios,lhour
3785 if (ios /= 0)lhour=imiss
3786
3787 read(chardate(8:9),'(i2)',iostat=ios)lminute
3788 !print*,chardate(8:9),ios,lminute
3789 if (ios /= 0)lminute=imiss
3790 end if
3791
3792 this%tendaysp=ltendaysp
3793 this%month=lmonth
3794 this%day=lday
3795 this%hour=lhour
3796 this%minute=lminute
3797else
3798 this%tendaysp=optio_l(tendaysp)
3799 this%month=optio_l(month)
3800 this%day=optio_l(day)
3801 this%hour=optio_l(hour)
3802 this%minute=optio_l(minute)
3803end if
3804
3805END FUNCTION cyclicdatetime_new
3806
3809elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
3810TYPE(cyclicdatetime),INTENT(IN) :: this
3811
3812CHARACTER(len=80) :: char
3813
3814char=to_char(this%tendaysp)//";"//to_char(this%month)//";"//to_char(this%day)//";"//&
3815to_char(this%hour)//";"//to_char(this%minute)
3816
3817END FUNCTION cyclicdatetime_to_char
3818
3819
3832FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
3833TYPE(cyclicdatetime),INTENT(IN) :: this
3834
3835TYPE(datetime) :: dtc
3836
3837integer :: year,month,day,hour
3838
3839dtc = datetime_miss
3840
3841! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
3842if ( .not. c_e(this)) then
3843 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
3844 return
3845end if
3846
3847! minute present -> not good for conventional datetime
3848if (c_e(this%minute)) return
3849! day, month and tendaysp present -> no good
3850if (c_e(this%day) .and. c_e(this%month) .and. c_e(this%tendaysp)) return
3851
3852if (c_e(this%day) .and. c_e(this%month)) then
3853 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
3854else if (c_e(this%tendaysp) .and. c_e(this%month)) then
3855 day=(this%tendaysp-1)*10+1
3856 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
3857else if (c_e(this%month)) then
3858 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
3859else if (c_e(this%day)) then
3860 ! only day present -> no good
3861 return
3862end if
3863
3864if (c_e(this%hour)) then
3865 call getval(dtc,year=year,month=month,day=day,hour=hour)
3866 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
3867end if
3868
3869
3870END FUNCTION cyclicdatetime_to_conventional
3871
3872
3873
3874FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
3875TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3876
3877CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
3878
3879char=cyclicdatetime_to_char(in)
3880
3881END FUNCTION trim_cyclicdatetime_to_char
3882
3883
3884
3885SUBROUTINE display_cyclicdatetime(this)
3886TYPE(cyclicdatetime),INTENT(in) :: this
3887
3888print*,"CYCLICDATETIME: ",to_char(this)
3889
3890end subroutine display_cyclicdatetime
3891
3892
3893#include "array_utilities_inc.F90"
3894
3895END MODULE datetime_class
3896
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.