libsim Versione 7.1.11

◆ vdi()

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

Data validity check for confidence.

Parametri
[in]flagconfidenza

Definizione alla linea 878 del file modqc.F90.

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