libsim Versione 7.1.11

◆ vdc()

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

Data validity check for confidence.

Parametri
[in]flagconfidenza

Definizione alla linea 1242 del file modqc.F90.

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

Generated with Doxygen.