libsim Versione 7.1.11

◆ invalidatedb()

elemental logical function invalidatedb ( integer(kind=int_b), intent(in)  flag)

Data invalidated check.

Parametri
[in]flagattributo di invalidazione del dato

Definizione alla linea 1091 del file modqc.F90.

1092! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1093! authors:
1094! Davide Cesari <dcesari@arpa.emr.it>
1095! Paolo Patruno <ppatruno@arpa.emr.it>
1096
1097! This program is free software; you can redistribute it and/or
1098! modify it under the terms of the GNU General Public License as
1099! published by the Free Software Foundation; either version 2 of
1100! the License, or (at your option) any later version.
1101
1102! This program is distributed in the hope that it will be useful,
1103! but WITHOUT ANY WARRANTY; without even the implied warranty of
1104! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1105! GNU General Public License for more details.
1106
1107! You should have received a copy of the GNU General Public License
1108! along with this program. If not, see <http://www.gnu.org/licenses/>.
1109#include "config.h"
1110
1113
1260module modqc
1261use kinds
1264use vol7d_class
1265
1266
1267implicit none
1268
1269
1271type :: qcpartype
1272 integer (kind=int_b):: att
1273 integer (kind=int_b):: gross_error ! special valuer for "*B33192" when gross error check failed
1274 integer (kind=int_b):: invalidated ! special valuer for "*B33196" when manual invalidation happen
1275end type qcpartype
1276
1278type(qcpartype) :: qcpar=qcpartype(10_int_b,0_int_b,1_int_b)
1279
1280integer, parameter :: nqcattrvars=4
1281CHARACTER(len=10),parameter :: qcattrvarsbtables(nqcattrvars)=(/"*B33196","*B33192","*B33193","*B33194"/)
1282
1283type :: qcattrvars
1284 TYPE(vol7d_var) :: vars(nqcattrvars)
1285 CHARACTER(len=10) :: btables(nqcattrvars)
1286end type qcattrvars
1287
1289interface init
1290 module procedure init_qcattrvars
1291end interface
1292
1294interface peeled
1295 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
1296 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
1297 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
1298 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
1299 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
1300end interface
1301
1302
1304interface vd
1305 module procedure vdi,vdb,vdr,vdd,vdc
1306end interface
1307
1309interface vdge
1310 module procedure vdgei,vdgeb,vdger,vdged,vdgec
1311end interface
1312
1314interface invalidated
1315 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
1316end interface
1317
1318private
1319
1320public vd, vdge, init, qcattrvars_new, invalidated, peeled, vol7d_peeling
1321public qcattrvars, nqcattrvars, qcattrvarsbtables
1322public qcpar, qcpartype, qcsummaryflagb ! ,qcsummaryflagi
1323
1324contains
1325
1326
1327! peeled routines
1328#undef VOL7D_POLY_SUBTYPE
1329#undef VOL7D_POLY_SUBTYPES
1330#undef VOL7D_POLY_ISC
1331#define VOL7D_POLY_SUBTYPE REAL
1332#define VOL7D_POLY_SUBTYPES r
1333
1334#undef VOL7D_POLY_TYPE
1335#undef VOL7D_POLY_TYPES
1336#undef VOL7D_POLY_ISC
1337#undef VOL7D_POLY_TYPES_SUBTYPES
1338#define VOL7D_POLY_TYPE REAL
1339#define VOL7D_POLY_TYPES r
1340#define VOL7D_POLY_TYPES_SUBTYPES rr
1341#include "modqc_peeled_include.F90"
1342#include "modqc_peel_util_include.F90"
1343#undef VOL7D_POLY_TYPE
1344#undef VOL7D_POLY_TYPES
1345#undef VOL7D_POLY_TYPES_SUBTYPES
1346#define VOL7D_POLY_TYPE DOUBLE PRECISION
1347#define VOL7D_POLY_TYPES d
1348#define VOL7D_POLY_TYPES_SUBTYPES dr
1349#include "modqc_peeled_include.F90"
1350#include "modqc_peel_util_include.F90"
1351#undef VOL7D_POLY_TYPE
1352#undef VOL7D_POLY_TYPES
1353#undef VOL7D_POLY_TYPES_SUBTYPES
1354#define VOL7D_POLY_TYPE INTEGER
1355#define VOL7D_POLY_TYPES i
1356#define VOL7D_POLY_TYPES_SUBTYPES ir
1357#include "modqc_peeled_include.F90"
1358#include "modqc_peel_util_include.F90"
1359#undef VOL7D_POLY_TYPE
1360#undef VOL7D_POLY_TYPES
1361#undef VOL7D_POLY_TYPES_SUBTYPES
1362#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1363#define VOL7D_POLY_TYPES b
1364#define VOL7D_POLY_TYPES_SUBTYPES br
1365#include "modqc_peeled_include.F90"
1366#include "modqc_peel_util_include.F90"
1367#undef VOL7D_POLY_TYPE
1368#undef VOL7D_POLY_TYPES
1369#undef VOL7D_POLY_TYPES_SUBTYPES
1370#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1371#define VOL7D_POLY_TYPES c
1372#define VOL7D_POLY_ISC = 1
1373#define VOL7D_POLY_TYPES_SUBTYPES cr
1374#include "modqc_peeled_include.F90"
1375#include "modqc_peel_util_include.F90"
1376
1377
1378#undef VOL7D_POLY_SUBTYPE
1379#undef VOL7D_POLY_SUBTYPES
1380#undef VOL7D_POLY_ISC
1381#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1382#define VOL7D_POLY_SUBTYPES d
1383
1384#undef VOL7D_POLY_TYPE
1385#undef VOL7D_POLY_TYPES
1386#undef VOL7D_POLY_TYPES_SUBTYPES
1387#define VOL7D_POLY_TYPE REAL
1388#define VOL7D_POLY_TYPES r
1389#define VOL7D_POLY_TYPES_SUBTYPES rd
1390#include "modqc_peeled_include.F90"
1391#undef VOL7D_POLY_TYPE
1392#undef VOL7D_POLY_TYPES
1393#undef VOL7D_POLY_TYPES_SUBTYPES
1394#define VOL7D_POLY_TYPE DOUBLE PRECISION
1395#define VOL7D_POLY_TYPES d
1396#define VOL7D_POLY_TYPES_SUBTYPES dd
1397#include "modqc_peeled_include.F90"
1398#undef VOL7D_POLY_TYPE
1399#undef VOL7D_POLY_TYPES
1400#undef VOL7D_POLY_TYPES_SUBTYPES
1401#define VOL7D_POLY_TYPE INTEGER
1402#define VOL7D_POLY_TYPES i
1403#define VOL7D_POLY_TYPES_SUBTYPES id
1404#include "modqc_peeled_include.F90"
1405#undef VOL7D_POLY_TYPE
1406#undef VOL7D_POLY_TYPES
1407#undef VOL7D_POLY_TYPES_SUBTYPES
1408#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1409#define VOL7D_POLY_TYPES b
1410#define VOL7D_POLY_TYPES_SUBTYPES bd
1411#include "modqc_peeled_include.F90"
1412#undef VOL7D_POLY_TYPE
1413#undef VOL7D_POLY_TYPES
1414#undef VOL7D_POLY_TYPES_SUBTYPES
1415#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1416#define VOL7D_POLY_TYPES c
1417#define VOL7D_POLY_TYPES_SUBTYPES cd
1418#include "modqc_peeled_include.F90"
1419
1420
1421#undef VOL7D_POLY_SUBTYPE
1422#undef VOL7D_POLY_SUBTYPES
1423#undef VOL7D_POLY_ISC
1424#define VOL7D_POLY_SUBTYPE INTEGER
1425#define VOL7D_POLY_SUBTYPES i
1426
1427#undef VOL7D_POLY_TYPE
1428#undef VOL7D_POLY_TYPES
1429#undef VOL7D_POLY_TYPES_SUBTYPES
1430#define VOL7D_POLY_TYPE REAL
1431#define VOL7D_POLY_TYPES r
1432#define VOL7D_POLY_TYPES_SUBTYPES ri
1433#include "modqc_peeled_include.F90"
1434#undef VOL7D_POLY_TYPE
1435#undef VOL7D_POLY_TYPES
1436#undef VOL7D_POLY_TYPES_SUBTYPES
1437#define VOL7D_POLY_TYPE DOUBLE PRECISION
1438#define VOL7D_POLY_TYPES d
1439#define VOL7D_POLY_TYPES_SUBTYPES di
1440#include "modqc_peeled_include.F90"
1441#undef VOL7D_POLY_TYPE
1442#undef VOL7D_POLY_TYPES
1443#undef VOL7D_POLY_TYPES_SUBTYPES
1444#define VOL7D_POLY_TYPE INTEGER
1445#define VOL7D_POLY_TYPES i
1446#define VOL7D_POLY_TYPES_SUBTYPES ii
1447#include "modqc_peeled_include.F90"
1448#undef VOL7D_POLY_TYPE
1449#undef VOL7D_POLY_TYPES
1450#undef VOL7D_POLY_TYPES_SUBTYPES
1451#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1452#define VOL7D_POLY_TYPES b
1453#define VOL7D_POLY_TYPES_SUBTYPES bi
1454#include "modqc_peeled_include.F90"
1455#undef VOL7D_POLY_TYPE
1456#undef VOL7D_POLY_TYPES
1457#undef VOL7D_POLY_TYPES_SUBTYPES
1458#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1459#define VOL7D_POLY_TYPES c
1460#define VOL7D_POLY_ISC = 1
1461#define VOL7D_POLY_TYPES_SUBTYPES ci
1462#include "modqc_peeled_include.F90"
1463
1464
1465#undef VOL7D_POLY_SUBTYPE
1466#undef VOL7D_POLY_SUBTYPES
1467#undef VOL7D_POLY_ISC
1468#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1469#define VOL7D_POLY_SUBTYPES b
1470
1471#undef VOL7D_POLY_TYPE
1472#undef VOL7D_POLY_TYPES
1473#undef VOL7D_POLY_TYPES_SUBTYPES
1474#define VOL7D_POLY_TYPE REAL
1475#define VOL7D_POLY_TYPES r
1476#define VOL7D_POLY_TYPES_SUBTYPES rb
1477#include "modqc_peeled_include.F90"
1478#undef VOL7D_POLY_TYPE
1479#undef VOL7D_POLY_TYPES
1480#undef VOL7D_POLY_TYPES_SUBTYPES
1481#define VOL7D_POLY_TYPE DOUBLE PRECISION
1482#define VOL7D_POLY_TYPES d
1483#define VOL7D_POLY_TYPES_SUBTYPES db
1484#include "modqc_peeled_include.F90"
1485#undef VOL7D_POLY_TYPE
1486#undef VOL7D_POLY_TYPES
1487#undef VOL7D_POLY_TYPES_SUBTYPES
1488#define VOL7D_POLY_TYPE INTEGER
1489#define VOL7D_POLY_TYPES i
1490#define VOL7D_POLY_TYPES_SUBTYPES ib
1491#include "modqc_peeled_include.F90"
1492#undef VOL7D_POLY_TYPE
1493#undef VOL7D_POLY_TYPES
1494#undef VOL7D_POLY_TYPES_SUBTYPES
1495#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1496#define VOL7D_POLY_TYPES b
1497#define VOL7D_POLY_TYPES_SUBTYPES bb
1498#include "modqc_peeled_include.F90"
1499#undef VOL7D_POLY_TYPE
1500#undef VOL7D_POLY_TYPES
1501#undef VOL7D_POLY_TYPES_SUBTYPES
1502#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1503#define VOL7D_POLY_TYPES c
1504#define VOL7D_POLY_ISC = 1
1505#define VOL7D_POLY_TYPES_SUBTYPES cb
1506#include "modqc_peeled_include.F90"
1507
1508
1509#undef VOL7D_POLY_SUBTYPE
1510#undef VOL7D_POLY_SUBTYPES
1511#undef VOL7D_POLY_ISC
1512#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1513#define VOL7D_POLY_SUBTYPES c
1514
1515#undef VOL7D_POLY_TYPE
1516#undef VOL7D_POLY_TYPES
1517#undef VOL7D_POLY_TYPES_SUBTYPES
1518#define VOL7D_POLY_TYPE REAL
1519#define VOL7D_POLY_TYPES r
1520#define VOL7D_POLY_TYPES_SUBTYPES rc
1521#include "modqc_peeled_include.F90"
1522#undef VOL7D_POLY_TYPE
1523#undef VOL7D_POLY_TYPES
1524#undef VOL7D_POLY_TYPES_SUBTYPES
1525#define VOL7D_POLY_TYPE DOUBLE PRECISION
1526#define VOL7D_POLY_TYPES d
1527#define VOL7D_POLY_TYPES_SUBTYPES dc
1528#include "modqc_peeled_include.F90"
1529#undef VOL7D_POLY_TYPE
1530#undef VOL7D_POLY_TYPES
1531#undef VOL7D_POLY_TYPES_SUBTYPES
1532#define VOL7D_POLY_TYPE INTEGER
1533#define VOL7D_POLY_TYPES i
1534#define VOL7D_POLY_TYPES_SUBTYPES ic
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 INTEGER(kind=int_b)
1540#define VOL7D_POLY_TYPES b
1541#define VOL7D_POLY_TYPES_SUBTYPES bc
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 CHARACTER(len=vol7d_cdatalen)
1547#define VOL7D_POLY_TYPES c
1548#define VOL7D_POLY_ISC = 1
1549#define VOL7D_POLY_TYPES_SUBTYPES cc
1550#include "modqc_peeled_include.F90"
1551
1552
1553subroutine init_qcattrvars(this)
1554
1555type(qcattrvars),intent(inout) :: this
1556integer :: i
1557
1558this%btables(:) =qcattrvarsbtables
1559do i =1, nqcattrvars
1560 call init(this%vars(i),this%btables(i))
1561end do
1562
1563end subroutine init_qcattrvars
1564
1565
1566type(qcattrvars) function qcattrvars_new()
1567
1568call init(qcattrvars_new)
1569
1570end function qcattrvars_new
1571
1572
1580SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
1581TYPE(vol7d),INTENT(INOUT) :: this
1582integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:)
1583CHARACTER(len=*),INTENT(in),OPTIONAL :: keep_attr(:)
1584CHARACTER(len=*),INTENT(in),OPTIONAL :: delete_attr(:)
1585logical,intent(in),optional :: preserve
1586logical,intent(in),optional :: purgeana
1587
1588integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
1589type(qcattrvars) :: attrvars
1590
1591INTEGER(kind=int_b),pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
1592INTEGER,pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
1593REAL,pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
1594DOUBLE PRECISION,pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
1595CHARACTER(len=vol7d_cdatalen),pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
1596
1597call l4f_log(l4f_info,'starting peeling')
1598
1599call init(attrvars)
1600
1601! generate code per i vari tipi di dati di v7d
1602! tramite un template e il preprocessore
1603
1604
1605#undef VOL7D_POLY_SUBTYPE
1606#undef VOL7D_POLY_SUBTYPES
1607#define VOL7D_POLY_SUBTYPE REAL
1608#define VOL7D_POLY_SUBTYPES r
1609
1610#undef VOL7D_POLY_TYPE
1611#undef VOL7D_POLY_TYPES
1612#define VOL7D_POLY_TYPE REAL
1613#define VOL7D_POLY_TYPES r
1614#include "modqc_peeling_include.F90"
1615#undef VOL7D_POLY_TYPE
1616#undef VOL7D_POLY_TYPES
1617#define VOL7D_POLY_TYPE DOUBLE PRECISION
1618#define VOL7D_POLY_TYPES d
1619#include "modqc_peeling_include.F90"
1620#undef VOL7D_POLY_TYPE
1621#undef VOL7D_POLY_TYPES
1622#define VOL7D_POLY_TYPE INTEGER
1623#define VOL7D_POLY_TYPES i
1624#include "modqc_peeling_include.F90"
1625#undef VOL7D_POLY_TYPE
1626#undef VOL7D_POLY_TYPES
1627#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1628#define VOL7D_POLY_TYPES b
1629#include "modqc_peeling_include.F90"
1630#undef VOL7D_POLY_TYPE
1631#undef VOL7D_POLY_TYPES
1632#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1633#define VOL7D_POLY_TYPES c
1634#include "modqc_peeling_include.F90"
1635
1636
1637#undef VOL7D_POLY_SUBTYPE
1638#undef VOL7D_POLY_SUBTYPES
1639#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1640#define VOL7D_POLY_SUBTYPES d
1641
1642#undef VOL7D_POLY_TYPE
1643#undef VOL7D_POLY_TYPES
1644#define VOL7D_POLY_TYPE REAL
1645#define VOL7D_POLY_TYPES r
1646#include "modqc_peeling_include.F90"
1647#undef VOL7D_POLY_TYPE
1648#undef VOL7D_POLY_TYPES
1649#define VOL7D_POLY_TYPE DOUBLE PRECISION
1650#define VOL7D_POLY_TYPES d
1651#include "modqc_peeling_include.F90"
1652#undef VOL7D_POLY_TYPE
1653#undef VOL7D_POLY_TYPES
1654#define VOL7D_POLY_TYPE INTEGER
1655#define VOL7D_POLY_TYPES i
1656#include "modqc_peeling_include.F90"
1657#undef VOL7D_POLY_TYPE
1658#undef VOL7D_POLY_TYPES
1659#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1660#define VOL7D_POLY_TYPES b
1661#include "modqc_peeling_include.F90"
1662#undef VOL7D_POLY_TYPE
1663#undef VOL7D_POLY_TYPES
1664#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1665#define VOL7D_POLY_TYPES c
1666#include "modqc_peeling_include.F90"
1667
1668
1669#undef VOL7D_POLY_SUBTYPE
1670#undef VOL7D_POLY_SUBTYPES
1671#define VOL7D_POLY_SUBTYPE INTEGER
1672#define VOL7D_POLY_SUBTYPES i
1673
1674#undef VOL7D_POLY_TYPE
1675#undef VOL7D_POLY_TYPES
1676#define VOL7D_POLY_TYPE REAL
1677#define VOL7D_POLY_TYPES r
1678#include "modqc_peeling_include.F90"
1679#undef VOL7D_POLY_TYPE
1680#undef VOL7D_POLY_TYPES
1681#define VOL7D_POLY_TYPE DOUBLE PRECISION
1682#define VOL7D_POLY_TYPES d
1683#include "modqc_peeling_include.F90"
1684#undef VOL7D_POLY_TYPE
1685#undef VOL7D_POLY_TYPES
1686#define VOL7D_POLY_TYPE INTEGER
1687#define VOL7D_POLY_TYPES i
1688#include "modqc_peeling_include.F90"
1689#undef VOL7D_POLY_TYPE
1690#undef VOL7D_POLY_TYPES
1691#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1692#define VOL7D_POLY_TYPES b
1693#include "modqc_peeling_include.F90"
1694#undef VOL7D_POLY_TYPE
1695#undef VOL7D_POLY_TYPES
1696#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1697#define VOL7D_POLY_TYPES c
1698#include "modqc_peeling_include.F90"
1699
1700
1701#undef VOL7D_POLY_SUBTYPE
1702#undef VOL7D_POLY_SUBTYPES
1703#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1704#define VOL7D_POLY_SUBTYPES b
1705
1706#undef VOL7D_POLY_TYPE
1707#undef VOL7D_POLY_TYPES
1708#define VOL7D_POLY_TYPE REAL
1709#define VOL7D_POLY_TYPES r
1710#include "modqc_peeling_include.F90"
1711#undef VOL7D_POLY_TYPE
1712#undef VOL7D_POLY_TYPES
1713#define VOL7D_POLY_TYPE DOUBLE PRECISION
1714#define VOL7D_POLY_TYPES d
1715#include "modqc_peeling_include.F90"
1716#undef VOL7D_POLY_TYPE
1717#undef VOL7D_POLY_TYPES
1718#define VOL7D_POLY_TYPE INTEGER
1719#define VOL7D_POLY_TYPES i
1720#include "modqc_peeling_include.F90"
1721#undef VOL7D_POLY_TYPE
1722#undef VOL7D_POLY_TYPES
1723#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1724#define VOL7D_POLY_TYPES b
1725#include "modqc_peeling_include.F90"
1726#undef VOL7D_POLY_TYPE
1727#undef VOL7D_POLY_TYPES
1728#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1729#define VOL7D_POLY_TYPES c
1730#include "modqc_peeling_include.F90"
1731
1732
1733
1734#undef VOL7D_POLY_SUBTYPE
1735#undef VOL7D_POLY_SUBTYPES
1736#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1737#define VOL7D_POLY_SUBTYPES c
1738
1739#undef VOL7D_POLY_TYPE
1740#undef VOL7D_POLY_TYPES
1741#define VOL7D_POLY_TYPE REAL
1742#define VOL7D_POLY_TYPES r
1743#include "modqc_peeling_include.F90"
1744#undef VOL7D_POLY_TYPE
1745#undef VOL7D_POLY_TYPES
1746#define VOL7D_POLY_TYPE DOUBLE PRECISION
1747#define VOL7D_POLY_TYPES d
1748#include "modqc_peeling_include.F90"
1749#undef VOL7D_POLY_TYPE
1750#undef VOL7D_POLY_TYPES
1751#define VOL7D_POLY_TYPE INTEGER
1752#define VOL7D_POLY_TYPES i
1753#include "modqc_peeling_include.F90"
1754#undef VOL7D_POLY_TYPE
1755#undef VOL7D_POLY_TYPES
1756#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1757#define VOL7D_POLY_TYPES b
1758#include "modqc_peeling_include.F90"
1759#undef VOL7D_POLY_TYPE
1760#undef VOL7D_POLY_TYPES
1761#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1762#define VOL7D_POLY_TYPES c
1763#include "modqc_peeling_include.F90"
1764
1765
1766
1767IF (.NOT.PRESENT(keep_attr) .AND. .NOT.PRESENT(delete_attr) .and. .not. optio_log(preserve)) THEN ! destroy all attributes
1768 IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
1769 IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
1770 IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
1771 IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
1772 IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
1773
1774 CALL delete(this%datiattr)
1775 CALL delete(this%dativarattr)
1776END IF
1777
1778IF (PRESENT(keep_attr)) THEN ! set to missing non requested attributes and reform
1779
1780 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: keep_attr passed")
1781 CALL keep_var(this%datiattr%r)
1782 CALL keep_var(this%datiattr%d)
1783 CALL keep_var(this%datiattr%i)
1784 CALL keep_var(this%datiattr%b)
1785 CALL keep_var(this%datiattr%c)
1786 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1787
1788ELSE IF (PRESENT(delete_attr)) THEN ! set to missing requested attributes and reform
1789
1790 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: delete_attr passed")
1791 CALL delete_var(this%datiattr%r)
1792 CALL delete_var(this%datiattr%d)
1793 CALL delete_var(this%datiattr%i)
1794 CALL delete_var(this%datiattr%b)
1795 CALL delete_var(this%datiattr%c)
1796 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1797
1798ELSE IF (PRESENT(purgeana)) THEN
1799
1800 CALL qc_reform(this,data_id, purgeana=purgeana)
1801
1802ENDIF
1803
1804
1805CONTAINS
1806
1807
1809subroutine qc_reform(this,data_id,miss, purgeana)
1810TYPE(vol7d),INTENT(INOUT) :: this
1811integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:)
1812logical,intent(in),optional :: miss
1813logical,intent(in),optional :: purgeana
1814
1815integer,pointer :: data_idtmp(:,:,:,:,:)
1816logical,allocatable :: llana(:)
1817integer,allocatable :: anaind(:)
1818integer :: i,j,nana
1819
1820if (optio_log(purgeana)) then
1821 allocate(llana(size(this%ana)))
1822 llana =.false.
1823 do i =1,size(this%ana)
1824 if (associated(this%voldatii)) llana(i)= llana(i) .or. any(c_e(this%voldatii(i,:,:,:,:,:)))
1825 if (associated(this%voldatir)) llana(i)= llana(i) .or. any(c_e(this%voldatir(i,:,:,:,:,:)))
1826 if (associated(this%voldatid)) llana(i)= llana(i) .or. any(c_e(this%voldatid(i,:,:,:,:,:)))
1827 if (associated(this%voldatib)) llana(i)= llana(i) .or. any(c_e(this%voldatib(i,:,:,:,:,:)))
1828 if (associated(this%voldatic)) llana(i)= llana(i) .or. any(c_e(this%voldatic(i,:,:,:,:,:)))
1829
1830#ifdef DEBUG
1831 if (.not. llana(i)) call l4f_log(l4f_debug,"remove station"//t2c(i))
1832#endif
1833
1834 end do
1835
1836 nana=count(llana)
1837
1838
1839 allocate(anaind(nana))
1840
1841 j=0
1842 do i=1,size(this%ana)
1843 if (llana(i)) then
1844 j=j+1
1845 anaind(j)=i
1846 end if
1847 end do
1848
1849
1850 if(present(data_id)) then
1851 allocate(data_idtmp(nana,size(data_id,2),size(data_id,3),size(data_id,4),size(data_id,5)))
1852 data_idtmp=data_id(anaind,:,:,:,:)
1853 if (associated(data_id))deallocate(data_id)
1854 data_id=>data_idtmp
1855 end if
1856
1857 call vol7d_reform(this,miss=miss,lana=llana)
1858
1859 deallocate(llana,anaind)
1860
1861else
1862
1863 call vol7d_reform(this,miss=miss)
1864
1865end if
1866
1867end subroutine qc_reform
1868
1869
1870SUBROUTINE keep_var(var)
1871TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1872
1873INTEGER :: i
1874
1875IF (ASSOCIATED(var)) THEN
1876 if (size(var) == 0) then
1877 var%btable = vol7d_var_miss%btable
1878 else
1879 DO i = 1, SIZE(var)
1880 IF (all(var(i)%btable /= keep_attr(:))) THEN ! n.b. ALL((//)) = .TRUE.
1881 var(i)%btable = vol7d_var_miss%btable
1882 ENDIF
1883 ENDDO
1884 end if
1885ENDIF
1886
1887END SUBROUTINE keep_var
1888
1889SUBROUTINE delete_var(var)
1890TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1891
1892INTEGER :: i
1893
1894IF (ASSOCIATED(var)) THEN
1895 if (size(var) == 0) then
1896 var%btable = vol7d_var_miss%btable
1897 else
1898 DO i = 1, SIZE(var)
1899 IF (any(var(i)%btable == delete_attr(:))) THEN ! n.b. ANY((//)) = .FALSE.
1900 var(i) = vol7d_var_miss
1901 ENDIF
1902 ENDDO
1903 end if
1904ENDIF
1905
1906END SUBROUTINE delete_var
1907
1908END SUBROUTINE vol7d_peeling
1909
1910
1911end 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.