libsim Versione 7.1.11
|
◆ map_inv_distinct_datetime()
map inv distinct Definizione alla linea 2883 del file datetime_class.F90. 2885! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2886! authors:
2887! Davide Cesari <dcesari@arpa.emr.it>
2888! Paolo Patruno <ppatruno@arpa.emr.it>
2889
2890! This program is free software; you can redistribute it and/or
2891! modify it under the terms of the GNU General Public License as
2892! published by the Free Software Foundation; either version 2 of
2893! the License, or (at your option) any later version.
2894
2895! This program is distributed in the hope that it will be useful,
2896! but WITHOUT ANY WARRANTY; without even the implied warranty of
2897! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2898! GNU General Public License for more details.
2899
2900! You should have received a copy of the GNU General Public License
2901! along with this program. If not, see <http://www.gnu.org/licenses/>.
2902#include "config.h"
2903
2924IMPLICIT NONE
2925
2926INTEGER, PARAMETER :: dateint=selected_int_kind(13)
2927
2930 PRIVATE
2931 INTEGER(KIND=int_ll) :: iminuti
2933
2942 PRIVATE
2943 INTEGER(KIND=int_ll) :: iminuti
2944 INTEGER :: month
2946
2947
2952 PRIVATE
2953 INTEGER :: minute
2954 INTEGER :: hour
2955 INTEGER :: day
2956 INTEGER :: tendaysp
2957 INTEGER :: month
2959
2960
2968INTEGER, PARAMETER :: datetime_utc=1
2970INTEGER, PARAMETER :: datetime_local=2
2980TYPE(cyclicdatetime), PARAMETER :: cyclicdatetime_miss=cyclicdatetime(imiss,imiss,imiss,imiss,imiss)
2981
2982
2983INTEGER(kind=dateint), PARAMETER :: &
2984 sec_in_day=86400, &
2985 sec_in_hour=3600, &
2986 sec_in_min=60, &
2987 min_in_day=1440, &
2988 min_in_hour=60, &
2989 hour_in_day=24
2990
2991INTEGER,PARAMETER :: &
2992 year0=1, & ! anno di origine per iminuti
2993 d1=365, & ! giorni/1 anno nel calendario gregoriano
2994 d4=d1*4+1, & ! giorni/4 anni nel calendario gregoriano
2995 d100=d1*100+25-1, & ! giorni/100 anni nel calendario gregoriano
2996 d400=d1*400+100-3, & ! giorni/400 anni nel calendario gregoriano
2997 ianno(13,2)=reshape((/ &
2998 0,31,59,90,120,151,181,212,243,273,304,334,365, &
2999 0,31,60,91,121,152,182,213,244,274,305,335,366/),(/13,2/))
3000
3001INTEGER(KIND=int_ll),PARAMETER :: &
3002 unsec=62135596800_int_ll ! differenza tra 01/01/1970 e 01/01/0001 (sec, per unixtime)
3003
3008 MODULE PROCEDURE datetime_init, timedelta_init
3009END INTERFACE
3010
3014 MODULE PROCEDURE datetime_delete, timedelta_delete
3015END INTERFACE
3016
3019 MODULE PROCEDURE datetime_getval, timedelta_getval
3020END INTERFACE
3021
3024 MODULE PROCEDURE datetime_to_char, timedelta_to_char, cyclicdatetime_to_char
3025END INTERFACE
3026
3027
3046 MODULE PROCEDURE trim_datetime_to_char, trim_timedelta_to_char, trim_cyclicdatetime_to_char
3047END INTERFACE
3048
3054INTERFACE OPERATOR (==)
3055 MODULE PROCEDURE datetime_eq, timedelta_eq, &
3056 cyclicdatetime_eq, cyclicdatetime_datetime_eq, datetime_cyclicdatetime_eq
3057END INTERFACE
3058
3064INTERFACE OPERATOR (/=)
3065 MODULE PROCEDURE datetime_ne, timedelta_ne
3066END INTERFACE
3067
3075INTERFACE OPERATOR (>)
3076 MODULE PROCEDURE datetime_gt, timedelta_gt
3077END INTERFACE
3078
3086INTERFACE OPERATOR (<)
3087 MODULE PROCEDURE datetime_lt, timedelta_lt
3088END INTERFACE
3089
3097INTERFACE OPERATOR (>=)
3098 MODULE PROCEDURE datetime_ge, timedelta_ge
3099END INTERFACE
3100
3108INTERFACE OPERATOR (<=)
3109 MODULE PROCEDURE datetime_le, timedelta_le
3110END INTERFACE
3111
3118INTERFACE OPERATOR (+)
3119 MODULE PROCEDURE datetime_add, timedelta_add
3120END INTERFACE
3121
3129INTERFACE OPERATOR (-)
3130 MODULE PROCEDURE datetime_subdt, datetime_subtd, timedelta_sub
3131END INTERFACE
3132
3138INTERFACE OPERATOR (*)
3139 MODULE PROCEDURE timedelta_mult, timedelta_tlum
3140END INTERFACE
3141
3148INTERFACE OPERATOR (/)
3149 MODULE PROCEDURE timedelta_divint, timedelta_divtd
3150END INTERFACE
3151
3163 MODULE PROCEDURE timedelta_mod, datetime_timedelta_mod
3164END INTERFACE
3165
3169 MODULE PROCEDURE timedelta_abs
3170END INTERFACE
3171
3175 MODULE PROCEDURE datetime_read_unit, datetime_vect_read_unit, &
3176 timedelta_read_unit, timedelta_vect_read_unit
3177END INTERFACE
3178
3182 MODULE PROCEDURE datetime_write_unit, datetime_vect_write_unit, &
3183 timedelta_write_unit, timedelta_vect_write_unit
3184END INTERFACE
3185
3188 MODULE PROCEDURE display_datetime, display_timedelta, display_cyclicdatetime
3189END INTERFACE
3190
3193 MODULE PROCEDURE c_e_datetime, c_e_timedelta, c_e_cyclicdatetime
3194END INTERFACE
3195
3196#undef VOL7D_POLY_TYPE
3197#undef VOL7D_POLY_TYPES
3198#undef ENABLE_SORT
3199#define VOL7D_POLY_TYPE TYPE(datetime)
3200#define VOL7D_POLY_TYPES _datetime
3201#define ENABLE_SORT
3202#include "array_utilities_pre.F90"
3203
3204
3205#define ARRAYOF_ORIGTYPE TYPE(datetime)
3206#define ARRAYOF_TYPE arrayof_datetime
3207#define ARRAYOF_ORIGEQ 1
3208#include "arrayof_pre.F90"
3209! from arrayof
3210
3211PRIVATE
3212
3214 datetime_min, datetime_max, &
3217 OPERATOR(==), OPERATOR(/=), OPERATOR(>), OPERATOR(<), &
3218 OPERATOR(>=), OPERATOR(<=), OPERATOR(+), OPERATOR(-), &
3220 timedelta, timedelta_miss, timedelta_new, timedelta_0, &
3221 timedelta_min, timedelta_max, timedelta_getamsec, timedelta_depop, &
3223 count_distinct, pack_distinct, &
3224 count_distinct_sorted, pack_distinct_sorted, &
3225 count_and_pack_distinct, &
3227 cyclicdatetime, cyclicdatetime_new, cyclicdatetime_miss, display_cyclicdatetime
3229PUBLIC insert_unique, append_unique
3230PUBLIC cyclicdatetime_to_conventional
3231
3232CONTAINS
3233
3234
3235! ==============
3236! == datetime ==
3237! ==============
3238
3245ELEMENTAL FUNCTION datetime_new(year, month, day, hour, minute, msec, &
3246 unixtime, isodate, simpledate) RESULT(this)
3247INTEGER,INTENT(IN),OPTIONAL :: year
3248INTEGER,INTENT(IN),OPTIONAL :: month
3249INTEGER,INTENT(IN),OPTIONAL :: day
3250INTEGER,INTENT(IN),OPTIONAL :: hour
3251INTEGER,INTENT(IN),OPTIONAL :: minute
3252INTEGER,INTENT(IN),OPTIONAL :: msec
3253INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
3254CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3255CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3256
3257TYPE(datetime) :: this
3258INTEGER :: lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3259CHARACTER(len=23) :: datebuf
3260
3261IF (PRESENT(year)) THEN ! anno/mese/giorno, ecc.
3262 lyear = year
3263 IF (PRESENT(month)) THEN
3264 lmonth = month
3265 ELSE
3266 lmonth = 1
3267 ENDIF
3268 IF (PRESENT(day)) THEN
3269 lday = day
3270 ELSE
3271 lday = 1
3272 ENDIF
3273 IF (PRESENT(hour)) THEN
3274 lhour = hour
3275 ELSE
3276 lhour = 0
3277 ENDIF
3278 IF (PRESENT(minute)) THEN
3279 lminute = minute
3280 ELSE
3281 lminute = 0
3282 ENDIF
3283 IF (PRESENT(msec)) THEN
3284 lmsec = msec
3285 ELSE
3286 lmsec = 0
3287 ENDIF
3288
3291 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3292 else
3293 this=datetime_miss
3294 end if
3295
3296ELSE IF (PRESENT(unixtime)) THEN ! secondi dal 01/01/1970 (unix)
3298 this%iminuti = (unixtime + unsec)*1000
3299 else
3300 this=datetime_miss
3301 end if
3302
3303ELSE IF (PRESENT(isodate)) THEN ! formato iso YYYY-MM-DD hh:mm:ss.msc
3304
3306 datebuf(1:23) = '0001-01-01 00:00:00.000'
3307 datebuf(1:min(len_trim(isodate),23)) = isodate(1:min(len_trim(isodate),23))
3308 READ(datebuf,'(I4,1X,I2,1X,I2,1X,I2,1X,I2,1X,I2,1X,I3)', err=100) &
3309 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3310 lmsec = lmsec + lsec*1000
3311 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3312 RETURN
3313
3314100 CONTINUE ! condizione di errore in isodate
3316 RETURN
3317 ELSE
3318 this = datetime_miss
3319 ENDIF
3320
3321ELSE IF (PRESENT(simpledate)) THEN ! formato YYYYMMDDhhmmssmsc
3323 datebuf(1:17) = '00010101000000000'
3324 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3325 READ(datebuf,'(I4.4,5I2.2,I3.3)', err=120) &
3326 lyear, lmonth, lday, lhour, lminute, lsec, lmsec
3327 lmsec = lmsec + lsec*1000
3328 CALL jeladata5_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3329 RETURN
3330
3331120 CONTINUE ! condizione di errore in simpledate
3333 RETURN
3334 ELSE
3335 this = datetime_miss
3336 ENDIF
3337
3338ELSE
3339 this = datetime_miss
3340ENDIF
3341
3342END FUNCTION datetime_new
3343
3344
3346FUNCTION datetime_new_now(now) RESULT(this)
3347INTEGER,INTENT(IN) :: now
3348TYPE(datetime) :: this
3349
3350INTEGER :: dt(8)
3351
3353 CALL date_and_time(values=dt)
3354 IF (now /= datetime_local) dt(6) = dt(6) - dt(4) ! back to UTC
3356 msec=dt(7)*1000+dt(8))
3357ELSE
3358 this = datetime_miss
3359ENDIF
3360
3361END FUNCTION datetime_new_now
3362
3363
3370SUBROUTINE datetime_init(this, year, month, day, hour, minute, msec, &
3371 unixtime, isodate, simpledate, now)
3372TYPE(datetime),INTENT(INOUT) :: this
3373INTEGER,INTENT(IN),OPTIONAL :: year
3374INTEGER,INTENT(IN),OPTIONAL :: month
3375INTEGER,INTENT(IN),OPTIONAL :: day
3376INTEGER,INTENT(IN),OPTIONAL :: hour
3377INTEGER,INTENT(IN),OPTIONAL :: minute
3378INTEGER,INTENT(IN),OPTIONAL :: msec
3379INTEGER(kind=int_ll),INTENT(IN),OPTIONAL :: unixtime
3380CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3381CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3382INTEGER,INTENT(IN),OPTIONAL :: now
3383
3384IF (PRESENT(now)) THEN
3385 this = datetime_new_now(now)
3386ELSE
3387 this = datetime_new(year, month, day, hour, minute, msec, &
3388 unixtime, isodate, simpledate)
3389ENDIF
3390
3391END SUBROUTINE datetime_init
3392
3393
3394ELEMENTAL SUBROUTINE datetime_delete(this)
3395TYPE(datetime),INTENT(INOUT) :: this
3396
3397this%iminuti = illmiss
3398
3399END SUBROUTINE datetime_delete
3400
3401
3406PURE SUBROUTINE datetime_getval(this, year, month, day, hour, minute, msec, &
3407 unixtime, isodate, simpledate, oraclesimdate)
3408TYPE(datetime),INTENT(IN) :: this
3409INTEGER,INTENT(OUT),OPTIONAL :: year
3410INTEGER,INTENT(OUT),OPTIONAL :: month
3411INTEGER,INTENT(OUT),OPTIONAL :: day
3412INTEGER,INTENT(OUT),OPTIONAL :: hour
3413INTEGER,INTENT(OUT),OPTIONAL :: minute
3414INTEGER,INTENT(OUT),OPTIONAL :: msec
3415INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: unixtime
3416CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3417CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3418CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3419
3420INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3421CHARACTER(len=23) :: datebuf
3422
3423IF (PRESENT(year) .OR. PRESENT(month) .OR. PRESENT(day) .OR. PRESENT(hour) &
3424 .OR. PRESENT(minute) .OR. PRESENT(msec) .OR. PRESENT(isodate) &
3425 .OR. PRESENT(simpledate) .OR. PRESENT(oraclesimdate) .OR. PRESENT(unixtime)) THEN
3426
3427 IF (this == datetime_miss) THEN
3428
3429 IF (PRESENT(msec)) THEN
3430 msec = imiss
3431 ENDIF
3432 IF (PRESENT(minute)) THEN
3433 minute = imiss
3434 ENDIF
3435 IF (PRESENT(hour)) THEN
3436 hour = imiss
3437 ENDIF
3438 IF (PRESENT(day)) THEN
3439 day = imiss
3440 ENDIF
3441 IF (PRESENT(month)) THEN
3442 month = imiss
3443 ENDIF
3444 IF (PRESENT(year)) THEN
3445 year = imiss
3446 ENDIF
3447 IF (PRESENT(isodate)) THEN
3448 isodate = cmiss
3449 ENDIF
3450 IF (PRESENT(simpledate)) THEN
3451 simpledate = cmiss
3452 ENDIF
3453 IF (PRESENT(oraclesimdate)) THEN
3454!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3455!!$ 'obsoleto, usare piuttosto simpledate')
3456 oraclesimdate=cmiss
3457 ENDIF
3458 IF (PRESENT(unixtime)) THEN
3459 unixtime = illmiss
3460 ENDIF
3461
3462 ELSE
3463
3464 CALL jeladata6_1(lday, lmonth, lyear, lhour, lminute, lmsec, this%iminuti)
3465 IF (PRESENT(msec)) THEN
3466 msec = lmsec
3467 ENDIF
3468 IF (PRESENT(minute)) THEN
3469 minute = lminute
3470 ENDIF
3471 IF (PRESENT(hour)) THEN
3472 hour = lhour
3473 ENDIF
3474 IF (PRESENT(day)) THEN
3475 day = lday
3476 ENDIF
3477 IF (PRESENT(month)) THEN
3478 month = lmonth
3479 ENDIF
3480 IF (PRESENT(year)) THEN
3481 year = lyear
3482 ENDIF
3483 IF (PRESENT(isodate)) THEN
3484 WRITE(datebuf(1:23), '(I4.4,A1,I2.2,A1,I2.2,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
3485 lyear, '-', lmonth, '-', lday, lhour, ':', lminute, ':', lmsec/1000, &
3487 isodate = datebuf(1:min(len(isodate),23))
3488 ENDIF
3489 IF (PRESENT(simpledate)) THEN
3490 WRITE(datebuf(1:17), '(I4.4,5I2.2,I3.3)') &
3491 lyear, lmonth, lday, lhour, lminute, lmsec/1000, mod(lmsec, 1000)
3492 simpledate = datebuf(1:min(len(simpledate),17))
3493 ENDIF
3494 IF (PRESENT(oraclesimdate)) THEN
3495!!$ CALL l4f_log(L4F_WARN, 'in datetime_getval, parametro oraclesimdate '// &
3496!!$ 'obsoleto, usare piuttosto simpledate')
3497 WRITE(oraclesimdate, '(I4.4,4I2.2)') lyear, lmonth, lday, lhour, lminute
3498 ENDIF
3499 IF (PRESENT(unixtime)) THEN
3500 unixtime = this%iminuti/1000_int_ll-unsec
3501 ENDIF
3502
3503 ENDIF
3504ENDIF
3505
3506END SUBROUTINE datetime_getval
3507
3508
3511elemental FUNCTION datetime_to_char(this) RESULT(char)
3512TYPE(datetime),INTENT(IN) :: this
3513
3514CHARACTER(len=23) :: char
3515
3517
3518END FUNCTION datetime_to_char
3519
3520
3521FUNCTION trim_datetime_to_char(in) RESULT(char)
3522TYPE(datetime),INTENT(IN) :: in ! value to be represented as CHARACTER
3523
3524CHARACTER(len=len_trim(datetime_to_char(in))) :: char
3525
3526char=datetime_to_char(in)
3527
3528END FUNCTION trim_datetime_to_char
3529
3530
3531
3532SUBROUTINE display_datetime(this)
3533TYPE(datetime),INTENT(in) :: this
3534
3536
3537end subroutine display_datetime
3538
3539
3540
3541SUBROUTINE display_timedelta(this)
3542TYPE(timedelta),INTENT(in) :: this
3543
3545
3546end subroutine display_timedelta
3547
3548
3549
3550ELEMENTAL FUNCTION c_e_datetime(this) result (res)
3551TYPE(datetime),INTENT(in) :: this
3552LOGICAL :: res
3553
3554res = .not. this == datetime_miss
3555
3556end FUNCTION c_e_datetime
3557
3558
3559ELEMENTAL FUNCTION datetime_eq(this, that) RESULT(res)
3560TYPE(datetime),INTENT(IN) :: this, that
3561LOGICAL :: res
3562
3563res = this%iminuti == that%iminuti
3564
3565END FUNCTION datetime_eq
3566
3567
3568ELEMENTAL FUNCTION datetime_ne(this, that) RESULT(res)
3569TYPE(datetime),INTENT(IN) :: this, that
3570LOGICAL :: res
3571
3572res = .NOT.(this == that)
3573
3574END FUNCTION datetime_ne
3575
3576
3577ELEMENTAL FUNCTION datetime_gt(this, that) RESULT(res)
3578TYPE(datetime),INTENT(IN) :: this, that
3579LOGICAL :: res
3580
3581res = this%iminuti > that%iminuti
3582
3583END FUNCTION datetime_gt
3584
3585
3586ELEMENTAL FUNCTION datetime_lt(this, that) RESULT(res)
3587TYPE(datetime),INTENT(IN) :: this, that
3588LOGICAL :: res
3589
3590res = this%iminuti < that%iminuti
3591
3592END FUNCTION datetime_lt
3593
3594
3595ELEMENTAL FUNCTION datetime_ge(this, that) RESULT(res)
3596TYPE(datetime),INTENT(IN) :: this, that
3597LOGICAL :: res
3598
3599IF (this == that) THEN
3600 res = .true.
3601ELSE IF (this > that) THEN
3602 res = .true.
3603ELSE
3604 res = .false.
3605ENDIF
3606
3607END FUNCTION datetime_ge
3608
3609
3610ELEMENTAL FUNCTION datetime_le(this, that) RESULT(res)
3611TYPE(datetime),INTENT(IN) :: this, that
3612LOGICAL :: res
3613
3614IF (this == that) THEN
3615 res = .true.
3616ELSE IF (this < that) THEN
3617 res = .true.
3618ELSE
3619 res = .false.
3620ENDIF
3621
3622END FUNCTION datetime_le
3623
3624
3625FUNCTION datetime_add(this, that) RESULT(res)
3626TYPE(datetime),INTENT(IN) :: this
3627TYPE(timedelta),INTENT(IN) :: that
3628TYPE(datetime) :: res
3629
3630INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3631
3632IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3633 res = datetime_miss
3634ELSE
3635 res%iminuti = this%iminuti + that%iminuti
3636 IF (that%month /= 0) THEN
3638 minute=lminute, msec=lmsec)
3640 hour=lhour, minute=lminute, msec=lmsec)
3641 ENDIF
3642ENDIF
3643
3644END FUNCTION datetime_add
3645
3646
3647ELEMENTAL FUNCTION datetime_subdt(this, that) RESULT(res)
3648TYPE(datetime),INTENT(IN) :: this, that
3649TYPE(timedelta) :: res
3650
3651IF (this == datetime_miss .OR. that == datetime_miss) THEN
3652 res = timedelta_miss
3653ELSE
3654 res%iminuti = this%iminuti - that%iminuti
3655 res%month = 0
3656ENDIF
3657
3658END FUNCTION datetime_subdt
3659
3660
3661FUNCTION datetime_subtd(this, that) RESULT(res)
3662TYPE(datetime),INTENT(IN) :: this
3663TYPE(timedelta),INTENT(IN) :: that
3664TYPE(datetime) :: res
3665
3666INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
3667
3668IF (this == datetime_miss .OR. that == timedelta_miss) THEN
3669 res = datetime_miss
3670ELSE
3671 res%iminuti = this%iminuti - that%iminuti
3672 IF (that%month /= 0) THEN
3674 minute=lminute, msec=lmsec)
3676 hour=lhour, minute=lminute, msec=lmsec)
3677 ENDIF
3678ENDIF
3679
3680END FUNCTION datetime_subtd
3681
3682
3687SUBROUTINE datetime_read_unit(this, unit)
3688TYPE(datetime),INTENT(out) :: this
3689INTEGER, INTENT(in) :: unit
3690CALL datetime_vect_read_unit((/this/), unit)
3691
3692END SUBROUTINE datetime_read_unit
3693
3694
3699SUBROUTINE datetime_vect_read_unit(this, unit)
3700TYPE(datetime) :: this(:)
3701INTEGER, INTENT(in) :: unit
3702
3703CHARACTER(len=40) :: form
3704CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3705INTEGER :: i
3706
3707ALLOCATE(dateiso(SIZE(this)))
3708INQUIRE(unit, form=form)
3709IF (form == 'FORMATTED') THEN
3710 READ(unit,'(A23,1X)')dateiso
3711ELSE
3712 READ(unit)dateiso
3713ENDIF
3714DO i = 1, SIZE(dateiso)
3716ENDDO
3717DEALLOCATE(dateiso)
3718
3719END SUBROUTINE datetime_vect_read_unit
3720
3721
3726SUBROUTINE datetime_write_unit(this, unit)
3727TYPE(datetime),INTENT(in) :: this
3728INTEGER, INTENT(in) :: unit
3729
3730CALL datetime_vect_write_unit((/this/), unit)
3731
3732END SUBROUTINE datetime_write_unit
3733
3734
3739SUBROUTINE datetime_vect_write_unit(this, unit)
3740TYPE(datetime),INTENT(in) :: this(:)
3741INTEGER, INTENT(in) :: unit
3742
3743CHARACTER(len=40) :: form
3744CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
3745INTEGER :: i
3746
3747ALLOCATE(dateiso(SIZE(this)))
3748DO i = 1, SIZE(dateiso)
3750ENDDO
3751INQUIRE(unit, form=form)
3752IF (form == 'FORMATTED') THEN
3753 WRITE(unit,'(A23,1X)')dateiso
3754ELSE
3755 WRITE(unit)dateiso
3756ENDIF
3757DEALLOCATE(dateiso)
3758
3759END SUBROUTINE datetime_vect_write_unit
3760
3761
3762#include "arrayof_post.F90"
3763
3764
3765! ===============
3766! == timedelta ==
3767! ===============
3774FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
3775 isodate, simpledate, oraclesimdate) RESULT (this)
3776INTEGER,INTENT(IN),OPTIONAL :: year
3777INTEGER,INTENT(IN),OPTIONAL :: month
3778INTEGER,INTENT(IN),OPTIONAL :: day
3779INTEGER,INTENT(IN),OPTIONAL :: hour
3780INTEGER,INTENT(IN),OPTIONAL :: minute
3781INTEGER,INTENT(IN),OPTIONAL :: sec
3782INTEGER,INTENT(IN),OPTIONAL :: msec
3783CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3784CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3785CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3786
3787TYPE(timedelta) :: this
3788
3789CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3790 isodate, simpledate, oraclesimdate)
3791
3792END FUNCTION timedelta_new
3793
3794
3799SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
3800 isodate, simpledate, oraclesimdate)
3801TYPE(timedelta),INTENT(INOUT) :: this
3802INTEGER,INTENT(IN),OPTIONAL :: year
3803INTEGER,INTENT(IN),OPTIONAL :: month
3804INTEGER,INTENT(IN),OPTIONAL :: day
3805INTEGER,INTENT(IN),OPTIONAL :: hour
3806INTEGER,INTENT(IN),OPTIONAL :: minute
3807INTEGER,INTENT(IN),OPTIONAL :: sec
3808INTEGER,INTENT(IN),OPTIONAL :: msec
3809CHARACTER(len=*),INTENT(IN),OPTIONAL :: isodate
3810CHARACTER(len=*),INTENT(IN),OPTIONAL :: simpledate
3811CHARACTER(len=12),INTENT(IN),OPTIONAL :: oraclesimdate
3812
3813INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
3814CHARACTER(len=23) :: datebuf
3815
3816this%month = 0
3817
3818IF (PRESENT(isodate)) THEN
3819 datebuf(1:23) = '0000000000 00:00:00.000'
3820 l = len_trim(isodate)
3821! IF (l > 0) THEN
3823 IF (n > 0) THEN
3824 IF (n > 11 .OR. n < l - 12) GOTO 200 ! wrong format
3825 datebuf(12-n:12-n+l-1) = isodate(:l)
3826 ELSE
3827 datebuf(1:l) = isodate(1:l)
3828 ENDIF
3829! ENDIF
3830
3831! datebuf(1:MIN(LEN(isodate),23)) = isodate(1:MIN(LEN(isodate),23))
3832 READ(datebuf,'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
3833 h, m, s, ms
3834 this%month = lmonth + 12*lyear
3835 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3836 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3837 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3838 RETURN
3839
3840200 CONTINUE ! condizione di errore in isodate
3842 CALL l4f_log(l4f_error, 'isodate '//trim(isodate)//' not valid')
3843 CALL raise_error()
3844
3845ELSE IF (PRESENT(simpledate)) THEN
3846 datebuf(1:17) = '00000000000000000'
3847 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
3848 READ(datebuf,'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
3849 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3850 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
3851 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
3852
3853220 CONTINUE ! condizione di errore in simpledate
3855 CALL l4f_log(l4f_error, 'simpledate '//trim(simpledate)//' not valid')
3856 CALL raise_error()
3857 RETURN
3858
3859ELSE IF (PRESENT(oraclesimdate)) THEN
3860 CALL l4f_log(l4f_warn, 'in timedelta_init, parametro oraclesimdate '// &
3861 'obsoleto, usare piuttosto simpledate')
3862 READ(oraclesimdate, '(I8,2I2)')d, h, m
3863 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
3864 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
3865
3866ELSE IF (.not. present(year) .and. .not. present(month) .and. .not. present(day)&
3867 .and. .not. present(hour) .and. .not. present(minute) .and. .not. present(sec)&
3868 .and. .not. present(msec) .and. .not. present(isodate) &
3869 .and. .not. present(simpledate) .and. .not. present(oraclesimdate)) THEN
3870
3871 this=timedelta_miss
3872
3873ELSE
3874 this%iminuti = 0
3875 IF (PRESENT(year)) THEN
3877 this%month = this%month + year*12
3878 else
3879 this=timedelta_miss
3880 return
3881 end if
3882 ENDIF
3883 IF (PRESENT(month)) THEN
3885 this%month = this%month + month
3886 else
3887 this=timedelta_miss
3888 return
3889 end if
3890 ENDIF
3891 IF (PRESENT(day)) THEN
3893 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
3894 else
3895 this=timedelta_miss
3896 return
3897 end if
3898 ENDIF
3899 IF (PRESENT(hour)) THEN
3901 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
3902 else
3903 this=timedelta_miss
3904 return
3905 end if
3906 ENDIF
3907 IF (PRESENT(minute)) THEN
3909 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
3910 else
3911 this=timedelta_miss
3912 return
3913 end if
3914 ENDIF
3915 IF (PRESENT(sec)) THEN
3917 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
3918 else
3919 this=timedelta_miss
3920 return
3921 end if
3922 ENDIF
3923 IF (PRESENT(msec)) THEN
3925 this%iminuti = this%iminuti + msec
3926 else
3927 this=timedelta_miss
3928 return
3929 end if
3930 ENDIF
3931ENDIF
3932
3933
3934
3935
3936END SUBROUTINE timedelta_init
3937
3938
3939SUBROUTINE timedelta_delete(this)
3940TYPE(timedelta),INTENT(INOUT) :: this
3941
3942this%iminuti = imiss
3943this%month = 0
3944
3945END SUBROUTINE timedelta_delete
3946
3947
3952PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
3953 day, hour, minute, sec, msec, &
3954 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
3955TYPE(timedelta),INTENT(IN) :: this
3956INTEGER,INTENT(OUT),OPTIONAL :: year
3957INTEGER,INTENT(OUT),OPTIONAL :: month
3958INTEGER,INTENT(OUT),OPTIONAL :: amonth
3959INTEGER,INTENT(OUT),OPTIONAL :: day
3960INTEGER,INTENT(OUT),OPTIONAL :: hour
3961INTEGER,INTENT(OUT),OPTIONAL :: minute
3962INTEGER,INTENT(OUT),OPTIONAL :: sec
3963INTEGER,INTENT(OUT),OPTIONAL :: msec
3964INTEGER,INTENT(OUT),OPTIONAL :: ahour
3965INTEGER,INTENT(OUT),OPTIONAL :: aminute
3966INTEGER,INTENT(OUT),OPTIONAL :: asec
3967INTEGER(kind=int_ll),INTENT(OUT),OPTIONAL :: amsec
3968CHARACTER(len=*),INTENT(OUT),OPTIONAL :: isodate
3969CHARACTER(len=*),INTENT(OUT),OPTIONAL :: simpledate
3970CHARACTER(len=12),INTENT(OUT),OPTIONAL :: oraclesimdate
3971
3972CHARACTER(len=23) :: datebuf
3973
3974IF (PRESENT(amsec)) THEN
3975 amsec = this%iminuti
3976ENDIF
3977IF (PRESENT(asec)) THEN
3978 asec = int(this%iminuti/1000_int_ll)
3979ENDIF
3980IF (PRESENT(aminute)) THEN
3981 aminute = int(this%iminuti/60000_int_ll)
3982ENDIF
3983IF (PRESENT(ahour)) THEN
3984 ahour = int(this%iminuti/3600000_int_ll)
3985ENDIF
3986IF (PRESENT(msec)) THEN
3987 msec = int(mod(this%iminuti, 1000_int_ll))
3988ENDIF
3989IF (PRESENT(sec)) THEN
3990 sec = int(mod(this%iminuti/1000_int_ll, 60_int_ll))
3991ENDIF
3992IF (PRESENT(minute)) THEN
3993 minute = int(mod(this%iminuti/60000_int_ll, 60_int_ll))
3994ENDIF
3995IF (PRESENT(hour)) THEN
3996 hour = int(mod(this%iminuti/3600000_int_ll, 24_int_ll))
3997ENDIF
3998IF (PRESENT(day)) THEN
3999 day = int(this%iminuti/86400000_int_ll)
4000ENDIF
4001IF (PRESENT(amonth)) THEN
4002 amonth = this%month
4003ENDIF
4004IF (PRESENT(month)) THEN
4005 month = mod(this%month-1,12)+1
4006ENDIF
4007IF (PRESENT(year)) THEN
4008 year = this%month/12
4009ENDIF
4010IF (PRESENT(isodate)) THEN ! Non standard, inventato!
4011 WRITE(datebuf(1:23), '(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
4015 isodate = datebuf(1:min(len(isodate),23))
4016
4017ENDIF
4018IF (PRESENT(simpledate)) THEN
4019 WRITE(datebuf(1:17), '(I8.8,3I2.2,I3.3)') &
4020 this%iminuti/86400000_int_ll, mod(this%iminuti/3600000_int_ll, 24_int_ll), &
4022 mod(this%iminuti, 1000_int_ll)
4023 simpledate = datebuf(1:min(len(simpledate),17))
4024ENDIF
4025IF (PRESENT(oraclesimdate)) THEN
4026!!$ CALL l4f_log(L4F_WARN, 'in timedelta_getval, parametro oraclesimdate '// &
4027!!$ 'obsoleto, usare piuttosto simpledate')
4028 WRITE(oraclesimdate, '(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
4030ENDIF
4031
4032END SUBROUTINE timedelta_getval
4033
4034
4037elemental FUNCTION timedelta_to_char(this) RESULT(char)
4038TYPE(timedelta),INTENT(IN) :: this
4039
4040CHARACTER(len=23) :: char
4041
4043
4044END FUNCTION timedelta_to_char
4045
4046
4047FUNCTION trim_timedelta_to_char(in) RESULT(char)
4048TYPE(timedelta),INTENT(IN) :: in ! value to be represented as CHARACTER
4049
4050CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
4051
4052char=timedelta_to_char(in)
4053
4054END FUNCTION trim_timedelta_to_char
4055
4056
4058elemental FUNCTION timedelta_getamsec(this)
4059TYPE(timedelta),INTENT(IN) :: this
4060INTEGER(kind=int_ll) :: timedelta_getamsec
4061
4062timedelta_getamsec = this%iminuti
4063
4064END FUNCTION timedelta_getamsec
4065
4066
4072FUNCTION timedelta_depop(this)
4073TYPE(timedelta),INTENT(IN) :: this
4074TYPE(timedelta) :: timedelta_depop
4075
4076TYPE(datetime) :: tmpdt
4077
4078IF (this%month == 0) THEN
4079 timedelta_depop = this
4080ELSE
4081 tmpdt = datetime_new(1970, 1, 1)
4082 timedelta_depop = (tmpdt + this) - tmpdt
4083ENDIF
4084
4085END FUNCTION timedelta_depop
4086
4087
4088elemental FUNCTION timedelta_eq(this, that) RESULT(res)
4089TYPE(timedelta),INTENT(IN) :: this, that
4090LOGICAL :: res
4091
4092res = (this%iminuti == that%iminuti .AND. this%month == that%month)
4093
4094END FUNCTION timedelta_eq
4095
4096
4097ELEMENTAL FUNCTION timedelta_ne(this, that) RESULT(res)
4098TYPE(timedelta),INTENT(IN) :: this, that
4099LOGICAL :: res
4100
4101res = .NOT.(this == that)
4102
4103END FUNCTION timedelta_ne
4104
4105
4106ELEMENTAL FUNCTION timedelta_gt(this, that) RESULT(res)
4107TYPE(timedelta),INTENT(IN) :: this, that
4108LOGICAL :: res
4109
4110res = this%iminuti > that%iminuti
4111
4112END FUNCTION timedelta_gt
4113
4114
4115ELEMENTAL FUNCTION timedelta_lt(this, that) RESULT(res)
4116TYPE(timedelta),INTENT(IN) :: this, that
4117LOGICAL :: res
4118
4119res = this%iminuti < that%iminuti
4120
4121END FUNCTION timedelta_lt
4122
4123
4124ELEMENTAL FUNCTION timedelta_ge(this, that) RESULT(res)
4125TYPE(timedelta),INTENT(IN) :: this, that
4126LOGICAL :: res
4127
4128IF (this == that) THEN
4129 res = .true.
4130ELSE IF (this > that) THEN
4131 res = .true.
4132ELSE
4133 res = .false.
4134ENDIF
4135
4136END FUNCTION timedelta_ge
4137
4138
4139elemental FUNCTION timedelta_le(this, that) RESULT(res)
4140TYPE(timedelta),INTENT(IN) :: this, that
4141LOGICAL :: res
4142
4143IF (this == that) THEN
4144 res = .true.
4145ELSE IF (this < that) THEN
4146 res = .true.
4147ELSE
4148 res = .false.
4149ENDIF
4150
4151END FUNCTION timedelta_le
4152
4153
4154ELEMENTAL FUNCTION timedelta_add(this, that) RESULT(res)
4155TYPE(timedelta),INTENT(IN) :: this, that
4156TYPE(timedelta) :: res
4157
4158res%iminuti = this%iminuti + that%iminuti
4159res%month = this%month + that%month
4160
4161END FUNCTION timedelta_add
4162
4163
4164ELEMENTAL FUNCTION timedelta_sub(this, that) RESULT(res)
4165TYPE(timedelta),INTENT(IN) :: this, that
4166TYPE(timedelta) :: res
4167
4168res%iminuti = this%iminuti - that%iminuti
4169res%month = this%month - that%month
4170
4171END FUNCTION timedelta_sub
4172
4173
4174ELEMENTAL FUNCTION timedelta_mult(this, n) RESULT(res)
4175TYPE(timedelta),INTENT(IN) :: this
4176INTEGER,INTENT(IN) :: n
4177TYPE(timedelta) :: res
4178
4179res%iminuti = this%iminuti*n
4180res%month = this%month*n
4181
4182END FUNCTION timedelta_mult
4183
4184
4185ELEMENTAL FUNCTION timedelta_tlum(n, this) RESULT(res)
4186INTEGER,INTENT(IN) :: n
4187TYPE(timedelta),INTENT(IN) :: this
4188TYPE(timedelta) :: res
4189
4190res%iminuti = this%iminuti*n
4191res%month = this%month*n
4192
4193END FUNCTION timedelta_tlum
4194
4195
4196ELEMENTAL FUNCTION timedelta_divint(this, n) RESULT(res)
4197TYPE(timedelta),INTENT(IN) :: this
4198INTEGER,INTENT(IN) :: n
4199TYPE(timedelta) :: res
4200
4201res%iminuti = this%iminuti/n
4202res%month = this%month/n
4203
4204END FUNCTION timedelta_divint
4205
4206
4207ELEMENTAL FUNCTION timedelta_divtd(this, that) RESULT(res)
4208TYPE(timedelta),INTENT(IN) :: this, that
4209INTEGER :: res
4210
4211res = int(this%iminuti/that%iminuti)
4212
4213END FUNCTION timedelta_divtd
4214
4215
4216elemental FUNCTION timedelta_mod(this, that) RESULT(res)
4217TYPE(timedelta),INTENT(IN) :: this, that
4218TYPE(timedelta) :: res
4219
4220res%iminuti = mod(this%iminuti, that%iminuti)
4221res%month = 0
4222
4223END FUNCTION timedelta_mod
4224
4225
4226ELEMENTAL FUNCTION datetime_timedelta_mod(this, that) RESULT(res)
4227TYPE(datetime),INTENT(IN) :: this
4228TYPE(timedelta),INTENT(IN) :: that
4229TYPE(timedelta) :: res
4230
4231IF (that%iminuti == 0) THEN ! Controllo nel caso di intervalli "umani" o nulli
4232 res = timedelta_0
4233ELSE
4234 res%iminuti = mod(this%iminuti, that%iminuti)
4235 res%month = 0
4236ENDIF
4237
4238END FUNCTION datetime_timedelta_mod
4239
4240
4241ELEMENTAL FUNCTION timedelta_abs(this) RESULT(res)
4242TYPE(timedelta),INTENT(IN) :: this
4243TYPE(timedelta) :: res
4244
4245res%iminuti = abs(this%iminuti)
4246res%month = abs(this%month)
4247
4248END FUNCTION timedelta_abs
4249
4250
4255SUBROUTINE timedelta_read_unit(this, unit)
4256TYPE(timedelta),INTENT(out) :: this
4257INTEGER, INTENT(in) :: unit
4258
4259CALL timedelta_vect_read_unit((/this/), unit)
4260
4261END SUBROUTINE timedelta_read_unit
4262
4263
4268SUBROUTINE timedelta_vect_read_unit(this, unit)
4269TYPE(timedelta) :: this(:)
4270INTEGER, INTENT(in) :: unit
4271
4272CHARACTER(len=40) :: form
4273CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
4274INTEGER :: i
4275
4276ALLOCATE(dateiso(SIZE(this)))
4277INQUIRE(unit, form=form)
4278IF (form == 'FORMATTED') THEN
4279 READ(unit,'(3(A23,1X))')dateiso
4280ELSE
4281 READ(unit)dateiso
4282ENDIF
4283DO i = 1, SIZE(dateiso)
4285ENDDO
4286DEALLOCATE(dateiso)
4287
4288END SUBROUTINE timedelta_vect_read_unit
4289
4290
4295SUBROUTINE timedelta_write_unit(this, unit)
4296TYPE(timedelta),INTENT(in) :: this
4297INTEGER, INTENT(in) :: unit
4298
4299CALL timedelta_vect_write_unit((/this/), unit)
4300
4301END SUBROUTINE timedelta_write_unit
4302
4303
4308SUBROUTINE timedelta_vect_write_unit(this, unit)
4309TYPE(timedelta),INTENT(in) :: this(:)
4310INTEGER, INTENT(in) :: unit
4311
4312CHARACTER(len=40) :: form
4313CHARACTER(len=23), ALLOCATABLE :: dateiso(:)
4314INTEGER :: i
4315
4316ALLOCATE(dateiso(SIZE(this)))
4317DO i = 1, SIZE(dateiso)
4319ENDDO
4320INQUIRE(unit, form=form)
4321IF (form == 'FORMATTED') THEN
4322 WRITE(unit,'(3(A23,1X))')dateiso
4323ELSE
4324 WRITE(unit)dateiso
4325ENDIF
4326DEALLOCATE(dateiso)
4327
4328END SUBROUTINE timedelta_vect_write_unit
4329
4330
4331ELEMENTAL FUNCTION c_e_timedelta(this) result (res)
4332TYPE(timedelta),INTENT(in) :: this
4333LOGICAL :: res
4334
4335res = .not. this == timedelta_miss
4336
4337end FUNCTION c_e_timedelta
4338
4339
4340elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
4341
4342!!omstart JELADATA5
4343! SUBROUTINE JELADATA5(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
4344! 1 IMINUTI)
4345!
4346! Calcola i minuti trascorsi tra il 1/1/1 e la data fornita
4347!
4348! variabili integer*4
4349! IN:
4350! IDAY,IMONTH,IYEAR, I*4
4351! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
4352!
4353! OUT:
4354! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
4355!!OMEND
4356
4357INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin
4358INTEGER,intent(out) :: iminuti
4359
4360iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
4361
4362END SUBROUTINE jeladata5
4363
4364
4365elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
4366INTEGER,intent(in) :: iday, imonth, iyear, ihour, imin, imsec
4367INTEGER(KIND=int_ll),intent(out) :: imillisec
4368
4369imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
4370 + imsec
4371
4372END SUBROUTINE jeladata5_1
4373
4374
4375
4376elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
4377
4378!!omstart JELADATA6
4379! SUBROUTINE JELADATA6(IDAY,IMONTH,IYEAR,IHOUR,IMIN,
4380! 1 IMINUTI)
4381!
4382! Calcola la data e l'ora corrispondente a IMINUTI dopo il
4383! 1/1/1
4384!
4385! variabili integer*4
4386! IN:
4387! IMINUTI I*4 MINUTI AD INIZIARE DALLE ORE 00 DEL 1/1/1
4388!
4389! OUT:
4390! IDAY,IMONTH,IYEAR, I*4
4391! IHOUR,IMIN GIORNO MESE ANNO ORE MINUTI
4392!!OMEND
4393
4394
4395INTEGER,intent(in) :: iminuti
4396INTEGER,intent(out) :: iday, imonth, iyear, ihour, imin
4397
4398INTEGER ::igiorno
4399
4400imin = mod(iminuti,60)
4401ihour = mod(iminuti,1440)/60
4402igiorno = iminuti/1440
4404CALL ndyin(igiorno,iday,imonth,iyear)
4405
4406END SUBROUTINE jeladata6
4407
4408
4409elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
4410INTEGER(KIND=int_ll), INTENT(IN) :: imillisec
4411INTEGER, INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
4412
4413INTEGER :: igiorno
4414
4416!imin = MOD(imillisec/60000_int_ll, 60)
4417!ihour = MOD(imillisec/3600000_int_ll, 24)
4418imin = int(mod(imillisec, 3600000_int_ll)/60000_int_ll)
4419ihour = int(mod(imillisec, 86400000_int_ll)/3600000_int_ll)
4420igiorno = int(imillisec/86400000_int_ll)
4421!IF (MOD(imillisec,1440) < 0) igiorno = igiorno-1 !?!?!?
4422CALL ndyin(igiorno,iday,imonth,iyear)
4423
4424END SUBROUTINE jeladata6_1
4425
4426
4427elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
4428
4429!!OMSTART NDYIN
4430! SUBROUTINE NDYIN(NDAYS,IGG,IMM,IAA)
4431! restituisce la data fornendo in input il numero di
4432! giorni dal 1/1/1
4433!
4434!!omend
4435
4436INTEGER,intent(in) :: ndays
4437INTEGER,intent(out) :: igg, imm, iaa
4438integer :: n,lndays
4439
4440lndays=ndays
4441
4442n = lndays/d400
4443lndays = lndays - n*d400
4444iaa = year0 + n*400
4445n = min(lndays/d100, 3)
4446lndays = lndays - n*d100
4447iaa = iaa + n*100
4448n = lndays/d4
4449lndays = lndays - n*d4
4450iaa = iaa + n*4
4451n = min(lndays/d1, 3)
4452lndays = lndays - n*d1
4453iaa = iaa + n
4454n = bisextilis(iaa)
4455DO imm = 1, 12
4456 IF (lndays < ianno(imm+1,n)) EXIT
4457ENDDO
4458igg = lndays+1-ianno(imm,n) ! +1 perche' il mese parte da 1
4459
4460END SUBROUTINE ndyin
4461
4462
4463integer elemental FUNCTION ndays(igg,imm,iaa)
4464
4465!!OMSTART NDAYS
4466! FUNCTION NDAYS(IGG,IMM,IAA)
4467! restituisce il numero di giorni dal 1/1/1
4468! fornendo in input la data
4469!
4470!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4471! nota bene E' SICURO !!!
4472! un anno e' bisestile se divisibile per 4
4473! un anno rimane bisestile se divisibile per 400
4474! un anno NON e' bisestile se divisibile per 100
4475!
4476!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4477!
4478!!omend
4479
4480INTEGER, intent(in) :: igg, imm, iaa
4481
4482INTEGER :: lmonth, lyear
4483
4484! Limito il mese a [1-12] e correggo l'anno coerentemente
4485lmonth = modulo(imm-1, 12) + 1 ! uso MODULO e non MOD per gestire bene i valori <0
4486lyear = iaa + (imm - lmonth)/12
4487ndays = igg+ianno(lmonth, bisextilis(lyear))
4488ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
4489 (lyear-year0)/400
4490
4491END FUNCTION ndays
4492
4493
4494elemental FUNCTION bisextilis(annum)
4495INTEGER,INTENT(in) :: annum
4496INTEGER :: bisextilis
4497
4499 bisextilis = 2
4500ELSE
4501 bisextilis = 1
4502ENDIF
4503END FUNCTION bisextilis
4504
4505
4506ELEMENTAL FUNCTION cyclicdatetime_eq(this, that) RESULT(res)
4507TYPE(cyclicdatetime),INTENT(IN) :: this, that
4508LOGICAL :: res
4509
4510res = .true.
4511if (this%minute /= that%minute) res=.false.
4512if (this%hour /= that%hour) res=.false.
4513if (this%day /= that%day) res=.false.
4514if (this%month /= that%month) res=.false.
4515if (this%tendaysp /= that%tendaysp) res=.false.
4516
4517END FUNCTION cyclicdatetime_eq
4518
4519
4520ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that) RESULT(res)
4521TYPE(cyclicdatetime),INTENT(IN) :: this
4522TYPE(datetime),INTENT(IN) :: that
4523LOGICAL :: res
4524
4525integer :: minute,hour,day,month
4526
4528
4529res = .true.
4535 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4536end if
4537
4538END FUNCTION cyclicdatetime_datetime_eq
4539
4540
4541ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that) RESULT(res)
4542TYPE(datetime),INTENT(IN) :: this
4543TYPE(cyclicdatetime),INTENT(IN) :: that
4544LOGICAL :: res
4545
4546integer :: minute,hour,day,month
4547
4549
4550res = .true.
4555
4557 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
4558end if
4559
4560
4561END FUNCTION datetime_cyclicdatetime_eq
4562
4563ELEMENTAL FUNCTION c_e_cyclicdatetime(this) result (res)
4564TYPE(cyclicdatetime),INTENT(in) :: this
4565LOGICAL :: res
4566
4567res = .not. this == cyclicdatetime_miss
4568
4569end FUNCTION c_e_cyclicdatetime
4570
4571
4574FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate) RESULT(this)
4575INTEGER,INTENT(IN),OPTIONAL :: tendaysp
4576INTEGER,INTENT(IN),OPTIONAL :: month
4577INTEGER,INTENT(IN),OPTIONAL :: day
4578INTEGER,INTENT(IN),OPTIONAL :: hour
4579INTEGER,INTENT(IN),OPTIONAL :: minute
4580CHARACTER(len=9),INTENT(IN),OPTIONAL :: chardate
4581
4582integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
4583
4584
4585TYPE(cyclicdatetime) :: this
4586
4587if (present(chardate)) then
4588
4589 ltendaysp=imiss
4590 lmonth=imiss
4591 lday=imiss
4592 lhour=imiss
4593 lminute=imiss
4594
4596 ! TMMGGhhmm
4597 read(chardate(1:1),'(i1)',iostat=ios)ltendaysp
4598 !print*,chardate(1:1),ios,ltendaysp
4599 if (ios /= 0)ltendaysp=imiss
4600
4601 read(chardate(2:3),'(i2)',iostat=ios)lmonth
4602 !print*,chardate(2:3),ios,lmonth
4603 if (ios /= 0)lmonth=imiss
4604
4605 read(chardate(4:5),'(i2)',iostat=ios)lday
4606 !print*,chardate(4:5),ios,lday
4607 if (ios /= 0)lday=imiss
4608
4609 read(chardate(6:7),'(i2)',iostat=ios)lhour
4610 !print*,chardate(6:7),ios,lhour
4611 if (ios /= 0)lhour=imiss
4612
4613 read(chardate(8:9),'(i2)',iostat=ios)lminute
4614 !print*,chardate(8:9),ios,lminute
4615 if (ios /= 0)lminute=imiss
4616 end if
4617
4618 this%tendaysp=ltendaysp
4619 this%month=lmonth
4620 this%day=lday
4621 this%hour=lhour
4622 this%minute=lminute
4623else
4624 this%tendaysp=optio_l(tendaysp)
4625 this%month=optio_l(month)
4626 this%day=optio_l(day)
4627 this%hour=optio_l(hour)
4628 this%minute=optio_l(minute)
4629end if
4630
4631END FUNCTION cyclicdatetime_new
4632
4635elemental FUNCTION cyclicdatetime_to_char(this) RESULT(char)
4636TYPE(cyclicdatetime),INTENT(IN) :: this
4637
4638CHARACTER(len=80) :: char
4639
4642
4643END FUNCTION cyclicdatetime_to_char
4644
4645
4658FUNCTION cyclicdatetime_to_conventional(this) RESULT(dtc)
4659TYPE(cyclicdatetime),INTENT(IN) :: this
4660
4661TYPE(datetime) :: dtc
4662
4663integer :: year,month,day,hour
4664
4665dtc = datetime_miss
4666
4667! no cyclicdatetime present -> year=1001 : yearly values (no other time dependence)
4669 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
4670 return
4671end if
4672
4673! minute present -> not good for conventional datetime
4675! day, month and tendaysp present -> no good
4677
4679 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
4681 day=(this%tendaysp-1)*10+1
4682 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
4684 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
4686 ! only day present -> no good
4687 return
4688end if
4689
4692 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
4693end if
4694
4695
4696END FUNCTION cyclicdatetime_to_conventional
4697
4698
4699
4700FUNCTION trim_cyclicdatetime_to_char(in) RESULT(char)
4701TYPE(cyclicdatetime),INTENT(IN) :: in ! value to be represented as CHARACTER
4702
4703CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
4704
4705char=cyclicdatetime_to_char(in)
4706
4707END FUNCTION trim_cyclicdatetime_to_char
4708
4709
4710
4711SUBROUTINE display_cyclicdatetime(this)
4712TYPE(cyclicdatetime),INTENT(in) :: this
4713
4715
4716end subroutine display_cyclicdatetime
4717
4718
4719#include "array_utilities_inc.F90"
4720
4722
Quick method to append an element to the array. Definition: datetime_class.F90:622 Restituiscono il valore dell'oggetto nella forma desiderata. Definition: datetime_class.F90:328 Costruttori per le classi datetime e timedelta. Definition: datetime_class.F90:317 Method for inserting elements of the array at a desired position. Definition: datetime_class.F90:613 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: datetime_class.F90:645 Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o... Definition: datetime_class.F90:484 Method for removing elements of the array at a desired position. Definition: datetime_class.F90:628 Functions that return a trimmed CHARACTER representation of the input variable. Definition: datetime_class.F90:355 Restituiscono il valore dell'oggetto in forma di stringa stampabile. Definition: datetime_class.F90:333 Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ... Definition: datetime_class.F90:491 Definition of constants to be used for declaring variables of a desired type. Definition: kinds.F90:251 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:261 Class for expressing an absolute time value. Definition: datetime_class.F90:239 Class for expressing a relative time interval. Definition: datetime_class.F90:251 |