libsim Versione 7.2.0

◆ timedelta_vect_write_unit()

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

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

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

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

Definizione alla linea 2052 del file datetime_class.F90.

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