libsim Versione 7.2.1

◆ invalidatedc()

elemental logical function invalidatedc ( character(len=vol7d_cdatalen), intent(in) flag)

Data invalidated check.

Parametri
[in]flagattributo di invalidazione del dato

Definizione alla linea 1264 del file modqc.F90.

1265! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1266! authors:
1267! Davide Cesari <dcesari@arpa.emr.it>
1268! Paolo Patruno <ppatruno@arpa.emr.it>
1269
1270! This program is free software; you can redistribute it and/or
1271! modify it under the terms of the GNU General Public License as
1272! published by the Free Software Foundation; either version 2 of
1273! the License, or (at your option) any later version.
1274
1275! This program is distributed in the hope that it will be useful,
1276! but WITHOUT ANY WARRANTY; without even the implied warranty of
1277! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1278! GNU General Public License for more details.
1279
1280! You should have received a copy of the GNU General Public License
1281! along with this program. If not, see <http://www.gnu.org/licenses/>.
1282#include "config.h"
1283
1286
1433module modqc
1434use kinds
1437use vol7d_class
1438
1439
1440implicit none
1441
1442
1444type :: qcpartype
1445 integer (kind=int_b):: att
1446 integer (kind=int_b):: gross_error ! special valuer for "*B33192" when gross error check failed
1447 integer (kind=int_b):: invalidated ! special valuer for "*B33196" when manual invalidation happen
1448end type qcpartype
1449
1451type(qcpartype) :: qcpar=qcpartype(10_int_b,0_int_b,1_int_b)
1452
1453integer, parameter :: nqcattrvars=4
1454CHARACTER(len=10),parameter :: qcattrvarsbtables(nqcattrvars)=(/"*B33196","*B33192","*B33193","*B33194"/)
1455
1456type :: qcattrvars
1457 TYPE(vol7d_var) :: vars(nqcattrvars)
1458 CHARACTER(len=10) :: btables(nqcattrvars)
1459end type qcattrvars
1460
1462interface init
1463 module procedure init_qcattrvars
1464end interface
1465
1467interface peeled
1468 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
1469 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
1470 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
1471 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
1472 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
1473end interface
1474
1475
1477interface vd
1478 module procedure vdi,vdb,vdr,vdd,vdc
1479end interface
1480
1482interface vdge
1483 module procedure vdgei,vdgeb,vdger,vdged,vdgec
1484end interface
1485
1487interface invalidated
1488 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
1489end interface
1490
1491private
1492
1493public vd, vdge, init, qcattrvars_new, invalidated, peeled, vol7d_peeling
1494public qcattrvars, nqcattrvars, qcattrvarsbtables
1495public qcpar, qcpartype, qcsummaryflagb ! ,qcsummaryflagi
1496
1497contains
1498
1499
1500! peeled routines
1501#undef VOL7D_POLY_SUBTYPE
1502#undef VOL7D_POLY_SUBTYPES
1503#undef VOL7D_POLY_ISC
1504#define VOL7D_POLY_SUBTYPE REAL
1505#define VOL7D_POLY_SUBTYPES r
1506
1507#undef VOL7D_POLY_TYPE
1508#undef VOL7D_POLY_TYPES
1509#undef VOL7D_POLY_ISC
1510#undef VOL7D_POLY_TYPES_SUBTYPES
1511#define VOL7D_POLY_TYPE REAL
1512#define VOL7D_POLY_TYPES r
1513#define VOL7D_POLY_TYPES_SUBTYPES rr
1514#include "modqc_peeled_include.F90"
1515#include "modqc_peel_util_include.F90"
1516#undef VOL7D_POLY_TYPE
1517#undef VOL7D_POLY_TYPES
1518#undef VOL7D_POLY_TYPES_SUBTYPES
1519#define VOL7D_POLY_TYPE DOUBLE PRECISION
1520#define VOL7D_POLY_TYPES d
1521#define VOL7D_POLY_TYPES_SUBTYPES dr
1522#include "modqc_peeled_include.F90"
1523#include "modqc_peel_util_include.F90"
1524#undef VOL7D_POLY_TYPE
1525#undef VOL7D_POLY_TYPES
1526#undef VOL7D_POLY_TYPES_SUBTYPES
1527#define VOL7D_POLY_TYPE INTEGER
1528#define VOL7D_POLY_TYPES i
1529#define VOL7D_POLY_TYPES_SUBTYPES ir
1530#include "modqc_peeled_include.F90"
1531#include "modqc_peel_util_include.F90"
1532#undef VOL7D_POLY_TYPE
1533#undef VOL7D_POLY_TYPES
1534#undef VOL7D_POLY_TYPES_SUBTYPES
1535#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1536#define VOL7D_POLY_TYPES b
1537#define VOL7D_POLY_TYPES_SUBTYPES br
1538#include "modqc_peeled_include.F90"
1539#include "modqc_peel_util_include.F90"
1540#undef VOL7D_POLY_TYPE
1541#undef VOL7D_POLY_TYPES
1542#undef VOL7D_POLY_TYPES_SUBTYPES
1543#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1544#define VOL7D_POLY_TYPES c
1545#define VOL7D_POLY_ISC = 1
1546#define VOL7D_POLY_TYPES_SUBTYPES cr
1547#include "modqc_peeled_include.F90"
1548#include "modqc_peel_util_include.F90"
1549
1550
1551#undef VOL7D_POLY_SUBTYPE
1552#undef VOL7D_POLY_SUBTYPES
1553#undef VOL7D_POLY_ISC
1554#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1555#define VOL7D_POLY_SUBTYPES d
1556
1557#undef VOL7D_POLY_TYPE
1558#undef VOL7D_POLY_TYPES
1559#undef VOL7D_POLY_TYPES_SUBTYPES
1560#define VOL7D_POLY_TYPE REAL
1561#define VOL7D_POLY_TYPES r
1562#define VOL7D_POLY_TYPES_SUBTYPES rd
1563#include "modqc_peeled_include.F90"
1564#undef VOL7D_POLY_TYPE
1565#undef VOL7D_POLY_TYPES
1566#undef VOL7D_POLY_TYPES_SUBTYPES
1567#define VOL7D_POLY_TYPE DOUBLE PRECISION
1568#define VOL7D_POLY_TYPES d
1569#define VOL7D_POLY_TYPES_SUBTYPES dd
1570#include "modqc_peeled_include.F90"
1571#undef VOL7D_POLY_TYPE
1572#undef VOL7D_POLY_TYPES
1573#undef VOL7D_POLY_TYPES_SUBTYPES
1574#define VOL7D_POLY_TYPE INTEGER
1575#define VOL7D_POLY_TYPES i
1576#define VOL7D_POLY_TYPES_SUBTYPES id
1577#include "modqc_peeled_include.F90"
1578#undef VOL7D_POLY_TYPE
1579#undef VOL7D_POLY_TYPES
1580#undef VOL7D_POLY_TYPES_SUBTYPES
1581#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1582#define VOL7D_POLY_TYPES b
1583#define VOL7D_POLY_TYPES_SUBTYPES bd
1584#include "modqc_peeled_include.F90"
1585#undef VOL7D_POLY_TYPE
1586#undef VOL7D_POLY_TYPES
1587#undef VOL7D_POLY_TYPES_SUBTYPES
1588#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1589#define VOL7D_POLY_TYPES c
1590#define VOL7D_POLY_TYPES_SUBTYPES cd
1591#include "modqc_peeled_include.F90"
1592
1593
1594#undef VOL7D_POLY_SUBTYPE
1595#undef VOL7D_POLY_SUBTYPES
1596#undef VOL7D_POLY_ISC
1597#define VOL7D_POLY_SUBTYPE INTEGER
1598#define VOL7D_POLY_SUBTYPES i
1599
1600#undef VOL7D_POLY_TYPE
1601#undef VOL7D_POLY_TYPES
1602#undef VOL7D_POLY_TYPES_SUBTYPES
1603#define VOL7D_POLY_TYPE REAL
1604#define VOL7D_POLY_TYPES r
1605#define VOL7D_POLY_TYPES_SUBTYPES ri
1606#include "modqc_peeled_include.F90"
1607#undef VOL7D_POLY_TYPE
1608#undef VOL7D_POLY_TYPES
1609#undef VOL7D_POLY_TYPES_SUBTYPES
1610#define VOL7D_POLY_TYPE DOUBLE PRECISION
1611#define VOL7D_POLY_TYPES d
1612#define VOL7D_POLY_TYPES_SUBTYPES di
1613#include "modqc_peeled_include.F90"
1614#undef VOL7D_POLY_TYPE
1615#undef VOL7D_POLY_TYPES
1616#undef VOL7D_POLY_TYPES_SUBTYPES
1617#define VOL7D_POLY_TYPE INTEGER
1618#define VOL7D_POLY_TYPES i
1619#define VOL7D_POLY_TYPES_SUBTYPES ii
1620#include "modqc_peeled_include.F90"
1621#undef VOL7D_POLY_TYPE
1622#undef VOL7D_POLY_TYPES
1623#undef VOL7D_POLY_TYPES_SUBTYPES
1624#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1625#define VOL7D_POLY_TYPES b
1626#define VOL7D_POLY_TYPES_SUBTYPES bi
1627#include "modqc_peeled_include.F90"
1628#undef VOL7D_POLY_TYPE
1629#undef VOL7D_POLY_TYPES
1630#undef VOL7D_POLY_TYPES_SUBTYPES
1631#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1632#define VOL7D_POLY_TYPES c
1633#define VOL7D_POLY_ISC = 1
1634#define VOL7D_POLY_TYPES_SUBTYPES ci
1635#include "modqc_peeled_include.F90"
1636
1637
1638#undef VOL7D_POLY_SUBTYPE
1639#undef VOL7D_POLY_SUBTYPES
1640#undef VOL7D_POLY_ISC
1641#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1642#define VOL7D_POLY_SUBTYPES b
1643
1644#undef VOL7D_POLY_TYPE
1645#undef VOL7D_POLY_TYPES
1646#undef VOL7D_POLY_TYPES_SUBTYPES
1647#define VOL7D_POLY_TYPE REAL
1648#define VOL7D_POLY_TYPES r
1649#define VOL7D_POLY_TYPES_SUBTYPES rb
1650#include "modqc_peeled_include.F90"
1651#undef VOL7D_POLY_TYPE
1652#undef VOL7D_POLY_TYPES
1653#undef VOL7D_POLY_TYPES_SUBTYPES
1654#define VOL7D_POLY_TYPE DOUBLE PRECISION
1655#define VOL7D_POLY_TYPES d
1656#define VOL7D_POLY_TYPES_SUBTYPES db
1657#include "modqc_peeled_include.F90"
1658#undef VOL7D_POLY_TYPE
1659#undef VOL7D_POLY_TYPES
1660#undef VOL7D_POLY_TYPES_SUBTYPES
1661#define VOL7D_POLY_TYPE INTEGER
1662#define VOL7D_POLY_TYPES i
1663#define VOL7D_POLY_TYPES_SUBTYPES ib
1664#include "modqc_peeled_include.F90"
1665#undef VOL7D_POLY_TYPE
1666#undef VOL7D_POLY_TYPES
1667#undef VOL7D_POLY_TYPES_SUBTYPES
1668#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1669#define VOL7D_POLY_TYPES b
1670#define VOL7D_POLY_TYPES_SUBTYPES bb
1671#include "modqc_peeled_include.F90"
1672#undef VOL7D_POLY_TYPE
1673#undef VOL7D_POLY_TYPES
1674#undef VOL7D_POLY_TYPES_SUBTYPES
1675#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1676#define VOL7D_POLY_TYPES c
1677#define VOL7D_POLY_ISC = 1
1678#define VOL7D_POLY_TYPES_SUBTYPES cb
1679#include "modqc_peeled_include.F90"
1680
1681
1682#undef VOL7D_POLY_SUBTYPE
1683#undef VOL7D_POLY_SUBTYPES
1684#undef VOL7D_POLY_ISC
1685#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1686#define VOL7D_POLY_SUBTYPES c
1687
1688#undef VOL7D_POLY_TYPE
1689#undef VOL7D_POLY_TYPES
1690#undef VOL7D_POLY_TYPES_SUBTYPES
1691#define VOL7D_POLY_TYPE REAL
1692#define VOL7D_POLY_TYPES r
1693#define VOL7D_POLY_TYPES_SUBTYPES rc
1694#include "modqc_peeled_include.F90"
1695#undef VOL7D_POLY_TYPE
1696#undef VOL7D_POLY_TYPES
1697#undef VOL7D_POLY_TYPES_SUBTYPES
1698#define VOL7D_POLY_TYPE DOUBLE PRECISION
1699#define VOL7D_POLY_TYPES d
1700#define VOL7D_POLY_TYPES_SUBTYPES dc
1701#include "modqc_peeled_include.F90"
1702#undef VOL7D_POLY_TYPE
1703#undef VOL7D_POLY_TYPES
1704#undef VOL7D_POLY_TYPES_SUBTYPES
1705#define VOL7D_POLY_TYPE INTEGER
1706#define VOL7D_POLY_TYPES i
1707#define VOL7D_POLY_TYPES_SUBTYPES ic
1708#include "modqc_peeled_include.F90"
1709#undef VOL7D_POLY_TYPE
1710#undef VOL7D_POLY_TYPES
1711#undef VOL7D_POLY_TYPES_SUBTYPES
1712#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1713#define VOL7D_POLY_TYPES b
1714#define VOL7D_POLY_TYPES_SUBTYPES bc
1715#include "modqc_peeled_include.F90"
1716#undef VOL7D_POLY_TYPE
1717#undef VOL7D_POLY_TYPES
1718#undef VOL7D_POLY_TYPES_SUBTYPES
1719#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1720#define VOL7D_POLY_TYPES c
1721#define VOL7D_POLY_ISC = 1
1722#define VOL7D_POLY_TYPES_SUBTYPES cc
1723#include "modqc_peeled_include.F90"
1724
1725
1726subroutine init_qcattrvars(this)
1727
1728type(qcattrvars),intent(inout) :: this
1729integer :: i
1730
1731this%btables(:) =qcattrvarsbtables
1732do i =1, nqcattrvars
1733 call init(this%vars(i),this%btables(i))
1734end do
1735
1736end subroutine init_qcattrvars
1737
1738
1739type(qcattrvars) function qcattrvars_new()
1740
1741call init(qcattrvars_new)
1742
1743end function qcattrvars_new
1744
1745
1753SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
1754TYPE(vol7d),INTENT(INOUT) :: this
1755integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:)
1756CHARACTER(len=*),INTENT(in),OPTIONAL :: keep_attr(:)
1757CHARACTER(len=*),INTENT(in),OPTIONAL :: delete_attr(:)
1758logical,intent(in),optional :: preserve
1759logical,intent(in),optional :: purgeana
1760
1761integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
1762type(qcattrvars) :: attrvars
1763
1764INTEGER(kind=int_b),pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
1765INTEGER,pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
1766REAL,pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
1767DOUBLE PRECISION,pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
1768CHARACTER(len=vol7d_cdatalen),pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
1769
1770call l4f_log(l4f_info,'starting peeling')
1771
1772call init(attrvars)
1773
1774! generate code per i vari tipi di dati di v7d
1775! tramite un template e il preprocessore
1776
1777
1778#undef VOL7D_POLY_SUBTYPE
1779#undef VOL7D_POLY_SUBTYPES
1780#define VOL7D_POLY_SUBTYPE REAL
1781#define VOL7D_POLY_SUBTYPES r
1782
1783#undef VOL7D_POLY_TYPE
1784#undef VOL7D_POLY_TYPES
1785#define VOL7D_POLY_TYPE REAL
1786#define VOL7D_POLY_TYPES r
1787#include "modqc_peeling_include.F90"
1788#undef VOL7D_POLY_TYPE
1789#undef VOL7D_POLY_TYPES
1790#define VOL7D_POLY_TYPE DOUBLE PRECISION
1791#define VOL7D_POLY_TYPES d
1792#include "modqc_peeling_include.F90"
1793#undef VOL7D_POLY_TYPE
1794#undef VOL7D_POLY_TYPES
1795#define VOL7D_POLY_TYPE INTEGER
1796#define VOL7D_POLY_TYPES i
1797#include "modqc_peeling_include.F90"
1798#undef VOL7D_POLY_TYPE
1799#undef VOL7D_POLY_TYPES
1800#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1801#define VOL7D_POLY_TYPES b
1802#include "modqc_peeling_include.F90"
1803#undef VOL7D_POLY_TYPE
1804#undef VOL7D_POLY_TYPES
1805#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1806#define VOL7D_POLY_TYPES c
1807#include "modqc_peeling_include.F90"
1808
1809
1810#undef VOL7D_POLY_SUBTYPE
1811#undef VOL7D_POLY_SUBTYPES
1812#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1813#define VOL7D_POLY_SUBTYPES d
1814
1815#undef VOL7D_POLY_TYPE
1816#undef VOL7D_POLY_TYPES
1817#define VOL7D_POLY_TYPE REAL
1818#define VOL7D_POLY_TYPES r
1819#include "modqc_peeling_include.F90"
1820#undef VOL7D_POLY_TYPE
1821#undef VOL7D_POLY_TYPES
1822#define VOL7D_POLY_TYPE DOUBLE PRECISION
1823#define VOL7D_POLY_TYPES d
1824#include "modqc_peeling_include.F90"
1825#undef VOL7D_POLY_TYPE
1826#undef VOL7D_POLY_TYPES
1827#define VOL7D_POLY_TYPE INTEGER
1828#define VOL7D_POLY_TYPES i
1829#include "modqc_peeling_include.F90"
1830#undef VOL7D_POLY_TYPE
1831#undef VOL7D_POLY_TYPES
1832#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1833#define VOL7D_POLY_TYPES b
1834#include "modqc_peeling_include.F90"
1835#undef VOL7D_POLY_TYPE
1836#undef VOL7D_POLY_TYPES
1837#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1838#define VOL7D_POLY_TYPES c
1839#include "modqc_peeling_include.F90"
1840
1841
1842#undef VOL7D_POLY_SUBTYPE
1843#undef VOL7D_POLY_SUBTYPES
1844#define VOL7D_POLY_SUBTYPE INTEGER
1845#define VOL7D_POLY_SUBTYPES i
1846
1847#undef VOL7D_POLY_TYPE
1848#undef VOL7D_POLY_TYPES
1849#define VOL7D_POLY_TYPE REAL
1850#define VOL7D_POLY_TYPES r
1851#include "modqc_peeling_include.F90"
1852#undef VOL7D_POLY_TYPE
1853#undef VOL7D_POLY_TYPES
1854#define VOL7D_POLY_TYPE DOUBLE PRECISION
1855#define VOL7D_POLY_TYPES d
1856#include "modqc_peeling_include.F90"
1857#undef VOL7D_POLY_TYPE
1858#undef VOL7D_POLY_TYPES
1859#define VOL7D_POLY_TYPE INTEGER
1860#define VOL7D_POLY_TYPES i
1861#include "modqc_peeling_include.F90"
1862#undef VOL7D_POLY_TYPE
1863#undef VOL7D_POLY_TYPES
1864#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1865#define VOL7D_POLY_TYPES b
1866#include "modqc_peeling_include.F90"
1867#undef VOL7D_POLY_TYPE
1868#undef VOL7D_POLY_TYPES
1869#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1870#define VOL7D_POLY_TYPES c
1871#include "modqc_peeling_include.F90"
1872
1873
1874#undef VOL7D_POLY_SUBTYPE
1875#undef VOL7D_POLY_SUBTYPES
1876#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1877#define VOL7D_POLY_SUBTYPES b
1878
1879#undef VOL7D_POLY_TYPE
1880#undef VOL7D_POLY_TYPES
1881#define VOL7D_POLY_TYPE REAL
1882#define VOL7D_POLY_TYPES r
1883#include "modqc_peeling_include.F90"
1884#undef VOL7D_POLY_TYPE
1885#undef VOL7D_POLY_TYPES
1886#define VOL7D_POLY_TYPE DOUBLE PRECISION
1887#define VOL7D_POLY_TYPES d
1888#include "modqc_peeling_include.F90"
1889#undef VOL7D_POLY_TYPE
1890#undef VOL7D_POLY_TYPES
1891#define VOL7D_POLY_TYPE INTEGER
1892#define VOL7D_POLY_TYPES i
1893#include "modqc_peeling_include.F90"
1894#undef VOL7D_POLY_TYPE
1895#undef VOL7D_POLY_TYPES
1896#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1897#define VOL7D_POLY_TYPES b
1898#include "modqc_peeling_include.F90"
1899#undef VOL7D_POLY_TYPE
1900#undef VOL7D_POLY_TYPES
1901#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1902#define VOL7D_POLY_TYPES c
1903#include "modqc_peeling_include.F90"
1904
1905
1906
1907#undef VOL7D_POLY_SUBTYPE
1908#undef VOL7D_POLY_SUBTYPES
1909#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1910#define VOL7D_POLY_SUBTYPES c
1911
1912#undef VOL7D_POLY_TYPE
1913#undef VOL7D_POLY_TYPES
1914#define VOL7D_POLY_TYPE REAL
1915#define VOL7D_POLY_TYPES r
1916#include "modqc_peeling_include.F90"
1917#undef VOL7D_POLY_TYPE
1918#undef VOL7D_POLY_TYPES
1919#define VOL7D_POLY_TYPE DOUBLE PRECISION
1920#define VOL7D_POLY_TYPES d
1921#include "modqc_peeling_include.F90"
1922#undef VOL7D_POLY_TYPE
1923#undef VOL7D_POLY_TYPES
1924#define VOL7D_POLY_TYPE INTEGER
1925#define VOL7D_POLY_TYPES i
1926#include "modqc_peeling_include.F90"
1927#undef VOL7D_POLY_TYPE
1928#undef VOL7D_POLY_TYPES
1929#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1930#define VOL7D_POLY_TYPES b
1931#include "modqc_peeling_include.F90"
1932#undef VOL7D_POLY_TYPE
1933#undef VOL7D_POLY_TYPES
1934#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1935#define VOL7D_POLY_TYPES c
1936#include "modqc_peeling_include.F90"
1937
1938
1939
1940IF (.NOT.PRESENT(keep_attr) .AND. .NOT.PRESENT(delete_attr) .and. .not. optio_log(preserve)) THEN ! destroy all attributes
1941 IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
1942 IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
1943 IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
1944 IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
1945 IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
1946
1947 CALL delete(this%datiattr)
1948 CALL delete(this%dativarattr)
1949END IF
1950
1951IF (PRESENT(keep_attr)) THEN ! set to missing non requested attributes and reform
1952
1953 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: keep_attr passed")
1954 CALL keep_var(this%datiattr%r)
1955 CALL keep_var(this%datiattr%d)
1956 CALL keep_var(this%datiattr%i)
1957 CALL keep_var(this%datiattr%b)
1958 CALL keep_var(this%datiattr%c)
1959 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1960
1961ELSE IF (PRESENT(delete_attr)) THEN ! set to missing requested attributes and reform
1962
1963 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: delete_attr passed")
1964 CALL delete_var(this%datiattr%r)
1965 CALL delete_var(this%datiattr%d)
1966 CALL delete_var(this%datiattr%i)
1967 CALL delete_var(this%datiattr%b)
1968 CALL delete_var(this%datiattr%c)
1969 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1970
1971ELSE IF (PRESENT(purgeana)) THEN
1972
1973 CALL qc_reform(this,data_id, purgeana=purgeana)
1974
1975ENDIF
1976
1977
1978CONTAINS
1979
1980
1982subroutine qc_reform(this,data_id,miss, purgeana)
1983TYPE(vol7d),INTENT(INOUT) :: this
1984integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:)
1985logical,intent(in),optional :: miss
1986logical,intent(in),optional :: purgeana
1987
1988integer,pointer :: data_idtmp(:,:,:,:,:)
1989logical,allocatable :: llana(:)
1990integer,allocatable :: anaind(:)
1991integer :: i,j,nana
1992
1993if (optio_log(purgeana)) then
1994 allocate(llana(size(this%ana)))
1995 llana =.false.
1996 do i =1,size(this%ana)
1997 if (associated(this%voldatii)) llana(i)= llana(i) .or. any(c_e(this%voldatii(i,:,:,:,:,:)))
1998 if (associated(this%voldatir)) llana(i)= llana(i) .or. any(c_e(this%voldatir(i,:,:,:,:,:)))
1999 if (associated(this%voldatid)) llana(i)= llana(i) .or. any(c_e(this%voldatid(i,:,:,:,:,:)))
2000 if (associated(this%voldatib)) llana(i)= llana(i) .or. any(c_e(this%voldatib(i,:,:,:,:,:)))
2001 if (associated(this%voldatic)) llana(i)= llana(i) .or. any(c_e(this%voldatic(i,:,:,:,:,:)))
2002
2003#ifdef DEBUG
2004 if (.not. llana(i)) call l4f_log(l4f_debug,"remove station"//t2c(i))
2005#endif
2006
2007 end do
2008
2009 nana=count(llana)
2010
2011
2012 allocate(anaind(nana))
2013
2014 j=0
2015 do i=1,size(this%ana)
2016 if (llana(i)) then
2017 j=j+1
2018 anaind(j)=i
2019 end if
2020 end do
2021
2022
2023 if(present(data_id)) then
2024 allocate(data_idtmp(nana,size(data_id,2),size(data_id,3),size(data_id,4),size(data_id,5)))
2025 data_idtmp=data_id(anaind,:,:,:,:)
2026 if (associated(data_id))deallocate(data_id)
2027 data_id=>data_idtmp
2028 end if
2029
2030 call vol7d_reform(this,miss=miss,lana=llana)
2031
2032 deallocate(llana,anaind)
2033
2034else
2035
2036 call vol7d_reform(this,miss=miss)
2037
2038end if
2039
2040end subroutine qc_reform
2041
2042
2043SUBROUTINE keep_var(var)
2044TYPE(vol7d_var),intent(inout),POINTER :: var(:)
2045
2046INTEGER :: i
2047
2048IF (ASSOCIATED(var)) THEN
2049 if (size(var) == 0) then
2050 var%btable = vol7d_var_miss%btable
2051 else
2052 DO i = 1, SIZE(var)
2053 IF (all(var(i)%btable /= keep_attr(:))) THEN ! n.b. ALL((//)) = .TRUE.
2054 var(i)%btable = vol7d_var_miss%btable
2055 ENDIF
2056 ENDDO
2057 end if
2058ENDIF
2059
2060END SUBROUTINE keep_var
2061
2062SUBROUTINE delete_var(var)
2063TYPE(vol7d_var),intent(inout),POINTER :: var(:)
2064
2065INTEGER :: i
2066
2067IF (ASSOCIATED(var)) THEN
2068 if (size(var) == 0) then
2069 var%btable = vol7d_var_miss%btable
2070 else
2071 DO i = 1, SIZE(var)
2072 IF (any(var(i)%btable == delete_attr(:))) THEN ! n.b. ANY((//)) = .FALSE.
2073 var(i) = vol7d_var_miss
2074 ENDIF
2075 ENDDO
2076 end if
2077ENDIF
2078
2079END SUBROUTINE delete_var
2080
2081END SUBROUTINE vol7d_peeling
2082
2083
2084end module modqc
Variables user in Quality Control.
Definition modqc.F90:386
Test di dato invalidato.
Definition modqc.F90:411
Remove data under a defined grade of confidence.
Definition modqc.F90:391
Check data validity based on single confidence.
Definition modqc.F90:401
Check data validity based on gross error check.
Definition modqc.F90:406
Definition of constants to be used for declaring variables of a desired type.
Definition kinds.F90:245
Definitions of constants and functions for working with missing values.
Utilities and defines for quality control.
Definition modqc.F90:357
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione di un volume completo di dati osservati.
Definisce il livello di attendibilità per i dati validi.
Definition modqc.F90:368

Generated with Doxygen.