libsim Versione 7.2.1

◆ timedelta_read_unit()

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

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

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