33 INTEGER :: extra_info=imiss
34 TYPE(datetime) :: time=datetime_miss
37 INTERFACE OPERATOR (==)
38 MODULE PROCEDURE ttr_mapper_eq
41 INTERFACE OPERATOR (/=)
42 MODULE PROCEDURE ttr_mapper_ne
45 INTERFACE OPERATOR (>)
46 MODULE PROCEDURE ttr_mapper_gt
49 INTERFACE OPERATOR (<)
50 MODULE PROCEDURE ttr_mapper_lt
53 INTERFACE OPERATOR (>=)
54 MODULE PROCEDURE ttr_mapper_ge
57 INTERFACE OPERATOR (<=)
58 MODULE PROCEDURE ttr_mapper_le
61 #undef VOL7D_POLY_TYPE 62 #undef VOL7D_POLY_TYPES 64 #define VOL7D_POLY_TYPE TYPE(ttr_mapper) 65 #define VOL7D_POLY_TYPES _ttr_mapper 67 #include "array_utilities_pre.F90" 69 #define ARRAYOF_ORIGTYPE TYPE(ttr_mapper) 70 #define ARRAYOF_TYPE arrayof_ttr_mapper 71 #define ARRAYOF_ORIGEQ 1 72 #define ARRAYOF_ORIGGT 1 73 #include "arrayof_pre.F90" 80 ELEMENTAL FUNCTION ttr_mapper_eq(this, that)
RESULT(res)
81 TYPE(ttr_mapper),
INTENT(IN) :: this, that
84 res = this%time == that%time
86 END FUNCTION ttr_mapper_eq
88 ELEMENTAL FUNCTION ttr_mapper_ne(this, that)
RESULT(res)
89 TYPE(ttr_mapper),
INTENT(IN) :: this, that
92 res = this%time /= that%time
94 END FUNCTION ttr_mapper_ne
96 ELEMENTAL FUNCTION ttr_mapper_gt(this, that)
RESULT(res)
97 TYPE(ttr_mapper),
INTENT(IN) :: this, that
100 res = this%time > that%time
102 END FUNCTION ttr_mapper_gt
104 ELEMENTAL FUNCTION ttr_mapper_lt(this, that)
RESULT(res)
105 TYPE(ttr_mapper),
INTENT(IN) :: this, that
108 res = this%time < that%time
110 END FUNCTION ttr_mapper_lt
112 ELEMENTAL FUNCTION ttr_mapper_ge(this, that)
RESULT(res)
113 TYPE(ttr_mapper),
INTENT(IN) :: this, that
116 res = this%time >= that%time
118 END FUNCTION ttr_mapper_ge
120 ELEMENTAL FUNCTION ttr_mapper_le(this, that)
RESULT(res)
121 TYPE(ttr_mapper),
INTENT(IN) :: this, that
124 res = this%time <= that%time
126 END FUNCTION ttr_mapper_le
128 #include "arrayof_post.F90" 129 #include "array_utilities_inc.F90" 133 SUBROUTINE recompute_stat_proc_diff_common(itime, itimerange, stat_proc, step, &
134 otime, otimerange, map_tr, f, keep_tr, time_definition, full_steps, &
136 TYPE(datetime),
INTENT(in) :: itime(:)
137 TYPE(vol7d_timerange),
INTENT(in) :: itimerange(:)
138 INTEGER,
INTENT(in) :: stat_proc
139 TYPE(timedelta),
INTENT(in) :: step
140 TYPE(datetime),
POINTER :: otime(:)
141 TYPE(vol7d_timerange),
POINTER :: otimerange(:)
142 INTEGER,
ALLOCATABLE,
INTENT(out) :: map_tr(:,:,:,:,:), f(:), keep_tr(:,:,:)
144 LOGICAL,
ALLOCATABLE :: mask_timerange(:)
145 INTEGER,
INTENT(in) :: time_definition
146 LOGICAL,
INTENT(in),
OPTIONAL :: full_steps
147 TYPE(datetime),
INTENT(in),
OPTIONAL :: start
149 INTEGER :: i, j, k, l, dirtyrep
151 LOGICAL :: lfull_steps, useful
152 TYPE(datetime) :: lstart, pstart1, pstart2, pend1, pend2, reftime1, reftime2, tmptime
153 TYPE(vol7d_timerange) :: tmptimerange
154 TYPE(arrayof_datetime) :: a_otime
155 TYPE(arrayof_vol7d_timerange) :: a_otimerange
156 TYPE(timedelta) :: start_delta
159 CALL getval(step, asec=steps)
161 lstart = datetime_miss
162 IF (
PRESENT(start)) lstart = start
163 lfull_steps = optio_log(full_steps)
166 ALLOCATE(mask_timerange(
SIZE(itimerange)))
167 mask_timerange(:) = itimerange(:)%timerange == stat_proc &
168 .AND. itimerange(:)%p1 /= imiss .AND. itimerange(:)%p2 /= imiss &
169 .AND. itimerange(:)%p1 >= 0 &
170 .AND. itimerange(:)%p2 > 0
172 IF (lfull_steps .AND. steps /= 0)
THEN 173 mask_timerange(:) = mask_timerange(:) .AND. &
174 (itimerange(:)%p1 == 0 .OR. &
175 mod(itimerange(:)%p1, steps) == 0 .OR. &
176 mod(itimerange(:)%p1 - itimerange(:)%p2, steps) == 0)
180 nitr = count(mask_timerange)
184 DO WHILE(.NOT.mask_timerange(j))
192 ALLOCATE(keep_tr(nitr,
SIZE(itime), 2))
193 CALL compute_keep_tr()
195 ALLOCATE(map_tr(nitr,
SIZE(itime), nitr,
SIZE(itime), 2))
196 map_tr(:,:,:,:,:) = imiss
200 IF (dirtyrep == 2)
THEN 203 CALL sort(a_otime%array)
204 CALL sort(a_otimerange%array)
206 DO l = 1,
SIZE(itime)
208 CALL time_timerange_get_period(itime(l), itimerange(f(k)), &
209 time_definition, pstart2, pend2, reftime2)
211 DO j = 1,
SIZE(itime)
214 CALL time_timerange_get_period(itime(j), itimerange(f(i)), &
215 time_definition, pstart1, pend1, reftime1)
216 tmptimerange = vol7d_timerange_new(timerange=stat_proc)
218 IF (reftime2 == pend2 .AND. reftime1 == pend1)
THEN 219 IF (pstart2 == pstart1 .AND. pend2 > pend1)
THEN 220 CALL time_timerange_set_period(tmptime, tmptimerange, &
221 time_definition, pend1, pend2, reftime2)
222 IF (lfull_steps)
THEN 223 IF (
mod(reftime2, step) == timedelta_0)
THEN 230 ELSE IF (pstart2 < pstart1 .AND. pend2 == pend1)
THEN 231 CALL time_timerange_set_period(tmptime, tmptimerange, &
232 time_definition, pstart2, pstart1, pstart1)
233 IF (lfull_steps)
THEN 234 IF (
mod(pstart1, step) == timedelta_0)
THEN 242 ELSE IF (reftime2 == reftime1)
THEN 243 IF (lfull_steps)
THEN 244 IF (
c_e(lstart))
THEN 247 start_delta = lstart-reftime2
249 start_delta = timedelta_0
253 IF (pstart2 == pstart1 .AND. pend2 > pend1)
THEN 254 CALL time_timerange_set_period(tmptime, tmptimerange, &
255 time_definition, pend1, pend2, reftime2)
256 IF (lfull_steps)
THEN 257 IF (
mod(pend2-reftime2-start_delta, step) == timedelta_0)
THEN 264 IF (
c_e(lstart))
THEN 265 IF (lstart > pend1) useful = .false.
268 ELSE IF (pstart2 < pstart1 .AND. pend2 == pend1)
THEN 269 CALL time_timerange_set_period(tmptime, tmptimerange, &
270 time_definition, pstart2, pstart1, reftime2)
271 IF (lfull_steps)
THEN 272 IF (
mod(pstart1-reftime2-start_delta, step) == timedelta_0)
THEN 279 IF (
c_e(lstart))
THEN 280 IF (lstart > pstart2) useful = .false.
285 useful = useful .AND. tmptime /= datetime_miss .AND. &
286 tmptimerange /= vol7d_timerange_miss .AND. tmptimerange%p2 == steps
289 map_tr(i,j,k,l,1) = append_unique(a_otime, tmptime)
290 map_tr(i,j,k,l,2) = append_unique(a_otimerange, tmptimerange)
299 CALL compute_keep_tr()
301 otime => a_otime%array
302 otimerange => a_otimerange%array
304 CALL delete(a_otime, nodealloc=.true.)
305 CALL delete(a_otimerange, nodealloc=.true.)
308 CALL l4f_log(l4f_debug, &
309 'recompute_stat_proc_diff, map_tr: '//
t2c((
SIZE(map_tr,1)))//
', '// &
310 t2c((
SIZE(map_tr,2)))//
', '// &
311 t2c((
SIZE(map_tr,3)))//
', '// &
312 t2c((
SIZE(map_tr,4))))
313 CALL l4f_log(l4f_debug, &
314 'recompute_stat_proc_diff, map_tr: '//
t2c((
SIZE(map_tr))/2)//
', '// &
316 CALL l4f_log(l4f_debug, &
317 'recompute_stat_proc_diff, nitr: '//
t2c(nitr))
318 CALL l4f_log(l4f_debug, &
319 'recompute_stat_proc_diff, good timeranges: '//
t2c(count(
c_e(keep_tr))/2))
320 CALL l4f_log(l4f_debug, &
321 'recompute_stat_proc_diff, output times: '//
t2c(
SIZE(otime)))
322 CALL l4f_log(l4f_debug, &
323 'recompute_stat_proc_diff, output timeranges: '//
t2c(
SIZE(otimerange)))
328 SUBROUTINE compute_keep_tr()
329 INTEGER :: start_deltas
331 keep_tr(:,:,:) = imiss
332 DO l = 1,
SIZE(itime)
333 itrloop:
DO k = 1, nitr
334 IF (itimerange(f(k))%p2 == steps)
THEN 335 CALL time_timerange_get_period(itime(l), itimerange(f(k)), &
336 time_definition, pstart2, pend2, reftime2)
339 IF (
c_e(lstart))
THEN 340 IF (lstart > pstart2) cycle itrloop
342 IF (reftime2 == pend2)
THEN 343 IF (
c_e(lstart))
THEN 344 IF (
mod(reftime2-lstart, step) == timedelta_0)
THEN 347 ELSE IF (lfull_steps)
THEN 348 IF (
mod(reftime2, step) == timedelta_0)
THEN 355 IF (lfull_steps)
THEN 358 start_deltas = timedelta_getamsec(lstart-reftime2)/1000_int_ll
362 IF (
mod(itimerange(f(k))%p1 - start_deltas, steps) == 0)
THEN 372 keep_tr(k,l,1) = append_unique(a_otime, itime(l))
373 keep_tr(k,l,2) = append_unique(a_otimerange, itimerange(f(k)))
379 END SUBROUTINE compute_keep_tr
381 END SUBROUTINE recompute_stat_proc_diff_common
385 SUBROUTINE compute_stat_proc_metamorph_common(istat_proc, itimerange, ostat_proc, &
387 INTEGER,
INTENT(in) :: istat_proc
388 TYPE(vol7d_timerange),
INTENT(in) :: itimerange(:)
389 INTEGER,
INTENT(in) :: ostat_proc
390 TYPE(vol7d_timerange),
POINTER :: otimerange(:)
391 INTEGER,
POINTER :: map_tr(:)
394 LOGICAL :: tr_mask(SIZE(itimerange))
396 IF (
SIZE(itimerange) == 0)
THEN 397 ALLOCATE(otimerange(0), map_tr(0))
402 tr_mask(:) = itimerange(:)%timerange == istat_proc .AND. itimerange(:)%p2 /= imiss &
403 .AND. itimerange(:)%p2 /= 0
404 ALLOCATE(otimerange(count(tr_mask)), map_tr(count(tr_mask)))
406 otimerange = pack(itimerange, mask=tr_mask)
407 otimerange(:)%timerange = ostat_proc
408 map_tr = pack((/(i,i=1,
SIZE(itimerange))/), mask=tr_mask)
410 END SUBROUTINE compute_stat_proc_metamorph_common
414 SUBROUTINE recompute_stat_proc_agg_common(itime, itimerange, stat_proc, tri, &
415 step, time_definition, otime, otimerange, map_ttr, dtratio, start, full_steps)
416 TYPE(datetime),
INTENT(in) :: itime(:)
417 TYPE(vol7d_timerange),
INTENT(in) :: itimerange(:)
418 INTEGER,
INTENT(in) :: stat_proc
419 INTEGER,
INTENT(in) :: tri
420 TYPE(timedelta),
INTENT(in) :: step
421 INTEGER,
INTENT(in) :: time_definition
422 TYPE(datetime),
POINTER :: otime(:)
423 TYPE(vol7d_timerange),
POINTER :: otimerange(:)
424 TYPE(arrayof_ttr_mapper),
POINTER :: map_ttr(:,:)
425 INTEGER,
POINTER,
OPTIONAL :: dtratio(:)
426 TYPE(datetime),
INTENT(in),
OPTIONAL :: start
427 LOGICAL,
INTENT(in),
OPTIONAL :: full_steps
429 INTEGER :: i, j, k, l, na, nf, n
430 INTEGER :: steps, p1, maxp1, maxp2, minp1mp2, dstart, msteps
431 INTEGER(kind=int_ll) :: stepms, mstepms
433 TYPE(datetime) :: lstart, lend, pstart1, pstart2, pend1, pend2, reftime1, reftime2, tmptime
434 TYPE(arrayof_datetime) :: a_otime
435 TYPE(arrayof_vol7d_timerange) :: a_otimerange
436 TYPE(arrayof_integer) :: a_dtratio
437 LOGICAL,
ALLOCATABLE :: mask_timerange(:)
438 TYPE(ttr_mapper) :: lmapper
439 CHARACTER(len=8) :: env_var
440 LOGICAL :: climat_behavior
445 CALL getenv(
'LIBSIM_CLIMAT_BEHAVIOR', env_var)
446 climat_behavior = len_trim(env_var) > 0 .AND. .NOT.
PRESENT(dtratio)
449 CALL getval(timedelta_depop(step), asec=steps)
452 ALLOCATE(mask_timerange(
SIZE(itimerange)))
453 mask_timerange(:) = itimerange(:)%timerange == tri &
454 .AND. itimerange(:)%p1 /= imiss .AND. itimerange(:)%p1 >= 0
456 IF (
PRESENT(dtratio))
THEN 457 WHERE(itimerange(:)%p2 > 0 .AND. itimerange(:)%p2 /= imiss)
458 mask_timerange(:) = mask_timerange(:) .AND.
mod(steps, itimerange(:)%p2) == 0
460 mask_timerange(:) = .false.
463 mask_timerange(:) = mask_timerange(:) .AND. itimerange(:)%p2 == 0
467 CALL l4f_log(l4f_debug, &
468 '(re)compute_stat_proc_agg, number of useful timeranges before choosing analysis/forecast: '// &
469 t2c(count(mask_timerange)))
474 na = count(mask_timerange(:) .AND. itimerange(:)%p1 == 0)
475 nf = count(mask_timerange(:) .AND. itimerange(:)%p1 > 0)
478 CALL l4f_log(l4f_debug, &
479 'recompute_stat_proc_agg, na: '//
t2c(na)//
', nf: '//
t2c(nf))
484 CALL l4f_log(l4f_info, &
485 'recompute_stat_proc_agg, processing in forecast mode')
487 mask_timerange(:) = mask_timerange(:) .AND. itimerange(:)%p1 == 0
488 CALL l4f_log(l4f_info, &
489 'recompute_stat_proc_agg, processing in analysis mode')
493 CALL l4f_log(l4f_debug, &
494 '(re)compute_stat_proc_agg, number of useful timeranges: '// &
495 t2c(count(mask_timerange)))
498 IF (
SIZE(itime) == 0 .OR. count(mask_timerange) == 0)
THEN 499 ALLOCATE(otime(0), otimerange(0), map_ttr(0,0))
500 IF (
PRESENT(dtratio))
ALLOCATE(dtratio(0))
505 lstart = datetime_miss
506 IF (
PRESENT(start)) lstart = start
507 lend = itime(
SIZE(itime))
509 maxp1 = maxval(itimerange(:)%p1, mask=mask_timerange)
510 maxp2 = maxval(itimerange(:)%p2, mask=mask_timerange)
511 minp1mp2 = minval(itimerange(:)%p1 - itimerange(:)%p2, mask=mask_timerange)
512 IF (time_definition == 0)
THEN 513 lend = lend + timedelta_new(sec=maxp1)
519 IF (lstart == datetime_miss)
THEN 522 IF (time_definition == 0)
THEN 523 lstart = lstart + timedelta_new(sec=minp1mp2)
526 lstart = lstart - timedelta_new(sec=maxp2)
531 IF (optio_log(full_steps) .AND. .NOT.lforecast)
THEN 532 lstart = lstart - (
mod(lstart, step))
537 CALL l4f_log(l4f_debug, &
538 'recompute_stat_proc_agg, processing period: '//
t2c(lstart)//
' - '//
t2c(lend))
544 IF (time_definition == 0)
THEN 545 CALL insert(a_otime, itime)
550 CALL getval(lstart-itime(1), asec=dstart)
553 IF (dstart < 0) dstart =
mod(dstart, steps)
554 DO p1 = steps + dstart, maxp1, steps
555 CALL insert_unique(a_otimerange, vol7d_timerange_new(stat_proc, p1, steps))
567 mstepms = steps*1000_int_ll
568 DO i = 2,
SIZE(itime)
569 CALL getval(itime(i)-itime(i-1), amsec=stepms)
570 IF (stepms > 0_int_ll .AND. stepms < mstepms)
THEN 571 msteps = stepms/1000_int_ll
572 IF (
mod(steps, msteps) == 0) mstepms = stepms
575 msteps = mstepms/1000_int_ll
577 tmptime = lstart + step
578 DO WHILE(tmptime < lend)
579 CALL insert_unique(a_otime, tmptime)
580 tmptime = tmptime + step
589 DO p1 = msteps, maxp1, msteps
590 CALL insert_unique(a_otimerange, vol7d_timerange_new(stat_proc, p1, steps))
596 tmptime = lstart + step
597 DO WHILE(tmptime < lend)
598 CALL insert_unique(a_otime, tmptime)
599 tmptime = tmptime + step
601 CALL insert_unique(a_otimerange, vol7d_timerange_new(stat_proc, 0, steps))
607 otime => a_otime%array
608 otimerange => a_otimerange%array
610 CALL sort(otimerange)
612 CALL delete(a_otime, nodealloc=.true.)
613 CALL delete(a_otimerange, nodealloc=.true.)
616 CALL l4f_log(l4f_debug, &
617 'recompute_stat_proc_agg, output time and timerange: '//&
618 t2c(
SIZE(otime))//
', '//
t2c(
size(otimerange)))
621 IF (
PRESENT(dtratio))
THEN 623 DO k = 1,
SIZE(itimerange)
624 IF (itimerange(k)%p2 /= 0) &
625 CALL insert_unique(a_dtratio, steps/itimerange(k)%p2)
628 dtratio => a_dtratio%array
631 CALL delete(a_dtratio, nodealloc=.true.)
634 CALL l4f_log(l4f_debug, &
635 'recompute_stat_proc_agg, found '//
t2c(
size(dtratio))// &
636 ' possible aggregation ratios, from '// &
637 t2c(dtratio(1))//
' to '//
t2c(dtratio(
SIZE(dtratio))))
640 ALLOCATE(map_ttr(
SIZE(otime),
SIZE(otimerange)))
641 do_itimerange1:
DO l = 1,
SIZE(itimerange)
642 IF (.NOT.mask_timerange(l)) cycle do_itimerange1
643 do_itime1:
DO k = 1,
SIZE(itime)
644 CALL time_timerange_get_period(itime(k), itimerange(l), &
645 time_definition, pstart1, pend1, reftime1)
646 do_otimerange1:
DO j = 1,
SIZE(otimerange)
647 do_otime1:
DO i = 1,
SIZE(otime)
648 CALL time_timerange_get_period_pop(otime(i), otimerange(j), step, &
649 time_definition, pstart2, pend2, reftime2)
651 IF (reftime1 /= reftime2) cycle do_otime1
654 IF (pstart1 >= pstart2 .AND. pend1 <= pend2 .AND. &
655 mod(pstart1-pstart2, pend1-pstart1) == timedelta_0)
THEN 658 lmapper%extra_info = steps/itimerange(l)%p2
659 n =
append(map_ttr(i,j), lmapper)
669 ALLOCATE(map_ttr(
SIZE(otime),
SIZE(otimerange)))
670 do_itimerange2:
DO l = 1,
SIZE(itimerange)
671 IF (.NOT.mask_timerange(l)) cycle do_itimerange2
672 do_itime2:
DO k = 1,
SIZE(itime)
673 CALL time_timerange_get_period(itime(k), itimerange(l), &
674 time_definition, pstart1, pend1, reftime1)
675 do_otimerange2:
DO j = 1,
SIZE(otimerange)
676 do_otime2:
DO i = 1,
SIZE(otime)
677 CALL time_timerange_get_period_pop(otime(i), otimerange(j), step, &
678 time_definition, pstart2, pend2, reftime2)
680 IF (reftime1 /= reftime2) cycle do_otime2
683 IF (climat_behavior .AND. pstart1 == pstart2) cycle do_otime2
684 IF (pstart1 >= pstart2 .AND. pend1 <= pend2)
THEN 687 IF (pstart1 == pstart2)
THEN 688 lmapper%extra_info = 1
689 ELSE IF (pend1 == pend2)
THEN 690 lmapper%extra_info = 2
692 lmapper%extra_info = imiss
694 lmapper%time = pstart1
695 n = insert_sorted(map_ttr(i,j), lmapper, .true., .true.)
705 END SUBROUTINE recompute_stat_proc_agg_common
708 SUBROUTINE compute_stat_proc_agg_sw(vertime, pstart, pend, time_mask, &
710 TYPE(
datetime),
INTENT(in) :: vertime(:)
713 LOGICAL,
INTENT(in) :: time_mask(:)
714 TYPE(
timedelta),
OPTIONAL,
INTENT(out) :: max_step
715 DOUBLE PRECISION,
OPTIONAL,
INTENT(out) :: weights(:)
718 TYPE(
datetime),
ALLOCATABLE :: lvertime(:)
720 INTEGER(kind=int_ll) :: dt, tdt
722 nt = count(time_mask)
723 ALLOCATE(lvertime(nt))
724 lvertime = pack(vertime, mask=time_mask)
726 IF (
PRESENT(max_step))
THEN 737 max_step = pend - pstart
739 half = lvertime(1) + (lvertime(2) - lvertime(1))/2
740 max_step = half - pstart
742 nexthalf = lvertime(i) + (lvertime(i+1) - lvertime(i))/2
743 IF (nexthalf - half > max_step) max_step = nexthalf - half
746 IF (pend - half > max_step) max_step = pend - half
751 IF (
PRESENT(weights))
THEN 755 CALL getval(pend - pstart, amsec=tdt)
756 half = lvertime(1) + (lvertime(2) - lvertime(1))/2
757 CALL getval(half - pstart, amsec=dt)
758 weights(1) = dble(dt)/dble(tdt)
760 nexthalf = lvertime(i) + (lvertime(i+1) - lvertime(i))/2
762 weights(i) = dble(dt)/dble(tdt)
765 CALL getval(pend - half, amsec=dt)
766 weights(nt) = dble(dt)/dble(tdt)
770 END SUBROUTINE compute_stat_proc_agg_sw
774 SUBROUTINE time_timerange_get_period(time, timerange, time_definition, &
775 pstart, pend, reftime)
777 TYPE(vol7d_timerange),
INTENT(in) :: timerange
778 INTEGER,
INTENT(in) :: time_definition
779 TYPE(
datetime),
INTENT(out) :: reftime
780 TYPE(
datetime),
INTENT(out) :: pstart
786 p1 = timedelta_new(sec=timerange%p1)
787 p2 = timedelta_new(sec=timerange%p2)
789 IF (time == datetime_miss .OR. .NOT.
c_e(timerange%p1) .OR. .NOT.
c_e(timerange%p2) .OR. &
791 timerange%p1 < 0 .OR. timerange%p2 < 0)
THEN 792 pstart = datetime_miss
794 reftime = datetime_miss
798 IF (time_definition == 0)
THEN 802 ELSE IF (time_definition == 1 .OR. time_definition == 2)
THEN 807 pstart = datetime_miss
809 reftime = datetime_miss
812 END SUBROUTINE time_timerange_get_period
818 SUBROUTINE time_timerange_get_period_pop(time, timerange, step, time_definition, &
819 pstart, pend, reftime)
821 TYPE(vol7d_timerange),
INTENT(in) :: timerange
823 INTEGER,
INTENT(in) :: time_definition
824 TYPE(
datetime),
INTENT(out) :: reftime
825 TYPE(
datetime),
INTENT(out) :: pstart
831 p1 = timedelta_new(sec=timerange%p1)
833 IF (time == datetime_miss .OR. .NOT.
c_e(timerange%p1) .OR. .NOT.
c_e(timerange%p2) .OR. &
835 timerange%p1 < 0 .OR. timerange%p2 < 0)
THEN 836 pstart = datetime_miss
838 reftime = datetime_miss
842 IF (time_definition == 0)
THEN 846 ELSE IF (time_definition == 1 .OR. time_definition == 2)
THEN 851 pstart = datetime_miss
853 reftime = datetime_miss
856 END SUBROUTINE time_timerange_get_period_pop
861 SUBROUTINE time_timerange_set_period(time, timerange, time_definition, &
862 pstart, pend, reftime)
864 TYPE(vol7d_timerange),
INTENT(inout) :: timerange
865 INTEGER,
INTENT(in) :: time_definition
871 INTEGER(kind=int_ll) :: dmsec
874 IF (time_definition == 0)
THEN 878 ELSE IF (time_definition == 1 .OR. time_definition == 2)
THEN 886 IF (time /= datetime_miss)
THEN 887 CALL getval(p1, amsec=dmsec)
888 timerange%p1 = int(dmsec/1000_int_ll)
889 CALL getval(p2, amsec=dmsec)
890 timerange%p2 = int(dmsec/1000_int_ll)
896 END SUBROUTINE time_timerange_set_period
Functions that return a trimmed CHARACTER representation of the input variable.
Class for expressing an absolute time value.
This module contains functions that are only for internal use of the library.
Classi per la gestione delle coordinate temporali.
Quick method to append an element to the array.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Restituiscono il valore dell'oggetto nella forma desiderata.
Operatore di resto della divisione.
Classe per la gestione di un volume completo di dati osservati.
Class for expressing a relative time interval.
Destructor for finalizing an array object.
Method for inserting elements of the array at a desired position.