libsim Versione 7.2.0

◆ vdgei()

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

Data gross error check.

Parametri
[in]flagconfidenza

Definizione alla linea 886 del file modqc.F90.

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