libsim Versione 7.2.1

◆ vdc()

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

Data validity check for confidence.

Parametri
[in]flagconfidenza

Definizione alla linea 1236 del file modqc.F90.

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