libsim Versione 7.1.11

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

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

Generated with Doxygen.