libsim Versione 7.2.1
|
◆ vol7d_recompute_stat_proc_agg_multiv()
Definizione alla linea 1268 del file vol7d_class_compute.F90. 1270!! viene modificato e quindi dovrà essere distrutto da parte del
1271!! programma chiamante se il suo contenuto non è più
1272!! richiesto. Attenzione, se necessario la dimensione tempo (vettore
1273!! \a this%time del volume \a this ) viene riordinata, come effetto
1274!! collaterale della chiamata.
1275SUBROUTINE vol7d_fill_time(this, that, step, start, stopp, cyclicdt)
1276TYPE(vol7d),INTENT(inout) :: this
1277TYPE(vol7d),INTENT(inout) :: that
1278TYPE(timedelta),INTENT(in) :: step
1279TYPE(datetime),INTENT(in),OPTIONAL :: start
1280TYPE(datetime),INTENT(in),OPTIONAL :: stopp
1281TYPE(cyclicdatetime),INTENT(in),OPTIONAL :: cyclicdt
1282
1283TYPE(cyclicdatetime) :: lcyclicdt
1284TYPE(datetime) :: counter, lstart, lstop
1285INTEGER :: i, naddtime
1286
1287CALL safe_start_stop(this, lstart, lstop, start, stopp)
1288IF (.NOT. c_e(lstart) .OR. .NOT. c_e(lstop) .OR. .NOT. c_e(step)) RETURN
1289
1290lcyclicdt=cyclicdatetime_miss
1291if (present(cyclicdt)) then
1292 if(c_e(cyclicdt)) lcyclicdt=cyclicdt
1293end if
1294
1295CALL l4f_log(l4f_info, 'vol7d_fill_time: time interval '//trim(to_char(lstart))// &
1296 ' '//trim(to_char(lstop)))
1297
1298! Count the number of time levels required for completing the series
1299! valid also in the case (SIZE(this%time) == 0)
1300naddtime = 0
1301counter = lstart
1302i = 1
1303naddcount: DO WHILE(counter <= lstop)
1304 DO WHILE(i <= SIZE(this%time)) ! this%time(i) chases counter
1305 IF (counter < this%time(i)) THEN ! this%time(i) overtook counter
1306 i = max(i-1,1) ! go back if possible
1307 EXIT
1308 ELSE IF (counter == this%time(i) .OR. .NOT. counter == lcyclicdt) THEN ! found matching time
1309 counter = counter + step
1310 cycle naddcount
1311 ENDIF
1312 i = i + 1
1313 ENDDO
1314 naddtime = naddtime + 1
1315 counter = counter + step
1316ENDDO naddcount
1317
1318! old universal algorithm, not optimized, check that the new one is equivalent
1319!naddtime = 0
1320!counter = lstart
1321!DO WHILE(counter <= lstop)
1322! IF (.NOT.ANY(counter == this%time(:))) THEN
1323! naddtime = naddtime + 1
1324! ENDIF
1325! counter = counter + step
1326!ENDDO
1327
1328IF (naddtime > 0) THEN
1329
1330 CALL init(that)
1331 CALL vol7d_alloc(that, ntime=naddtime)
1332 CALL vol7d_alloc_vol(that)
1333
1334 ! Repeat the count loop setting the time levels to be added
1335 naddtime = 0
1336 counter = lstart
1337 i = 1
1338 naddadd: DO WHILE(counter <= lstop)
1339 DO WHILE(i <= SIZE(this%time)) ! this%time(i) chases counter
1340 IF (counter < this%time(i)) THEN ! this%time(i) overtook counter
1341 i = max(i-1,1) ! go back if possible
1342 EXIT
1343 ELSE IF (counter == this%time(i) .OR. .NOT. counter == lcyclicdt) THEN ! found matching time
1344 counter = counter + step
1345 cycle naddadd
1346 ENDIF
1347 i = i + 1
1348 ENDDO
1349 naddtime = naddtime + 1
1350 that%time(naddtime) = counter ! only difference
1351 counter = counter + step
1352 ENDDO naddadd
1353
1354 CALL vol7d_append(that, this, sort=.true.)
1355
1356ELSE
1357!! ? why sort all dimension ?
1358!! CALL vol7d_copy(this, that, lsort_time=.TRUE.)
1359 CALL vol7d_copy(this, that, sort=.true.)
1360ENDIF
1361
1362
1363END SUBROUTINE vol7d_fill_time
1364
1365
1377SUBROUTINE vol7d_filter_time(this, that, step, start, stopp, cyclicdt)
1378TYPE(vol7d),INTENT(inout) :: this
1379TYPE(vol7d),INTENT(inout) :: that
1380TYPE(timedelta),INTENT(in),optional :: step
1381TYPE(datetime),INTENT(in),OPTIONAL :: start
1382TYPE(datetime),INTENT(in),OPTIONAL :: stopp
1383TYPE(cyclicdatetime),INTENT(in),OPTIONAL :: cyclicdt
1384
1385TYPE(datetime) :: lstart, lstop
1386LOGICAL, ALLOCATABLE :: time_mask(:)
1387
1388CALL safe_start_stop(this, lstart, lstop, start, stopp)
1389IF (.NOT. c_e(lstart) .OR. .NOT. c_e(lstop)) RETURN
1390
1391CALL l4f_log(l4f_info, 'vol7d_filter_time: time interval '//trim(to_char(lstart))// &
1392 ' '//trim(to_char(lstop)))
1393
1394ALLOCATE(time_mask(SIZE(this%time)))
1395
1396time_mask = this%time >= lstart .AND. this%time <= lstop
1397
1398IF (PRESENT(cyclicdt)) THEN
1399 IF (c_e(cyclicdt)) THEN
1400 time_mask = time_mask .AND. this%time == cyclicdt
1401 ENDIF
1402ENDIF
1403
1404IF (PRESENT(step)) THEN
1405 IF (c_e(step)) THEN
1406 time_mask = time_mask .AND. mod(this%time - lstart, step) == timedelta_0
1407 ENDIF
1408ENDIF
1409
1410CALL vol7d_copy(this,that, ltime=time_mask)
1411
1412DEALLOCATE(time_mask)
1413
1414END SUBROUTINE vol7d_filter_time
1415
1416
1420SUBROUTINE vol7d_fill_data(this, step, start, stopp, tolerance)
1421TYPE(vol7d),INTENT(inout) :: this
1422TYPE(timedelta),INTENT(in) :: step
1423TYPE(datetime),INTENT(in),OPTIONAL :: start
1424TYPE(datetime),INTENT(in),OPTIONAL :: stopp
1425TYPE(timedelta),INTENT(in),optional :: tolerance
1426
1427TYPE(datetime) :: lstart, lstop
1428integer :: indana , indtime ,indlevel ,indtimerange ,inddativarr, indnetwork, iindtime
1429type(timedelta) :: deltato,deltat, ltolerance
1430
1431CALL safe_start_stop(this, lstart, lstop, start, stopp)
1432IF (.NOT. c_e(lstart) .OR. .NOT. c_e(lstop)) RETURN
1433
1434CALL l4f_log(l4f_info, 'vol7d_fill_data: time interval '//trim(to_char(lstart))// &
1435 ' '//trim(to_char(lstop)))
1436
1437
1438ltolerance=step/2
1439
1440if (present(tolerance))then
1441 if (c_e(tolerance)) ltolerance=tolerance
1442end if
1443
1444
|