libsim Versione 7.2.1
|
◆ map_inv_distinct_datetime()
map inv distinct Definizione alla linea 2877 del file datetime_class.F90. 2879! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2880! authors:
2881! Davide Cesari <dcesari@arpa.emr.it>
2882! Paolo Patruno <ppatruno@arpa.emr.it>
2883
2884! This program is free software; you can redistribute it and/or
2885! modify it under the terms of the GNU General Public License as
2886! published by the Free Software Foundation; either version 2 of
2887! the License, or (at your option) any later version.
2888
2889! This program is distributed in the hope that it will be useful,
2890! but WITHOUT ANY WARRANTY; without even the implied warranty of
2891! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2892! GNU General Public License for more details.
2893
2894! You should have received a copy of the GNU General Public License
2895! along with this program. If not, see <http://www.gnu.org/licenses/>.
2896#include "config.h"
2897
2918IMPLICIT NONE
2919
2920INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2921
2924 PRIVATE
2925 INTEGER(KIND=int_ll) :: iminuti
2927
2936 PRIVATE
2937 INTEGER(KIND=int_ll) :: iminuti
2938 INTEGER :: month
2940
2941
2946 PRIVATE
2947 INTEGER :: minute
2948 INTEGER :: hour
2949 INTEGER :: day
2950 INTEGER :: tendaysp
2951 INTEGER :: month
2953
2954
2962INTEGER, PARAMETER :: datetime_utc=1
2964INTEGER, PARAMETER :: datetime_local=2
2974TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2975
2976
2977INTEGER(kind=dateint), PARAMETER :: &
2978 sec_in_day=86400, &
2979 sec_in_hour=3600, &
2980 sec_in_min=60, &
2981 min_in_day=1440, &
2982 min_in_hour=60, &
2983 hour_in_day=24
2984
2985INTEGER,PARAMETER :: &
2986 year0=1, & ! anno di origine per iminuti
2987 d1=365, & ! giorni/1 anno nel calendario gregoriano
2988 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2989 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2990 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2991 ianno(13,2)=reshape((/ &
2992 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2993 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
2994
2995INTEGER(KIND=int_ll),PARAMETER :: &
2996 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
2997
3002 MODULE PROCEDURE datetime_init, timedelta_init
3003END INTERFACE
3004
3008 MODULE PROCEDURE datetime_delete, timedelta_delete
3009END INTERFACE
3010
3013 MODULE PROCEDURE datetime_getval, timedelta_getval
3014END INTERFACE
3015
3018 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
3019END INTERFACE
3020
3021
3040 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
3041END INTERFACE
3042
3048INTERFACE OPERATOR (==)
3049 MODULE PROCEDURE datetime_eq, timedelta_eq, &
3050 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
3051END INTERFACE
3052
3058INTERFACE OPERATOR (/=)
3059 MODULE PROCEDURE datetime_ne, timedelta_ne
3060END INTERFACE
3061
3069INTERFACE OPERATOR (>)
3070 MODULE PROCEDURE datetime_gt, timedelta_gt
3071END INTERFACE
3072
3080INTERFACE OPERATOR (<)
3081 MODULE PROCEDURE datetime_lt, timedelta_lt
3082END INTERFACE
3083
3091INTERFACE OPERATOR (>=)
3092 MODULE PROCEDURE datetime_ge, timedelta_ge
3093END INTERFACE
3094
3102INTERFACE OPERATOR (<=)
3103 MODULE PROCEDURE datetime_le, timedelta_le
3104END INTERFACE
3105
3112INTERFACE OPERATOR (+)
3113 MODULE PROCEDURE datetime_add, timedelta_add
3114END INTERFACE
3115
3123INTERFACE OPERATOR (-)
3124 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
3125END INTERFACE
3126
3132INTERFACE OPERATOR (*)
3133 MODULE PROCEDURE timedelta_mult, timedelta_tlum
3134END INTERFACE
3135
3142INTERFACE OPERATOR (/)
3143 MODULE PROCEDURE timedelta_divint, timedelta_divtd
3144END INTERFACE
3145
3157 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
3158END INTERFACE
3159
3163 MODULE PROCEDURE timedelta_abs
3164END INTERFACE
3165
3169 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
3170 timedelta_read_unit, timedelta_vect_read_unit
3171END INTERFACE
3172
3176 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
3177 timedelta_write_unit, timedelta_vect_write_unit
3178END INTERFACE
3179
3182 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
3183END INTERFACE
3184
3187 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
3188END INTERFACE
3189
3190#undef VOL7D_POLY_TYPE
3191#undef VOL7D_POLY_TYPES
3192#undef ENABLE_SORT
3193#define VOL7D_POLY_TYPE TYPE(datetime)
3194#define VOL7D_POLY_TYPES _datetime
3195#define ENABLE_SORT
3196#include "array_utilities_pre.F90"
3197
3198
3199#define ARRAYOF_ORIGTYPE TYPE(datetime)
3200#define ARRAYOF_TYPE arrayof_datetime
3201#define ARRAYOF_ORIGEQ 1
3202#include "arrayof_pre.F90"
3203! from arrayof
3204
3205PRIVATE
3206
3208 datetime_min, datetime_max, &
3211 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
3212 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
3214 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
3215 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
3217 count_distinct, pack_distinct, &
3218 count_distinct_sorted, pack_distinct_sorted, &
3219 count_and_pack_distinct, &
3221 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
3223PUBLIC insert_unique, append_unique
3224PUBLIC cyclicdatetime_to_conventional
3225
3226CONTAINS
3227
3228
3229! ==============
3230! == datetime ==
3231! ==============
3232
3239ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
3240 unixtime, isodate, simpledate) RESULT(this)
3241INTEGER,INTENT(IN),OPTIONAL :: year
3242INTEGER,INTENT(IN),OPTIONAL :: month
3243INTEGER,INTENT(IN),OPTIONAL :: day
3244INTEGER,INTENT(IN),OPTIONAL :: hour
3245INTEGER,INTENT(IN),OPTIONAL :: minute
3246INTEGER,INTENT(IN),OPTIONAL :: msec
3247INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
3248CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3249CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3250
3251TYPE(datetime) :: this
3252INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3253CHARACTER(len=23) :: datebuf
3254
3255IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
3256 lyear = year
3257 IF (PRESENT(month)) THEN
3258 lmonth = month
3259 ELSE
3260 lmonth = 1
3261 ENDIF
3262 IF (PRESENT(day)) THEN
3263 lday = day
3264 ELSE
3265 lday = 1
3266 ENDIF
3267 IF (PRESENT(hour)) THEN
3268 lhour = hour
3269 ELSE
3270 lhour = 0
3271 ENDIF
3272 IF (PRESENT(minute)) THEN
3273 lminute = minute
3274 ELSE
3275 lminute = 0
3276 ENDIF
3277 IF (PRESENT(msec)) THEN
3278 lmsec = msec
3279 ELSE
3280 lmsec = 0
3281 ENDIF
3282
3285 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3286 else
3287 this=datetime_miss
3288 end if
3289
3290ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
3292 this%iminuti = (unixtime + unsec)*1000
3293 else
3294 this=datetime_miss
3295 end if
3296
3297ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
3298
3300 datebuf(1:23) = '0001-01-01 00:00:00.000'
3301 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
3302 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
3303 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3304 lmsec = lmsec + lsec*1000
3305 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3306 RETURN
3307
3308100 CONTINUE ! condizione di errore in isodate
3310 RETURN
3311 ELSE
3312 this = datetime_miss
3313 ENDIF
3314
3315ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
3317 datebuf(1:17) = '00010101000000000'
3318 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3319 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
3320 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3321 lmsec = lmsec + lsec*1000
3322 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3323 RETURN
3324
3325120 CONTINUE ! condizione di errore in simpledate
3327 RETURN
3328 ELSE
3329 this = datetime_miss
3330 ENDIF
3331
3332ELSE
3333 this = datetime_miss
3334ENDIF
3335
3336END FUNCTION datetime_new
3337
3338
3340FUNCTION datetime_new_now(now) RESULT(this)
3341INTEGER,INTENT(IN) :: now
3342TYPE(datetime) :: this
3343
3344INTEGER :: dt(8)
3345
3347 CALL date_and_time(values=dt)
3348 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
3350 msec=dt(7)*1000+dt(8))
3351ELSE
3352 this = datetime_miss
3353ENDIF
3354
3355END FUNCTION datetime_new_now
3356
3357
3364SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
3365 unixtime, isodate, simpledate, now)
3366TYPE(datetime),INTENT(INOUT) :: this
3367INTEGER,INTENT(IN),OPTIONAL :: year
3368INTEGER,INTENT(IN),OPTIONAL :: month
3369INTEGER,INTENT(IN),OPTIONAL :: day
3370INTEGER,INTENT(IN),OPTIONAL :: hour
3371INTEGER,INTENT(IN),OPTIONAL :: minute
3372INTEGER,INTENT(IN),OPTIONAL :: msec
3373INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
3374CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3375CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3376INTEGER,INTENT(IN),OPTIONAL :: now
3377
3378IF (PRESENT(now)) THEN
3379 this = datetime_new_now(now)
3380ELSE
3381 this = datetime_new(year, month, day, hour, minute, msec, &
3382 unixtime, isodate, simpledate)
3383ENDIF
3384
3385END SUBROUTINE datetime_init
3386
3387
3388ELEMENTAL SUBROUTINE datetime_delete(this)
3389TYPE(datetime),INTENT(INOUT) :: this
3390
3391this%iminuti = illmiss
3392
3393END SUBROUTINE datetime_delete
3394
3395
3400PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
3401 unixtime, isodate, simpledate, oraclesimdate)
3402TYPE(datetime),INTENT(IN) :: this
3403INTEGER,INTENT(OUT),OPTIONAL :: year
3404INTEGER,INTENT(OUT),OPTIONAL :: month
3405INTEGER,INTENT(OUT),OPTIONAL :: day
3406INTEGER,INTENT(OUT),OPTIONAL :: hour
3407INTEGER,INTENT(OUT),OPTIONAL :: minute
3408INTEGER,INTENT(OUT),OPTIONAL :: msec
3409INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime
3410CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3411CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3412CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3413
3414INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3415CHARACTER(len=23) :: datebuf
3416
3417IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
3418 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
3419 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
3420
3421 IF (this == datetime_miss) THEN
3422
3423 IF (PRESENT(msec)) THEN
3424 msec = imiss
3425 ENDIF
3426 IF (PRESENT(minute)) THEN
3427 minute = imiss
3428 ENDIF
3429 IF (PRESENT(hour)) THEN
3430 hour = imiss
3431 ENDIF
3432 IF (PRESENT(day)) THEN
3433 day = imiss
3434 ENDIF
3435 IF (PRESENT(month)) THEN
3436 month = imiss
3437 ENDIF
3438 IF (PRESENT(year)) THEN
3439 year = imiss
3440 ENDIF
3441 IF (PRESENT(isodate)) THEN
3442 isodate = cmiss
3443 ENDIF
3444 IF (PRESENT(simpledate)) THEN
3445 simpledate = cmiss
3446 ENDIF
3447 IF (PRESENT(oraclesimdate)) THEN
3448!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3449!!$ 'obsoleto, usare piuttosto simpledate')
3450 oraclesimdate=cmiss
3451 ENDIF
3452 IF (PRESENT(unixtime)) THEN
3453 unixtime = illmiss
3454 ENDIF
3455
3456 ELSE
3457
3458 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3459 IF (PRESENT(msec)) THEN
3460 msec = lmsec
3461 ENDIF
3462 IF (PRESENT(minute)) THEN
3463 minute = lminute
3464 ENDIF
3465 IF (PRESENT(hour)) THEN
3466 hour = lhour
3467 ENDIF
3468 IF (PRESENT(day)) THEN
3469 day = lday
3470 ENDIF
3471 IF (PRESENT(month)) THEN
3472 month = lmonth
3473 ENDIF
3474 IF (PRESENT(year)) THEN
3475 year = lyear
3476 ENDIF
3477 IF (PRESENT(isodate)) THEN
3478 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3479 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
3481 isodate = datebuf(1:min(len(isodate),23))
3482 ENDIF
3483 IF (PRESENT(simpledate)) THEN
3484 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
3485 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
3486 simpledate = datebuf(1:min(len(simpledate),17))
3487 ENDIF
3488 IF (PRESENT(oraclesimdate)) THEN
3489!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3490!!$ 'obsoleto, usare piuttosto simpledate')
3491 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
3492 ENDIF
3493 IF (PRESENT(unixtime)) THEN
3494 unixtime = this%iminuti/1000_int_ll-unsec
3495 ENDIF
3496
3497 ENDIF
3498ENDIF
3499
3500END SUBROUTINE datetime_getval
3501
3502
3505elemental FUNCTION datetime_to_char(this) RESULT(char)
3506TYPE(datetime),INTENT(IN) :: this
3507
3508CHARACTER(len=23) :: char
3509
3511
3512END FUNCTION datetime_to_char
3513
3514
3515FUNCTION trim_datetime_to_char(in) RESULT(char)
3516TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3517
3518CHARACTER(len=len_trim(datetime_to_char(in))) :: char
3519
3520char=datetime_to_char(in)
3521
3522END FUNCTION trim_datetime_to_char
3523
3524
3525
3526SUBROUTINE display_datetime(this)
3527TYPE(datetime),INTENT(in) :: this
3528
3530
3531end subroutine display_datetime
3532
3533
3534
3535SUBROUTINE display_timedelta(this)
3536TYPE(timedelta),INTENT(in) :: this
3537
3539
3540end subroutine display_timedelta
3541
3542
3543
3544ELEMENTAL FUNCTION c_e_datetime(this) result (res)
3545TYPE(datetime),INTENT(in) :: this
3546LOGICAL :: res
3547
3548res = .not. this == datetime_miss
3549
3550end FUNCTION c_e_datetime
3551
3552
3553ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
3554TYPE(datetime),INTENT(IN) :: this, that
3555LOGICAL :: res
3556
3557res = this%iminuti == that%iminuti
3558
3559END FUNCTION datetime_eq
3560
3561
3562ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3563TYPE(datetime),INTENT(IN) :: this, that
3564LOGICAL :: res
3565
3566res = .NOT.(this == that)
3567
3568END FUNCTION datetime_ne
3569
3570
3571ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3572TYPE(datetime),INTENT(IN) :: this, that
3573LOGICAL :: res
3574
3575res = this%iminuti > that%iminuti
3576
3577END FUNCTION datetime_gt
3578
3579
3580ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3581TYPE(datetime),INTENT(IN) :: this, that
3582LOGICAL :: res
3583
3584res = this%iminuti < that%iminuti
3585
3586END FUNCTION datetime_lt
3587
3588
3589ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3590TYPE(datetime),INTENT(IN) :: this, that
3591LOGICAL :: res
3592
3593IF (this == that) THEN
3594 res = .true.
3595ELSE IF (this > that) THEN
3596 res = .true.
3597ELSE
3598 res = .false.
3599ENDIF
3600
3601END FUNCTION datetime_ge
3602
3603
3604ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3605TYPE(datetime),INTENT(IN) :: this, that
3606LOGICAL :: res
3607
3608IF (this == that) THEN
3609 res = .true.
3610ELSE IF (this < that) THEN
3611 res = .true.
3612ELSE
3613 res = .false.
3614ENDIF
3615
3616END FUNCTION datetime_le
3617
3618
3619FUNCTION datetime_add(this, that) RESULT(res)
3620TYPE(datetime),INTENT(IN) :: this
3621TYPE(timedelta),INTENT(IN) :: that
3622TYPE(datetime) :: res
3623
3624INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3625
3626IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3627 res = datetime_miss
3628ELSE
3629 res%iminuti = this%iminuti + that%iminuti
3630 IF (that%month /= 0) THEN
3632 minute=lminute, msec=lmsec)
3634 hour=lhour, minute=lminute, msec=lmsec)
3635 ENDIF
3636ENDIF
3637
3638END FUNCTION datetime_add
3639
3640
3641ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3642TYPE(datetime),INTENT(IN) :: this, that
3643TYPE(timedelta) :: res
3644
3645IF (this == datetime_miss .OR. that == datetime_miss) THEN
3646 res = timedelta_miss
3647ELSE
3648 res%iminuti = this%iminuti - that%iminuti
3649 res%month = 0
3650ENDIF
3651
3652END FUNCTION datetime_subdt
3653
3654
3655FUNCTION datetime_subtd(this, that) RESULT(res)
3656TYPE(datetime),INTENT(IN) :: this
3657TYPE(timedelta),INTENT(IN) :: that
3658TYPE(datetime) :: res
3659
3660INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3661
3662IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3663 res = datetime_miss
3664ELSE
3665 res%iminuti = this%iminuti - that%iminuti
3666 IF (that%month /= 0) THEN
3668 minute=lminute, msec=lmsec)
3670 hour=lhour, minute=lminute, msec=lmsec)
3671 ENDIF
3672ENDIF
3673
3674END FUNCTION datetime_subtd
3675
3676
3681SUBROUTINE datetime_read_unit(this, unit)
3682TYPE(datetime),INTENT(out) :: this
3683INTEGER, INTENT(in) :: unit
3684CALL datetime_vect_read_unit((/this/), unit)
3685
3686END SUBROUTINE datetime_read_unit
3687
3688
3693SUBROUTINE datetime_vect_read_unit(this, unit)
3694TYPE(datetime) :: this(:)
3695INTEGER, INTENT(in) :: unit
3696
3697CHARACTER(len=40) :: form
3698CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3699INTEGER :: i
3700
3701ALLOCATE(dateiso(SIZE(this)))
3702INQUIRE(unit, form=form)
3703IF (form == 'FORMATTED') THEN
3704 READ(unit,'(A23,1X)')dateiso
3705ELSE
3706 READ(unit)dateiso
3707ENDIF
3708DO i = 1, SIZE(dateiso)
3710ENDDO
3711DEALLOCATE(dateiso)
3712
3713END SUBROUTINE datetime_vect_read_unit
3714
3715
3720SUBROUTINE datetime_write_unit(this, unit)
3721TYPE(datetime),INTENT(in) :: this
3722INTEGER, INTENT(in) :: unit
3723
3724CALL datetime_vect_write_unit((/this/), unit)
3725
3726END SUBROUTINE datetime_write_unit
3727
3728
3733SUBROUTINE datetime_vect_write_unit(this, unit)
3734TYPE(datetime),INTENT(in) :: this(:)
3735INTEGER, INTENT(in) :: unit
3736
3737CHARACTER(len=40) :: form
3738CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3739INTEGER :: i
3740
3741ALLOCATE(dateiso(SIZE(this)))
3742DO i = 1, SIZE(dateiso)
3744ENDDO
3745INQUIRE(unit, form=form)
3746IF (form == 'FORMATTED') THEN
3747 WRITE(unit,'(A23,1X)')dateiso
3748ELSE
3749 WRITE(unit)dateiso
3750ENDIF
3751DEALLOCATE(dateiso)
3752
3753END SUBROUTINE datetime_vect_write_unit
3754
3755
3756#include "arrayof_post.F90"
3757
3758
3759! ===============
3760! == timedelta ==
3761! ===============
3768FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3769 isodate, simpledate, oraclesimdate) RESULT (this)
3770INTEGER,INTENT(IN),OPTIONAL :: year
3771INTEGER,INTENT(IN),OPTIONAL :: month
3772INTEGER,INTENT(IN),OPTIONAL :: day
3773INTEGER,INTENT(IN),OPTIONAL :: hour
3774INTEGER,INTENT(IN),OPTIONAL :: minute
3775INTEGER,INTENT(IN),OPTIONAL :: sec
3776INTEGER,INTENT(IN),OPTIONAL :: msec
3777CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3778CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3779CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3780
3781TYPE(timedelta) :: this
3782
3783CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3784 isodate, simpledate, oraclesimdate)
3785
3786END FUNCTION timedelta_new
3787
3788
3793SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3794 isodate, simpledate, oraclesimdate)
3795TYPE(timedelta),INTENT(INOUT) :: this
3796INTEGER,INTENT(IN),OPTIONAL :: year
3797INTEGER,INTENT(IN),OPTIONAL :: month
3798INTEGER,INTENT(IN),OPTIONAL :: day
3799INTEGER,INTENT(IN),OPTIONAL :: hour
3800INTEGER,INTENT(IN),OPTIONAL :: minute
3801INTEGER,INTENT(IN),OPTIONAL :: sec
3802INTEGER,INTENT(IN),OPTIONAL :: msec
3803CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3804CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3805CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3806
3807INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3808CHARACTER(len=23) :: datebuf
3809
3810this%month = 0
3811
3812IF (PRESENT(isodate)) THEN
3813 datebuf(1:23) = '0000000000 00:00:00.000'
3814 l = len_trim(isodate)
3815! IF (l > 0) THEN
3817 IF (n > 0) THEN
3818 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3819 datebuf(12-n:12-n+l-1) = isodate(:l)
3820 ELSE
3821 datebuf(1:l) = isodate(1:l)
3822 ENDIF
3823! ENDIF
3824
3825! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3826 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3827 h, m, s, ms
3828 this%month = lmonth + 12*lyear
3829 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3830 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3831 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3832 RETURN
3833
3834200 CONTINUE ! condizione di errore in isodate
3836 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3837 CALL raise_error()
3838
3839ELSE IF (PRESENT(simpledate)) THEN
3840 datebuf(1:17) = '00000000000000000'
3841 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3842 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3843 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3844 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3845 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3846
3847220 CONTINUE ! condizione di errore in simpledate
3849 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3850 CALL raise_error()
3851 RETURN
3852
3853ELSE IF (PRESENT(oraclesimdate)) THEN
3854 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3855 'obsoleto, usare piuttosto simpledate')
3856 READ(oraclesimdate, '(I8,2I2)')d, h, m
3857 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3858 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3859
3860ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3861 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3862 .and. .not. present(msec) .and. .not. present(isodate) &
3863 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3864
3865 this=timedelta_miss
3866
3867ELSE
3868 this%iminuti = 0
3869 IF (PRESENT(year)) THEN
3871 this%month = this%month + year*12
3872 else
3873 this=timedelta_miss
3874 return
3875 end if
3876 ENDIF
3877 IF (PRESENT(month)) THEN
3879 this%month = this%month + month
3880 else
3881 this=timedelta_miss
3882 return
3883 end if
3884 ENDIF
3885 IF (PRESENT(day)) THEN
3887 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3888 else
3889 this=timedelta_miss
3890 return
3891 end if
3892 ENDIF
3893 IF (PRESENT(hour)) THEN
3895 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3896 else
3897 this=timedelta_miss
3898 return
3899 end if
3900 ENDIF
3901 IF (PRESENT(minute)) THEN
3903 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3904 else
3905 this=timedelta_miss
3906 return
3907 end if
3908 ENDIF
3909 IF (PRESENT(sec)) THEN
3911 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3912 else
3913 this=timedelta_miss
3914 return
3915 end if
3916 ENDIF
3917 IF (PRESENT(msec)) THEN
3919 this%iminuti = this%iminuti + msec
3920 else
3921 this=timedelta_miss
3922 return
3923 end if
3924 ENDIF
3925ENDIF
3926
3927
3928
3929
3930END SUBROUTINE timedelta_init
3931
3932
3933SUBROUTINE timedelta_delete(this)
3934TYPE(timedelta),INTENT(INOUT) :: this
3935
3936this%iminuti = imiss
3937this%month = 0
3938
3939END SUBROUTINE timedelta_delete
3940
3941
3946PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3947 day, hour, minute, sec, msec, &
3948 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3949TYPE(timedelta),INTENT(IN) :: this
3950INTEGER,INTENT(OUT),OPTIONAL :: year
3951INTEGER,INTENT(OUT),OPTIONAL :: month
3952INTEGER,INTENT(OUT),OPTIONAL :: amonth
3953INTEGER,INTENT(OUT),OPTIONAL :: day
3954INTEGER,INTENT(OUT),OPTIONAL :: hour
3955INTEGER,INTENT(OUT),OPTIONAL :: minute
3956INTEGER,INTENT(OUT),OPTIONAL :: sec
3957INTEGER,INTENT(OUT),OPTIONAL :: msec
3958INTEGER,INTENT(OUT),OPTIONAL :: ahour
3959INTEGER,INTENT(OUT),OPTIONAL :: aminute
3960INTEGER,INTENT(OUT),OPTIONAL :: asec
3961INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec
3962CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3963CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3964CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3965
3966CHARACTER(len=23) :: datebuf
3967
3968IF (PRESENT(amsec)) THEN
3969 amsec = this%iminuti
3970ENDIF
3971IF (PRESENT(asec)) THEN
3972 asec = int(this%iminuti/1000_int_ll)
3973ENDIF
3974IF (PRESENT(aminute)) THEN
3975 aminute = int(this%iminuti/60000_int_ll)
3976ENDIF
3977IF (PRESENT(ahour)) THEN
3978 ahour = int(this%iminuti/3600000_int_ll)
3979ENDIF
3980IF (PRESENT(msec)) THEN
3981 msec = int(mod(this%iminuti, 1000_int_ll))
3982ENDIF
3983IF (PRESENT(sec)) THEN
3984 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3985ENDIF
3986IF (PRESENT(minute)) THEN
3987 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3988ENDIF
3989IF (PRESENT(hour)) THEN
3990 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3991ENDIF
3992IF (PRESENT(day)) THEN
3993 day = int(this%iminuti/86400000_int_ll)
3994ENDIF
3995IF (PRESENT(amonth)) THEN
3996 amonth = this%month
3997ENDIF
3998IF (PRESENT(month)) THEN
3999 month = mod(this%month-1,12)+1
4000ENDIF
4001IF (PRESENT(year)) THEN
4002 year = this%month/12
4003ENDIF
4004IF (PRESENT(isodate)) THEN ! Non standard, inventato!
4005 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
4009 isodate = datebuf(1:min(len(isodate),23))
4010
4011ENDIF
4012IF (PRESENT(simpledate)) THEN
4013 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
4014 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
4016 mod(this%iminuti, 1000_int_ll)
4017 simpledate = datebuf(1:min(len(simpledate),17))
4018ENDIF
4019IF (PRESENT(oraclesimdate)) THEN
4020!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
4021!!$ 'obsoleto, usare piuttosto simpledate')
4022 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
4024ENDIF
4025
4026END SUBROUTINE timedelta_getval
4027
4028
4031elemental FUNCTION timedelta_to_char(this) RESULT(char)
4032TYPE(timedelta),INTENT(IN) :: this
4033
4034CHARACTER(len=23) :: char
4035
4037
4038END FUNCTION timedelta_to_char
4039
4040
4041FUNCTION trim_timedelta_to_char(in) RESULT(char)
4042TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
4043
4044CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
4045
4046char=timedelta_to_char(in)
4047
4048END FUNCTION trim_timedelta_to_char
4049
4050
4052elemental FUNCTION timedelta_getamsec(this)
4053TYPE(timedelta),INTENT(IN) :: this
4054INTEGER(kind=int_ll) :: timedelta_getamsec
4055
4056timedelta_getamsec = this%iminuti
4057
4058END FUNCTION timedelta_getamsec
4059
4060
4066FUNCTION timedelta_depop(this)
4067TYPE(timedelta),INTENT(IN) :: this
4068TYPE(timedelta) :: timedelta_depop
4069
4070TYPE(datetime) :: tmpdt
4071
4072IF (this%month == 0) THEN
4073 timedelta_depop = this
4074ELSE
4075 tmpdt = datetime_new(1970, 1, 1)
4076 timedelta_depop = (tmpdt + this) - tmpdt
4077ENDIF
4078
4079END FUNCTION timedelta_depop
4080
4081
4082elemental FUNCTION timedelta_eq(this, that) RESULT(res)
4083TYPE(timedelta),INTENT(IN) :: this, that
4084LOGICAL :: res
4085
4086res = (this%iminuti == that%iminuti .AND. this%month == that%month)
4087
4088END FUNCTION timedelta_eq
4089
4090
4091ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
4092TYPE(timedelta),INTENT(IN) :: this, that
4093LOGICAL :: res
4094
4095res = .NOT.(this == that)
4096
4097END FUNCTION timedelta_ne
4098
4099
4100ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
4101TYPE(timedelta),INTENT(IN) :: this, that
4102LOGICAL :: res
4103
4104res = this%iminuti > that%iminuti
4105
4106END FUNCTION timedelta_gt
4107
4108
4109ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
4110TYPE(timedelta),INTENT(IN) :: this, that
4111LOGICAL :: res
4112
4113res = this%iminuti < that%iminuti
4114
4115END FUNCTION timedelta_lt
4116
4117
4118ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
4119TYPE(timedelta),INTENT(IN) :: this, that
4120LOGICAL :: res
4121
4122IF (this == that) THEN
4123 res = .true.
4124ELSE IF (this > that) THEN
4125 res = .true.
4126ELSE
4127 res = .false.
4128ENDIF
4129
4130END FUNCTION timedelta_ge
4131
4132
4133elemental FUNCTION timedelta_le(this, that) RESULT(res)
4134TYPE(timedelta),INTENT(IN) :: this, that
4135LOGICAL :: res
4136
4137IF (this == that) THEN
4138 res = .true.
4139ELSE IF (this < that) THEN
4140 res = .true.
4141ELSE
4142 res = .false.
4143ENDIF
4144
4145END FUNCTION timedelta_le
4146
4147
4148ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
4149TYPE(timedelta),INTENT(IN) :: this, that
4150TYPE(timedelta) :: res
4151
4152res%iminuti = this%iminuti + that%iminuti
4153res%month = this%month + that%month
4154
4155END FUNCTION timedelta_add
4156
4157
4158ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
4159TYPE(timedelta),INTENT(IN) :: this, that
4160TYPE(timedelta) :: res
4161
4162res%iminuti = this%iminuti - that%iminuti
4163res%month = this%month - that%month
4164
4165END FUNCTION timedelta_sub
4166
4167
4168ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
4169TYPE(timedelta),INTENT(IN) :: this
4170INTEGER,INTENT(IN) :: n
4171TYPE(timedelta) :: res
4172
4173res%iminuti = this%iminuti*n
4174res%month = this%month*n
4175
4176END FUNCTION timedelta_mult
4177
4178
4179ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
4180INTEGER,INTENT(IN) :: n
4181TYPE(timedelta),INTENT(IN) :: this
4182TYPE(timedelta) :: res
4183
4184res%iminuti = this%iminuti*n
4185res%month = this%month*n
4186
4187END FUNCTION timedelta_tlum
4188
4189
4190ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
4191TYPE(timedelta),INTENT(IN) :: this
4192INTEGER,INTENT(IN) :: n
4193TYPE(timedelta) :: res
4194
4195res%iminuti = this%iminuti/n
4196res%month = this%month/n
4197
4198END FUNCTION timedelta_divint
4199
4200
4201ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
4202TYPE(timedelta),INTENT(IN) :: this, that
4203INTEGER :: res
4204
4205res = int(this%iminuti/that%iminuti)
4206
4207END FUNCTION timedelta_divtd
4208
4209
4210elemental FUNCTION timedelta_mod(this, that) RESULT(res)
4211TYPE(timedelta),INTENT(IN) :: this, that
4212TYPE(timedelta) :: res
4213
4214res%iminuti = mod(this%iminuti, that%iminuti)
4215res%month = 0
4216
4217END FUNCTION timedelta_mod
4218
4219
4220ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
4221TYPE(datetime),INTENT(IN) :: this
4222TYPE(timedelta),INTENT(IN) :: that
4223TYPE(timedelta) :: res
4224
4225IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
4226 res = timedelta_0
4227ELSE
4228 res%iminuti = mod(this%iminuti, that%iminuti)
4229 res%month = 0
4230ENDIF
4231
4232END FUNCTION datetime_timedelta_mod
4233
4234
4235ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
4236TYPE(timedelta),INTENT(IN) :: this
4237TYPE(timedelta) :: res
4238
4239res%iminuti = abs(this%iminuti)
4240res%month = abs(this%month)
4241
4242END FUNCTION timedelta_abs
4243
4244
4249SUBROUTINE timedelta_read_unit(this, unit)
4250TYPE(timedelta),INTENT(out) :: this
4251INTEGER, INTENT(in) :: unit
4252
4253CALL timedelta_vect_read_unit((/this/), unit)
4254
4255END SUBROUTINE timedelta_read_unit
4256
4257
4262SUBROUTINE timedelta_vect_read_unit(this, unit)
4263TYPE(timedelta) :: this(:)
4264INTEGER, INTENT(in) :: unit
4265
4266CHARACTER(len=40) :: form
4267CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
4268INTEGER :: i
4269
4270ALLOCATE(dateiso(SIZE(this)))
4271INQUIRE(unit, form=form)
4272IF (form == 'FORMATTED') THEN
4273 READ(unit,'(3(A23,1X))')dateiso
4274ELSE
4275 READ(unit)dateiso
4276ENDIF
4277DO i = 1, SIZE(dateiso)
4279ENDDO
4280DEALLOCATE(dateiso)
4281
4282END SUBROUTINE timedelta_vect_read_unit
4283
4284
4289SUBROUTINE timedelta_write_unit(this, unit)
4290TYPE(timedelta),INTENT(in) :: this
4291INTEGER, INTENT(in) :: unit
4292
4293CALL timedelta_vect_write_unit((/this/), unit)
4294
4295END SUBROUTINE timedelta_write_unit
4296
4297
4302SUBROUTINE timedelta_vect_write_unit(this, unit)
4303TYPE(timedelta),INTENT(in) :: this(:)
4304INTEGER, INTENT(in) :: unit
4305
4306CHARACTER(len=40) :: form
4307CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
4308INTEGER :: i
4309
4310ALLOCATE(dateiso(SIZE(this)))
4311DO i = 1, SIZE(dateiso)
4313ENDDO
4314INQUIRE(unit, form=form)
4315IF (form == 'FORMATTED') THEN
4316 WRITE(unit,'(3(A23,1X))')dateiso
4317ELSE
4318 WRITE(unit)dateiso
4319ENDIF
4320DEALLOCATE(dateiso)
4321
4322END SUBROUTINE timedelta_vect_write_unit
4323
4324
4325ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
4326TYPE(timedelta),INTENT(in) :: this
4327LOGICAL :: res
4328
4329res = .not. this == timedelta_miss
4330
4331end FUNCTION c_e_timedelta
4332
4333
4334elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
4335
4336!!omstart JELADATA5
4337! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
4338! 1 IMINUTI)
4339!
4340! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
4341!
4342! variabili integer*4
4343! IN:
4344! IDAY,IMONTH,IYEAR, I*4
4345! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
4346!
4347! OUT:
4348! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
4349!!OMEND
4350
4351INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
4352INTEGER,intent(out) :: iminuti
4353
4354iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
4355
4356END SUBROUTINE jeladata5
4357
4358
4359elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
4360INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
4361INTEGER(KIND=int_ll),intent(out) :: imillisec
4362
4363imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
4364 + imsec
4365
4366END SUBROUTINE jeladata5_1
4367
4368
4369
4370elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
4371
4372!!omstart JELADATA6
4373! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
4374! 1 IMINUTI)
4375!
4376! Calcola la data e l'ora corrispondente a IMINUTI dopo il
4377! 1/1/1
4378!
4379! variabili integer*4
4380! IN:
4381! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
4382!
4383! OUT:
4384! IDAY,IMONTH,IYEAR, I*4
4385! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
4386!!OMEND
4387
4388
4389INTEGER,intent(in) :: iminuti
4390INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
4391
4392INTEGER ::igiorno
4393
4394imin = mod(iminuti,60)
4395ihour = mod(iminuti,1440)/60
4396igiorno = iminuti/1440
4398CALL ndyin(igiorno,iday,imonth,iyear)
4399
4400END SUBROUTINE jeladata6
4401
4402
4403elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
4404INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
4405INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
4406
4407INTEGER :: igiorno
4408
4410!imin = MOD(imillisec/60000_int_ll, 60)
4411!ihour = MOD(imillisec/3600000_int_ll, 24)
4412imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
4413ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
4414igiorno = int(imillisec/86400000_int_ll)
4415!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
4416CALL ndyin(igiorno,iday,imonth,iyear)
4417
4418END SUBROUTINE jeladata6_1
4419
4420
4421elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
4422
4423!!OMSTART NDYIN
4424! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
4425! restituisce la data fornendo in input il numero di
4426! giorni dal 1/1/1
4427!
4428!!omend
4429
4430INTEGER,intent(in) :: ndays
4431INTEGER,intent(out) :: igg, imm, iaa
4432integer :: n,lndays
4433
4434lndays=ndays
4435
4436n = lndays/d400
4437lndays = lndays - n*d400
4438iaa = year0 + n*400
4439n = min(lndays/d100, 3)
4440lndays = lndays - n*d100
4441iaa = iaa + n*100
4442n = lndays/d4
4443lndays = lndays - n*d4
4444iaa = iaa + n*4
4445n = min(lndays/d1, 3)
4446lndays = lndays - n*d1
4447iaa = iaa + n
4448n = bisextilis(iaa)
4449DO imm = 1, 12
4450 IF (lndays < ianno(imm+1,n)) EXIT
4451ENDDO
4452igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
4453
4454END SUBROUTINE ndyin
4455
4456
4457integer elemental FUNCTION ndays(igg,imm,iaa)
4458
4459!!OMSTART NDAYS
4460! FUNCTION NDAYS(IGG,IMM,IAA)
4461! restituisce il numero di giorni dal 1/1/1
4462! fornendo in input la data
4463!
4464!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4465! nota bene E' SICURO !!!
4466! un anno e' bisestile se divisibile per 4
4467! un anno rimane bisestile se divisibile per 400
4468! un anno NON e' bisestile se divisibile per 100
4469!
4470!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4471!
4472!!omend
4473
4474INTEGER, intent(in) :: igg, imm, iaa
4475
4476INTEGER :: lmonth, lyear
4477
4478! Limito il mese a [1-12] e correggo l'anno coerentemente
4479lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
4480lyear = iaa + (imm - lmonth)/12
4481ndays = igg+ianno(lmonth, bisextilis(lyear))
4482ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
4483 (lyear-year0)/400
4484
4485END FUNCTION ndays
4486
4487
4488elemental FUNCTION bisextilis(annum)
4489INTEGER,INTENT(in) :: annum
4490INTEGER :: bisextilis
4491
4493 bisextilis = 2
4494ELSE
4495 bisextilis = 1
4496ENDIF
4497END FUNCTION bisextilis
4498
4499
4500ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
4501TYPE(cyclicdatetime),INTENT(IN) :: this, that
4502LOGICAL :: res
4503
4504res = .true.
4505if (this%minute /= that%minute) res=.false.
4506if (this%hour /= that%hour) res=.false.
4507if (this%day /= that%day) res=.false.
4508if (this%month /= that%month) res=.false.
4509if (this%tendaysp /= that%tendaysp) res=.false.
4510
4511END FUNCTION cyclicdatetime_eq
4512
4513
4514ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
4515TYPE(cyclicdatetime),INTENT(IN) :: this
4516TYPE(datetime),INTENT(IN) :: that
4517LOGICAL :: res
4518
4519integer :: minute,hour,day,month
4520
4522
4523res = .true.
4529 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4530end if
4531
4532END FUNCTION cyclicdatetime_datetime_eq
4533
4534
4535ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
4536TYPE(datetime),INTENT(IN) :: this
4537TYPE(cyclicdatetime),INTENT(IN) :: that
4538LOGICAL :: res
4539
4540integer :: minute,hour,day,month
4541
4543
4544res = .true.
4549
4551 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4552end if
4553
4554
4555END FUNCTION datetime_cyclicdatetime_eq
4556
4557ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
4558TYPE(cyclicdatetime),INTENT(in) :: this
4559LOGICAL :: res
4560
4561res = .not. this == cyclicdatetime_miss
4562
4563end FUNCTION c_e_cyclicdatetime
4564
4565
4568FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4569INTEGER,INTENT(IN),OPTIONAL :: tendaysp
4570INTEGER,INTENT(IN),OPTIONAL :: month
4571INTEGER,INTENT(IN),OPTIONAL :: day
4572INTEGER,INTENT(IN),OPTIONAL :: hour
4573INTEGER,INTENT(IN),OPTIONAL :: minute
4574CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate
4575
4576integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4577
4578
4579TYPE(cyclicdatetime) :: this
4580
4581if (present(chardate)) then
4582
4583 ltendaysp=imiss
4584 lmonth=imiss
4585 lday=imiss
4586 lhour=imiss
4587 lminute=imiss
4588
4590 ! TMMGGhhmm
4591 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4592 !print*,chardate(1:1),ios,ltendaysp
4593 if (ios /= 0)ltendaysp=imiss
4594
4595 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4596 !print*,chardate(2:3),ios,lmonth
4597 if (ios /= 0)lmonth=imiss
4598
4599 read(chardate(4:5),'(i2)',iostat=ios)lday
4600 !print*,chardate(4:5),ios,lday
4601 if (ios /= 0)lday=imiss
4602
4603 read(chardate(6:7),'(i2)',iostat=ios)lhour
4604 !print*,chardate(6:7),ios,lhour
4605 if (ios /= 0)lhour=imiss
4606
4607 read(chardate(8:9),'(i2)',iostat=ios)lminute
4608 !print*,chardate(8:9),ios,lminute
4609 if (ios /= 0)lminute=imiss
4610 end if
4611
4612 this%tendaysp=ltendaysp
4613 this%month=lmonth
4614 this%day=lday
4615 this%hour=lhour
4616 this%minute=lminute
4617else
4618 this%tendaysp=optio_l(tendaysp)
4619 this%month=optio_l(month)
4620 this%day=optio_l(day)
4621 this%hour=optio_l(hour)
4622 this%minute=optio_l(minute)
4623end if
4624
4625END FUNCTION cyclicdatetime_new
4626
4629elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4630TYPE(cyclicdatetime),INTENT(IN) :: this
4631
4632CHARACTER(len=80) :: char
4633
4636
4637END FUNCTION cyclicdatetime_to_char
4638
4639
4652FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4653TYPE(cyclicdatetime),INTENT(IN) :: this
4654
4655TYPE(datetime) :: dtc
4656
4657integer :: year,month,day,hour
4658
4659dtc = datetime_miss
4660
4661! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4663 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4664 return
4665end if
4666
4667! minute present -> not good for conventional datetime
4669! day, month and tendaysp present -> no good
4671
4673 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4675 day=(this%tendaysp-1)*10+1
4676 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4678 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4680 ! only day present -> no good
4681 return
4682end if
4683
4686 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4687end if
4688
4689
4690END FUNCTION cyclicdatetime_to_conventional
4691
4692
4693
4694FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4695TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4696
4697CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4698
4699char=cyclicdatetime_to_char(in)
4700
4701END FUNCTION trim_cyclicdatetime_to_char
4702
4703
4704
4705SUBROUTINE display_cyclicdatetime(this)
4706TYPE(cyclicdatetime),INTENT(in) :: this
4707
4709
4710end subroutine display_cyclicdatetime
4711
4712
4713#include "array_utilities_inc.F90"
4714
4716
Quick method to append an element to the array. Definition datetime_class.F90:616 Restituiscono il valore dell'oggetto nella forma desiderata. Definition datetime_class.F90:322 Costruttori per le classi datetime e timedelta. Definition datetime_class.F90:311 Method for inserting elements of the array at a desired position. Definition datetime_class.F90:607 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition datetime_class.F90:639 Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o... Definition datetime_class.F90:478 Method for removing elements of the array at a desired position. Definition datetime_class.F90:622 Functions that return a trimmed CHARACTER representation of the input variable. Definition datetime_class.F90:349 Restituiscono il valore dell'oggetto in forma di stringa stampabile. Definition datetime_class.F90:327 Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ... Definition datetime_class.F90:485 Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 Definitions of constants and functions for working with missing values. Definition missing_values.f90:50 Module for quickly interpreting the OPTIONAL parameters passed to a subprogram. Definition optional_values.f90:28 Class for expressing a cyclic datetime. Definition datetime_class.F90:255 Class for expressing an absolute time value. Definition datetime_class.F90:233 Class for expressing a relative time interval. Definition datetime_class.F90:245 |