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)
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
761 CALL getval(nexthalf - half, amsec=dt)
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)
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)
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
866 TYPE(
datetime),
INTENT(in) :: reftime
871 INTEGER(kind=int_ll) :: dmsec
874 IF (time_definition == 0)
THEN
878 ELSE IF (time_definition == 1)
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
Restituiscono il valore dell'oggetto nella forma desiderata.
Operatore di resto della divisione.
Functions that return a trimmed CHARACTER representation of the input variable.
Quick method to append an element to the array.
Destructor for finalizing an array object.
Method for inserting elements of the array at a desired position.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Classi per la gestione delle coordinate temporali.
This module contains functions that are only for internal use of the library.
Classe per la gestione di un volume completo di dati osservati.
Class for expressing an absolute time value.
Class for expressing a relative time interval.