libsim Versione 7.2.1

◆ qcsummaryflagc()

elemental logical function qcsummaryflagc ( character(len=vol7d_cdatalen), intent(in), optional flag0,
character(len=vol7d_cdatalen), intent(in), optional flag1,
character(len=vol7d_cdatalen), intent(in), optional flag2,
character(len=vol7d_cdatalen), intent(in), optional flag3 )
private

Check data validity based on multiple confidences.

Compute final decision boolean flag Quality control is complete if one of 3 conditions is verified: a) invalidated data b) gross error check failed c) tot variable less -1 Controllo di validita' del dato basato su test multipli. Per il calcolo della validita' del dato (flag booleano B33007), si prendono in considerazione 3 test; il dato risulta invalidato (flag booleano posto a false) se e solo se uno dei test risulta soddisfatto: a) il dato e' stato invalidato a mano (flag0=B33196=0) b) il dato non ha passato il gross erro check (flag1=B33192=0) c) la variabile tot risulta minore a -1 La variabile tot e' il risultato del confronto tra controllo climatologico (flag1, B33192), controllo temporale (flag2, B33193) e controllo spaziale (flag3, B33194). Ad ognuno di tali controlli e' stato attribuito un punteggio a seconda che ciascuno dei valori relativi ai flag di qualita' risulti inferiore od uguale-maggiore di 10. Nel dettaglio: se B33192 < 10 tot=-1; se B33192>=10 tot=0 se B33193 < 10 tot=-1; se B33193>=10 tot=1 se B33194 < 10 tot=-1; se B33194>=10 tot=1 Ogni dato e' controllato nei 3 flag di qualita' presenti, e viene valutata la somma risultante di tot. Se tot risulta inferiore a -1, qcsummaryflag e' posto a false ed il dato e' invalitato (B33007=0). Se tot risulta maggiore od uguale a -1 qcsummaryflag e' true ed il dato e' valido.

Definizione alla linea 1295 del file modqc.F90.

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