libsim Versione 7.2.1

◆ invalidatedb()

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

Data invalidated check.

Parametri
[in]flagattributo di invalidazione del dato

Definizione alla linea 1085 del file modqc.F90.

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