libsim Versione 7.2.1

◆ vdi()

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

Data validity check for confidence.

Parametri
[in]flagconfidenza

Definizione alla linea 872 del file modqc.F90.

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