libsim Versione 7.1.11

◆ vdb()

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

Data validity check for confidence.

Parametri
[in]flagconfidenza

Definizione alla linea 1063 del file modqc.F90.

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