libsim Versione 7.1.11

◆ invalidatedi()

elemental logical function invalidatedi ( integer, intent(in)  flag)

Data invalidated check.

Parametri
[in]flagattributo di invalidazione del dato

Definizione alla linea 906 del file modqc.F90.

907! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
908! authors:
909! Davide Cesari <dcesari@arpa.emr.it>
910! Paolo Patruno <ppatruno@arpa.emr.it>
911
912! This program is free software; you can redistribute it and/or
913! modify it under the terms of the GNU General Public License as
914! published by the Free Software Foundation; either version 2 of
915! the License, or (at your option) any later version.
916
917! This program is distributed in the hope that it will be useful,
918! but WITHOUT ANY WARRANTY; without even the implied warranty of
919! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
920! GNU General Public License for more details.
921
922! You should have received a copy of the GNU General Public License
923! along with this program. If not, see <http://www.gnu.org/licenses/>.
924#include "config.h"
925
928
1075module modqc
1076use kinds
1079use vol7d_class
1080
1081
1082implicit none
1083
1084
1086type :: qcpartype
1087 integer (kind=int_b):: att
1088 integer (kind=int_b):: gross_error ! special valuer for "*B33192" when gross error check failed
1089 integer (kind=int_b):: invalidated ! special valuer for "*B33196" when manual invalidation happen
1090end type qcpartype
1091
1093type(qcpartype) :: qcpar=qcpartype(10_int_b,0_int_b,1_int_b)
1094
1095integer, parameter :: nqcattrvars=4
1096CHARACTER(len=10),parameter :: qcattrvarsbtables(nqcattrvars)=(/"*B33196","*B33192","*B33193","*B33194"/)
1097
1098type :: qcattrvars
1099 TYPE(vol7d_var) :: vars(nqcattrvars)
1100 CHARACTER(len=10) :: btables(nqcattrvars)
1101end type qcattrvars
1102
1104interface init
1105 module procedure init_qcattrvars
1106end interface
1107
1109interface peeled
1110 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
1111 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
1112 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
1113 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
1114 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
1115end interface
1116
1117
1119interface vd
1120 module procedure vdi,vdb,vdr,vdd,vdc
1121end interface
1122
1124interface vdge
1125 module procedure vdgei,vdgeb,vdger,vdged,vdgec
1126end interface
1127
1129interface invalidated
1130 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
1131end interface
1132
1133private
1134
1135public vd, vdge, init, qcattrvars_new, invalidated, peeled, vol7d_peeling
1136public qcattrvars, nqcattrvars, qcattrvarsbtables
1137public qcpar, qcpartype, qcsummaryflagb ! ,qcsummaryflagi
1138
1139contains
1140
1141
1142! peeled routines
1143#undef VOL7D_POLY_SUBTYPE
1144#undef VOL7D_POLY_SUBTYPES
1145#undef VOL7D_POLY_ISC
1146#define VOL7D_POLY_SUBTYPE REAL
1147#define VOL7D_POLY_SUBTYPES r
1148
1149#undef VOL7D_POLY_TYPE
1150#undef VOL7D_POLY_TYPES
1151#undef VOL7D_POLY_ISC
1152#undef VOL7D_POLY_TYPES_SUBTYPES
1153#define VOL7D_POLY_TYPE REAL
1154#define VOL7D_POLY_TYPES r
1155#define VOL7D_POLY_TYPES_SUBTYPES rr
1156#include "modqc_peeled_include.F90"
1157#include "modqc_peel_util_include.F90"
1158#undef VOL7D_POLY_TYPE
1159#undef VOL7D_POLY_TYPES
1160#undef VOL7D_POLY_TYPES_SUBTYPES
1161#define VOL7D_POLY_TYPE DOUBLE PRECISION
1162#define VOL7D_POLY_TYPES d
1163#define VOL7D_POLY_TYPES_SUBTYPES dr
1164#include "modqc_peeled_include.F90"
1165#include "modqc_peel_util_include.F90"
1166#undef VOL7D_POLY_TYPE
1167#undef VOL7D_POLY_TYPES
1168#undef VOL7D_POLY_TYPES_SUBTYPES
1169#define VOL7D_POLY_TYPE INTEGER
1170#define VOL7D_POLY_TYPES i
1171#define VOL7D_POLY_TYPES_SUBTYPES ir
1172#include "modqc_peeled_include.F90"
1173#include "modqc_peel_util_include.F90"
1174#undef VOL7D_POLY_TYPE
1175#undef VOL7D_POLY_TYPES
1176#undef VOL7D_POLY_TYPES_SUBTYPES
1177#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1178#define VOL7D_POLY_TYPES b
1179#define VOL7D_POLY_TYPES_SUBTYPES br
1180#include "modqc_peeled_include.F90"
1181#include "modqc_peel_util_include.F90"
1182#undef VOL7D_POLY_TYPE
1183#undef VOL7D_POLY_TYPES
1184#undef VOL7D_POLY_TYPES_SUBTYPES
1185#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1186#define VOL7D_POLY_TYPES c
1187#define VOL7D_POLY_ISC = 1
1188#define VOL7D_POLY_TYPES_SUBTYPES cr
1189#include "modqc_peeled_include.F90"
1190#include "modqc_peel_util_include.F90"
1191
1192
1193#undef VOL7D_POLY_SUBTYPE
1194#undef VOL7D_POLY_SUBTYPES
1195#undef VOL7D_POLY_ISC
1196#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1197#define VOL7D_POLY_SUBTYPES d
1198
1199#undef VOL7D_POLY_TYPE
1200#undef VOL7D_POLY_TYPES
1201#undef VOL7D_POLY_TYPES_SUBTYPES
1202#define VOL7D_POLY_TYPE REAL
1203#define VOL7D_POLY_TYPES r
1204#define VOL7D_POLY_TYPES_SUBTYPES rd
1205#include "modqc_peeled_include.F90"
1206#undef VOL7D_POLY_TYPE
1207#undef VOL7D_POLY_TYPES
1208#undef VOL7D_POLY_TYPES_SUBTYPES
1209#define VOL7D_POLY_TYPE DOUBLE PRECISION
1210#define VOL7D_POLY_TYPES d
1211#define VOL7D_POLY_TYPES_SUBTYPES dd
1212#include "modqc_peeled_include.F90"
1213#undef VOL7D_POLY_TYPE
1214#undef VOL7D_POLY_TYPES
1215#undef VOL7D_POLY_TYPES_SUBTYPES
1216#define VOL7D_POLY_TYPE INTEGER
1217#define VOL7D_POLY_TYPES i
1218#define VOL7D_POLY_TYPES_SUBTYPES id
1219#include "modqc_peeled_include.F90"
1220#undef VOL7D_POLY_TYPE
1221#undef VOL7D_POLY_TYPES
1222#undef VOL7D_POLY_TYPES_SUBTYPES
1223#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1224#define VOL7D_POLY_TYPES b
1225#define VOL7D_POLY_TYPES_SUBTYPES bd
1226#include "modqc_peeled_include.F90"
1227#undef VOL7D_POLY_TYPE
1228#undef VOL7D_POLY_TYPES
1229#undef VOL7D_POLY_TYPES_SUBTYPES
1230#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1231#define VOL7D_POLY_TYPES c
1232#define VOL7D_POLY_TYPES_SUBTYPES cd
1233#include "modqc_peeled_include.F90"
1234
1235
1236#undef VOL7D_POLY_SUBTYPE
1237#undef VOL7D_POLY_SUBTYPES
1238#undef VOL7D_POLY_ISC
1239#define VOL7D_POLY_SUBTYPE INTEGER
1240#define VOL7D_POLY_SUBTYPES i
1241
1242#undef VOL7D_POLY_TYPE
1243#undef VOL7D_POLY_TYPES
1244#undef VOL7D_POLY_TYPES_SUBTYPES
1245#define VOL7D_POLY_TYPE REAL
1246#define VOL7D_POLY_TYPES r
1247#define VOL7D_POLY_TYPES_SUBTYPES ri
1248#include "modqc_peeled_include.F90"
1249#undef VOL7D_POLY_TYPE
1250#undef VOL7D_POLY_TYPES
1251#undef VOL7D_POLY_TYPES_SUBTYPES
1252#define VOL7D_POLY_TYPE DOUBLE PRECISION
1253#define VOL7D_POLY_TYPES d
1254#define VOL7D_POLY_TYPES_SUBTYPES di
1255#include "modqc_peeled_include.F90"
1256#undef VOL7D_POLY_TYPE
1257#undef VOL7D_POLY_TYPES
1258#undef VOL7D_POLY_TYPES_SUBTYPES
1259#define VOL7D_POLY_TYPE INTEGER
1260#define VOL7D_POLY_TYPES i
1261#define VOL7D_POLY_TYPES_SUBTYPES ii
1262#include "modqc_peeled_include.F90"
1263#undef VOL7D_POLY_TYPE
1264#undef VOL7D_POLY_TYPES
1265#undef VOL7D_POLY_TYPES_SUBTYPES
1266#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1267#define VOL7D_POLY_TYPES b
1268#define VOL7D_POLY_TYPES_SUBTYPES bi
1269#include "modqc_peeled_include.F90"
1270#undef VOL7D_POLY_TYPE
1271#undef VOL7D_POLY_TYPES
1272#undef VOL7D_POLY_TYPES_SUBTYPES
1273#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1274#define VOL7D_POLY_TYPES c
1275#define VOL7D_POLY_ISC = 1
1276#define VOL7D_POLY_TYPES_SUBTYPES ci
1277#include "modqc_peeled_include.F90"
1278
1279
1280#undef VOL7D_POLY_SUBTYPE
1281#undef VOL7D_POLY_SUBTYPES
1282#undef VOL7D_POLY_ISC
1283#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1284#define VOL7D_POLY_SUBTYPES b
1285
1286#undef VOL7D_POLY_TYPE
1287#undef VOL7D_POLY_TYPES
1288#undef VOL7D_POLY_TYPES_SUBTYPES
1289#define VOL7D_POLY_TYPE REAL
1290#define VOL7D_POLY_TYPES r
1291#define VOL7D_POLY_TYPES_SUBTYPES rb
1292#include "modqc_peeled_include.F90"
1293#undef VOL7D_POLY_TYPE
1294#undef VOL7D_POLY_TYPES
1295#undef VOL7D_POLY_TYPES_SUBTYPES
1296#define VOL7D_POLY_TYPE DOUBLE PRECISION
1297#define VOL7D_POLY_TYPES d
1298#define VOL7D_POLY_TYPES_SUBTYPES db
1299#include "modqc_peeled_include.F90"
1300#undef VOL7D_POLY_TYPE
1301#undef VOL7D_POLY_TYPES
1302#undef VOL7D_POLY_TYPES_SUBTYPES
1303#define VOL7D_POLY_TYPE INTEGER
1304#define VOL7D_POLY_TYPES i
1305#define VOL7D_POLY_TYPES_SUBTYPES ib
1306#include "modqc_peeled_include.F90"
1307#undef VOL7D_POLY_TYPE
1308#undef VOL7D_POLY_TYPES
1309#undef VOL7D_POLY_TYPES_SUBTYPES
1310#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1311#define VOL7D_POLY_TYPES b
1312#define VOL7D_POLY_TYPES_SUBTYPES bb
1313#include "modqc_peeled_include.F90"
1314#undef VOL7D_POLY_TYPE
1315#undef VOL7D_POLY_TYPES
1316#undef VOL7D_POLY_TYPES_SUBTYPES
1317#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1318#define VOL7D_POLY_TYPES c
1319#define VOL7D_POLY_ISC = 1
1320#define VOL7D_POLY_TYPES_SUBTYPES cb
1321#include "modqc_peeled_include.F90"
1322
1323
1324#undef VOL7D_POLY_SUBTYPE
1325#undef VOL7D_POLY_SUBTYPES
1326#undef VOL7D_POLY_ISC
1327#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1328#define VOL7D_POLY_SUBTYPES c
1329
1330#undef VOL7D_POLY_TYPE
1331#undef VOL7D_POLY_TYPES
1332#undef VOL7D_POLY_TYPES_SUBTYPES
1333#define VOL7D_POLY_TYPE REAL
1334#define VOL7D_POLY_TYPES r
1335#define VOL7D_POLY_TYPES_SUBTYPES rc
1336#include "modqc_peeled_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 dc
1343#include "modqc_peeled_include.F90"
1344#undef VOL7D_POLY_TYPE
1345#undef VOL7D_POLY_TYPES
1346#undef VOL7D_POLY_TYPES_SUBTYPES
1347#define VOL7D_POLY_TYPE INTEGER
1348#define VOL7D_POLY_TYPES i
1349#define VOL7D_POLY_TYPES_SUBTYPES ic
1350#include "modqc_peeled_include.F90"
1351#undef VOL7D_POLY_TYPE
1352#undef VOL7D_POLY_TYPES
1353#undef VOL7D_POLY_TYPES_SUBTYPES
1354#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1355#define VOL7D_POLY_TYPES b
1356#define VOL7D_POLY_TYPES_SUBTYPES bc
1357#include "modqc_peeled_include.F90"
1358#undef VOL7D_POLY_TYPE
1359#undef VOL7D_POLY_TYPES
1360#undef VOL7D_POLY_TYPES_SUBTYPES
1361#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1362#define VOL7D_POLY_TYPES c
1363#define VOL7D_POLY_ISC = 1
1364#define VOL7D_POLY_TYPES_SUBTYPES cc
1365#include "modqc_peeled_include.F90"
1366
1367
1368subroutine init_qcattrvars(this)
1369
1370type(qcattrvars),intent(inout) :: this
1371integer :: i
1372
1373this%btables(:) =qcattrvarsbtables
1374do i =1, nqcattrvars
1375 call init(this%vars(i),this%btables(i))
1376end do
1377
1378end subroutine init_qcattrvars
1379
1380
1381type(qcattrvars) function qcattrvars_new()
1382
1383call init(qcattrvars_new)
1384
1385end function qcattrvars_new
1386
1387
1395SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
1396TYPE(vol7d),INTENT(INOUT) :: this
1397integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:)
1398CHARACTER(len=*),INTENT(in),OPTIONAL :: keep_attr(:)
1399CHARACTER(len=*),INTENT(in),OPTIONAL :: delete_attr(:)
1400logical,intent(in),optional :: preserve
1401logical,intent(in),optional :: purgeana
1402
1403integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
1404type(qcattrvars) :: attrvars
1405
1406INTEGER(kind=int_b),pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
1407INTEGER,pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
1408REAL,pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
1409DOUBLE PRECISION,pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
1410CHARACTER(len=vol7d_cdatalen),pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
1411
1412call l4f_log(l4f_info,'starting peeling')
1413
1414call init(attrvars)
1415
1416! generate code per i vari tipi di dati di v7d
1417! tramite un template e il preprocessore
1418
1419
1420#undef VOL7D_POLY_SUBTYPE
1421#undef VOL7D_POLY_SUBTYPES
1422#define VOL7D_POLY_SUBTYPE REAL
1423#define VOL7D_POLY_SUBTYPES r
1424
1425#undef VOL7D_POLY_TYPE
1426#undef VOL7D_POLY_TYPES
1427#define VOL7D_POLY_TYPE REAL
1428#define VOL7D_POLY_TYPES r
1429#include "modqc_peeling_include.F90"
1430#undef VOL7D_POLY_TYPE
1431#undef VOL7D_POLY_TYPES
1432#define VOL7D_POLY_TYPE DOUBLE PRECISION
1433#define VOL7D_POLY_TYPES d
1434#include "modqc_peeling_include.F90"
1435#undef VOL7D_POLY_TYPE
1436#undef VOL7D_POLY_TYPES
1437#define VOL7D_POLY_TYPE INTEGER
1438#define VOL7D_POLY_TYPES i
1439#include "modqc_peeling_include.F90"
1440#undef VOL7D_POLY_TYPE
1441#undef VOL7D_POLY_TYPES
1442#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1443#define VOL7D_POLY_TYPES b
1444#include "modqc_peeling_include.F90"
1445#undef VOL7D_POLY_TYPE
1446#undef VOL7D_POLY_TYPES
1447#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1448#define VOL7D_POLY_TYPES c
1449#include "modqc_peeling_include.F90"
1450
1451
1452#undef VOL7D_POLY_SUBTYPE
1453#undef VOL7D_POLY_SUBTYPES
1454#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1455#define VOL7D_POLY_SUBTYPES d
1456
1457#undef VOL7D_POLY_TYPE
1458#undef VOL7D_POLY_TYPES
1459#define VOL7D_POLY_TYPE REAL
1460#define VOL7D_POLY_TYPES r
1461#include "modqc_peeling_include.F90"
1462#undef VOL7D_POLY_TYPE
1463#undef VOL7D_POLY_TYPES
1464#define VOL7D_POLY_TYPE DOUBLE PRECISION
1465#define VOL7D_POLY_TYPES d
1466#include "modqc_peeling_include.F90"
1467#undef VOL7D_POLY_TYPE
1468#undef VOL7D_POLY_TYPES
1469#define VOL7D_POLY_TYPE INTEGER
1470#define VOL7D_POLY_TYPES i
1471#include "modqc_peeling_include.F90"
1472#undef VOL7D_POLY_TYPE
1473#undef VOL7D_POLY_TYPES
1474#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1475#define VOL7D_POLY_TYPES b
1476#include "modqc_peeling_include.F90"
1477#undef VOL7D_POLY_TYPE
1478#undef VOL7D_POLY_TYPES
1479#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1480#define VOL7D_POLY_TYPES c
1481#include "modqc_peeling_include.F90"
1482
1483
1484#undef VOL7D_POLY_SUBTYPE
1485#undef VOL7D_POLY_SUBTYPES
1486#define VOL7D_POLY_SUBTYPE INTEGER
1487#define VOL7D_POLY_SUBTYPES i
1488
1489#undef VOL7D_POLY_TYPE
1490#undef VOL7D_POLY_TYPES
1491#define VOL7D_POLY_TYPE REAL
1492#define VOL7D_POLY_TYPES r
1493#include "modqc_peeling_include.F90"
1494#undef VOL7D_POLY_TYPE
1495#undef VOL7D_POLY_TYPES
1496#define VOL7D_POLY_TYPE DOUBLE PRECISION
1497#define VOL7D_POLY_TYPES d
1498#include "modqc_peeling_include.F90"
1499#undef VOL7D_POLY_TYPE
1500#undef VOL7D_POLY_TYPES
1501#define VOL7D_POLY_TYPE INTEGER
1502#define VOL7D_POLY_TYPES i
1503#include "modqc_peeling_include.F90"
1504#undef VOL7D_POLY_TYPE
1505#undef VOL7D_POLY_TYPES
1506#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1507#define VOL7D_POLY_TYPES b
1508#include "modqc_peeling_include.F90"
1509#undef VOL7D_POLY_TYPE
1510#undef VOL7D_POLY_TYPES
1511#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1512#define VOL7D_POLY_TYPES c
1513#include "modqc_peeling_include.F90"
1514
1515
1516#undef VOL7D_POLY_SUBTYPE
1517#undef VOL7D_POLY_SUBTYPES
1518#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1519#define VOL7D_POLY_SUBTYPES b
1520
1521#undef VOL7D_POLY_TYPE
1522#undef VOL7D_POLY_TYPES
1523#define VOL7D_POLY_TYPE REAL
1524#define VOL7D_POLY_TYPES r
1525#include "modqc_peeling_include.F90"
1526#undef VOL7D_POLY_TYPE
1527#undef VOL7D_POLY_TYPES
1528#define VOL7D_POLY_TYPE DOUBLE PRECISION
1529#define VOL7D_POLY_TYPES d
1530#include "modqc_peeling_include.F90"
1531#undef VOL7D_POLY_TYPE
1532#undef VOL7D_POLY_TYPES
1533#define VOL7D_POLY_TYPE INTEGER
1534#define VOL7D_POLY_TYPES i
1535#include "modqc_peeling_include.F90"
1536#undef VOL7D_POLY_TYPE
1537#undef VOL7D_POLY_TYPES
1538#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1539#define VOL7D_POLY_TYPES b
1540#include "modqc_peeling_include.F90"
1541#undef VOL7D_POLY_TYPE
1542#undef VOL7D_POLY_TYPES
1543#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1544#define VOL7D_POLY_TYPES c
1545#include "modqc_peeling_include.F90"
1546
1547
1548
1549#undef VOL7D_POLY_SUBTYPE
1550#undef VOL7D_POLY_SUBTYPES
1551#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1552#define VOL7D_POLY_SUBTYPES c
1553
1554#undef VOL7D_POLY_TYPE
1555#undef VOL7D_POLY_TYPES
1556#define VOL7D_POLY_TYPE REAL
1557#define VOL7D_POLY_TYPES r
1558#include "modqc_peeling_include.F90"
1559#undef VOL7D_POLY_TYPE
1560#undef VOL7D_POLY_TYPES
1561#define VOL7D_POLY_TYPE DOUBLE PRECISION
1562#define VOL7D_POLY_TYPES d
1563#include "modqc_peeling_include.F90"
1564#undef VOL7D_POLY_TYPE
1565#undef VOL7D_POLY_TYPES
1566#define VOL7D_POLY_TYPE INTEGER
1567#define VOL7D_POLY_TYPES i
1568#include "modqc_peeling_include.F90"
1569#undef VOL7D_POLY_TYPE
1570#undef VOL7D_POLY_TYPES
1571#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1572#define VOL7D_POLY_TYPES b
1573#include "modqc_peeling_include.F90"
1574#undef VOL7D_POLY_TYPE
1575#undef VOL7D_POLY_TYPES
1576#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1577#define VOL7D_POLY_TYPES c
1578#include "modqc_peeling_include.F90"
1579
1580
1581
1582IF (.NOT.PRESENT(keep_attr) .AND. .NOT.PRESENT(delete_attr) .and. .not. optio_log(preserve)) THEN ! destroy all attributes
1583 IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
1584 IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
1585 IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
1586 IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
1587 IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
1588
1589 CALL delete(this%datiattr)
1590 CALL delete(this%dativarattr)
1591END IF
1592
1593IF (PRESENT(keep_attr)) THEN ! set to missing non requested attributes and reform
1594
1595 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: keep_attr passed")
1596 CALL keep_var(this%datiattr%r)
1597 CALL keep_var(this%datiattr%d)
1598 CALL keep_var(this%datiattr%i)
1599 CALL keep_var(this%datiattr%b)
1600 CALL keep_var(this%datiattr%c)
1601 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1602
1603ELSE IF (PRESENT(delete_attr)) THEN ! set to missing requested attributes and reform
1604
1605 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: delete_attr passed")
1606 CALL delete_var(this%datiattr%r)
1607 CALL delete_var(this%datiattr%d)
1608 CALL delete_var(this%datiattr%i)
1609 CALL delete_var(this%datiattr%b)
1610 CALL delete_var(this%datiattr%c)
1611 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1612
1613ELSE IF (PRESENT(purgeana)) THEN
1614
1615 CALL qc_reform(this,data_id, purgeana=purgeana)
1616
1617ENDIF
1618
1619
1620CONTAINS
1621
1622
1624subroutine qc_reform(this,data_id,miss, purgeana)
1625TYPE(vol7d),INTENT(INOUT) :: this
1626integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:)
1627logical,intent(in),optional :: miss
1628logical,intent(in),optional :: purgeana
1629
1630integer,pointer :: data_idtmp(:,:,:,:,:)
1631logical,allocatable :: llana(:)
1632integer,allocatable :: anaind(:)
1633integer :: i,j,nana
1634
1635if (optio_log(purgeana)) then
1636 allocate(llana(size(this%ana)))
1637 llana =.false.
1638 do i =1,size(this%ana)
1639 if (associated(this%voldatii)) llana(i)= llana(i) .or. any(c_e(this%voldatii(i,:,:,:,:,:)))
1640 if (associated(this%voldatir)) llana(i)= llana(i) .or. any(c_e(this%voldatir(i,:,:,:,:,:)))
1641 if (associated(this%voldatid)) llana(i)= llana(i) .or. any(c_e(this%voldatid(i,:,:,:,:,:)))
1642 if (associated(this%voldatib)) llana(i)= llana(i) .or. any(c_e(this%voldatib(i,:,:,:,:,:)))
1643 if (associated(this%voldatic)) llana(i)= llana(i) .or. any(c_e(this%voldatic(i,:,:,:,:,:)))
1644
1645#ifdef DEBUG
1646 if (.not. llana(i)) call l4f_log(l4f_debug,"remove station"//t2c(i))
1647#endif
1648
1649 end do
1650
1651 nana=count(llana)
1652
1653
1654 allocate(anaind(nana))
1655
1656 j=0
1657 do i=1,size(this%ana)
1658 if (llana(i)) then
1659 j=j+1
1660 anaind(j)=i
1661 end if
1662 end do
1663
1664
1665 if(present(data_id)) then
1666 allocate(data_idtmp(nana,size(data_id,2),size(data_id,3),size(data_id,4),size(data_id,5)))
1667 data_idtmp=data_id(anaind,:,:,:,:)
1668 if (associated(data_id))deallocate(data_id)
1669 data_id=>data_idtmp
1670 end if
1671
1672 call vol7d_reform(this,miss=miss,lana=llana)
1673
1674 deallocate(llana,anaind)
1675
1676else
1677
1678 call vol7d_reform(this,miss=miss)
1679
1680end if
1681
1682end subroutine qc_reform
1683
1684
1685SUBROUTINE keep_var(var)
1686TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1687
1688INTEGER :: i
1689
1690IF (ASSOCIATED(var)) THEN
1691 if (size(var) == 0) then
1692 var%btable = vol7d_var_miss%btable
1693 else
1694 DO i = 1, SIZE(var)
1695 IF (all(var(i)%btable /= keep_attr(:))) THEN ! n.b. ALL((//)) = .TRUE.
1696 var(i)%btable = vol7d_var_miss%btable
1697 ENDIF
1698 ENDDO
1699 end if
1700ENDIF
1701
1702END SUBROUTINE keep_var
1703
1704SUBROUTINE delete_var(var)
1705TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1706
1707INTEGER :: i
1708
1709IF (ASSOCIATED(var)) THEN
1710 if (size(var) == 0) then
1711 var%btable = vol7d_var_miss%btable
1712 else
1713 DO i = 1, SIZE(var)
1714 IF (any(var(i)%btable == delete_attr(:))) THEN ! n.b. ANY((//)) = .FALSE.
1715 var(i) = vol7d_var_miss
1716 ENDIF
1717 ENDDO
1718 end if
1719ENDIF
1720
1721END SUBROUTINE delete_var
1722
1723END SUBROUTINE vol7d_peeling
1724
1725
1726end 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.