libsim Versione 7.1.11

◆ timedelta_read_unit()

subroutine timedelta_read_unit ( type(timedelta), intent(out)  this,
integer, intent(in)  unit 
)

This method reads from a Fortran file unit the contents of the object this.

The record to be read must have been written with the ::write_unit method. The method works both on formatted and unformatted files.

Parametri
[out]thisobject to be read
[in]unitunit from which to read, it must be an opened Fortran file unit

Definizione alla linea 2005 del file datetime_class.F90.

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