libsim Versione 7.2.1

◆ timedelta_vect_read_unit()

subroutine timedelta_vect_read_unit ( type(timedelta), dimension(:)  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
thisobject to be read
[in]unitunit from which to read, it must be an opened Fortran file unit

Definizione alla linea 2012 del file datetime_class.F90.

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