libsim Versione 7.1.11

◆ vdgei()

elemental logical function vdgei ( integer, intent(in)  flag)
private

Data gross error check.

Parametri
[in]flagconfidenza

Definizione alla linea 892 del file modqc.F90.

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