libsim Versione 7.2.4
|
◆ vol7d_set_attr_ind()
Metodo per creare gli indici che associano le variabili aventi attributo alle variabili nei relativi descrittori. Ha senso chiamare questo metodo solo dopo che i descrittori delle variabili e degli attributi desiderati sono stati allocati ed รจ stato assegnato un valore ai relativi membri btable (vedi vol7d_var_class::vol7d_var), se i descrittori non sono stati allocati o assegnati, il metodo non fa niente.
Definizione alla linea 1506 del file vol7d_class.F90. 1507 ENDDO
1508 ENDIF
1509
1510 IF (ASSOCIATED(this%dativarattr%c)) THEN
1511 DO i = 1, SIZE(this%dativar%c)
1512 this%dativar%c(i)%c = &
1513 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
1514 ENDDO
1515 ENDIF
1516ENDIF
1517
1518END SUBROUTINE vol7d_set_attr_ind
1519
1520
1525SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
1526 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
1527TYPE(vol7d),INTENT(INOUT) :: this
1528TYPE(vol7d),INTENT(INOUT) :: that
1529LOGICAL,INTENT(IN),OPTIONAL :: sort
1530LOGICAL,INTENT(in),OPTIONAL :: bestdata
1531LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
1532
1533TYPE(vol7d) :: v7d_clean
1534
1535
1536IF (.NOT.c_e(this)) THEN ! speedup
1537 this = that
1538 CALL init(v7d_clean)
1539 that = v7d_clean ! destroy that without deallocating
1540ELSE ! Append that to this and destroy that
1541 CALL vol7d_append(this, that, sort, bestdata, &
1542 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
1543 CALL delete(that)
1544ENDIF
1545
1546END SUBROUTINE vol7d_merge
1547
1548
1577SUBROUTINE vol7d_append(this, that, sort, bestdata, &
1578 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
1579TYPE(vol7d),INTENT(INOUT) :: this
1580TYPE(vol7d),INTENT(IN) :: that
1581LOGICAL,INTENT(IN),OPTIONAL :: sort
1582! experimental, please do not use outside the library now, they force the use
1583! of a simplified mapping algorithm which is valid only whene the dimension
1584! content is the same in both volumes , or when one of them is empty
1585LOGICAL,INTENT(in),OPTIONAL :: bestdata
1586LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
1587
1588
1589TYPE(vol7d) :: v7dtmp
1590LOGICAL :: lsort, lbestdata
1591INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
1592 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
1593
1594IF (.NOT.c_e(that)) RETURN ! speedup, nothing to do
1595IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
1596IF (.NOT.c_e(this)) THEN ! this case is like a vol7d_copy, more efficient to copy?
1597 CALL vol7d_copy(that, this, sort=sort)
1598 RETURN
1599ENDIF
1600
1601IF (this%time_definition /= that%time_definition) THEN
1602 CALL l4f_log(l4f_fatal, &
1603 'in vol7d_append, cannot append volumes with different &
1604 &time definition')
1605 CALL raise_fatal_error()
1606ENDIF
1607
1608! Completo l'allocazione per avere volumi a norma
1609CALL vol7d_alloc_vol(this)
1610
1611CALL init(v7dtmp, time_definition=this%time_definition)
1612CALL optio(sort, lsort)
1613CALL optio(bestdata, lbestdata)
1614
1615! Calcolo le mappature tra volumi vecchi e volume nuovo
1616! I puntatori remap* vengono tutti o allocati o nullificati
1617IF (optio_log(ltimesimple)) THEN
1618 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
1619 lsort, remapt1, remapt2)
1620ELSE
1621 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
1622 lsort, remapt1, remapt2)
1623ENDIF
1624IF (optio_log(ltimerangesimple)) THEN
1625 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
1626 v7dtmp%timerange, lsort, remaptr1, remaptr2)
1627ELSE
1628 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
1629 v7dtmp%timerange, lsort, remaptr1, remaptr2)
1630ENDIF
1631IF (optio_log(llevelsimple)) THEN
1632 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
1633 lsort, remapl1, remapl2)
1634ELSE
1635 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
1636 lsort, remapl1, remapl2)
1637ENDIF
1638IF (optio_log(lanasimple)) THEN
1639 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
1640 .false., remapa1, remapa2)
1641ELSE
1642 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
1643 .false., remapa1, remapa2)
1644ENDIF
1645IF (optio_log(lnetworksimple)) THEN
1646 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
1647 .false., remapn1, remapn2)
1648ELSE
1649 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
1650 .false., remapn1, remapn2)
1651ENDIF
1652
1653! Faccio la fusione fisica dei volumi
1654CALL vol7d_merge_finalr(this, that, v7dtmp, &
1655 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1656 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1657CALL vol7d_merge_finald(this, that, v7dtmp, &
1658 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1659 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1660CALL vol7d_merge_finali(this, that, v7dtmp, &
1661 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1662 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1663CALL vol7d_merge_finalb(this, that, v7dtmp, &
1664 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1665 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1666CALL vol7d_merge_finalc(this, that, v7dtmp, &
1667 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
1668 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
1669
1670! Dealloco i vettori di rimappatura
1671IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
1672IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
1673IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
1674IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
1675IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
1676IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
1677IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
1678IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
1679IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
1680IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
1681
1682! Distruggo il vecchio volume e assegno il nuovo a this
1683CALL delete(this)
1684this = v7dtmp
1685! Ricreo gli indici var-attr
1686CALL vol7d_set_attr_ind(this)
1687
1688END SUBROUTINE vol7d_append
1689
1690
|