libsim Versione 7.1.11

◆ timedelta_write_unit()

subroutine timedelta_write_unit ( type(timedelta), 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 2045 del file datetime_class.F90.

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