libsim Versione 7.2.1
|
◆ pack_distinct_i()
compatta gli elementi distinti di vect in un array Definizione alla linea 1120 del file array_utilities.F90. 1122! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1123! authors:
1124! Davide Cesari <dcesari@arpa.emr.it>
1125! Paolo Patruno <ppatruno@arpa.emr.it>
1126
1127! This program is free software; you can redistribute it and/or
1128! modify it under the terms of the GNU General Public License as
1129! published by the Free Software Foundation; either version 2 of
1130! the License, or (at your option) any later version.
1131
1132! This program is distributed in the hope that it will be useful,
1133! but WITHOUT ANY WARRANTY; without even the implied warranty of
1134! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1135! GNU General Public License for more details.
1136
1137! You should have received a copy of the GNU General Public License
1138! along with this program. If not, see <http://www.gnu.org/licenses/>.
1139
1140
1141
1144#include "config.h"
1146
1147IMPLICIT NONE
1148
1149! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1150!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1151
1152#undef VOL7D_POLY_TYPE_AUTO
1153
1154#undef VOL7D_POLY_TYPE
1155#undef VOL7D_POLY_TYPES
1156#define VOL7D_POLY_TYPE INTEGER
1157#define VOL7D_POLY_TYPES _i
1158#define ENABLE_SORT
1159#include "array_utilities_pre.F90"
1160#undef ENABLE_SORT
1161
1162#undef VOL7D_POLY_TYPE
1163#undef VOL7D_POLY_TYPES
1164#define VOL7D_POLY_TYPE REAL
1165#define VOL7D_POLY_TYPES _r
1166#define ENABLE_SORT
1167#include "array_utilities_pre.F90"
1168#undef ENABLE_SORT
1169
1170#undef VOL7D_POLY_TYPE
1171#undef VOL7D_POLY_TYPES
1172#define VOL7D_POLY_TYPE DOUBLEPRECISION
1173#define VOL7D_POLY_TYPES _d
1174#define ENABLE_SORT
1175#include "array_utilities_pre.F90"
1176#undef ENABLE_SORT
1177
1178#define VOL7D_NO_PACK
1179#undef VOL7D_POLY_TYPE
1180#undef VOL7D_POLY_TYPES
1181#define VOL7D_POLY_TYPE CHARACTER(len=*)
1182#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1183#define VOL7D_POLY_TYPES _c
1184#define ENABLE_SORT
1185#include "array_utilities_pre.F90"
1186#undef VOL7D_POLY_TYPE_AUTO
1187#undef ENABLE_SORT
1188
1189
1190#define ARRAYOF_ORIGEQ 1
1191
1192#define ARRAYOF_ORIGTYPE INTEGER
1193#define ARRAYOF_TYPE arrayof_integer
1194#include "arrayof_pre.F90"
1195
1196#undef ARRAYOF_ORIGTYPE
1197#undef ARRAYOF_TYPE
1198#define ARRAYOF_ORIGTYPE REAL
1199#define ARRAYOF_TYPE arrayof_real
1200#include "arrayof_pre.F90"
1201
1202#undef ARRAYOF_ORIGTYPE
1203#undef ARRAYOF_TYPE
1204#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1205#define ARRAYOF_TYPE arrayof_doubleprecision
1206#include "arrayof_pre.F90"
1207
1208#undef ARRAYOF_ORIGEQ
1209
1210#undef ARRAYOF_ORIGTYPE
1211#undef ARRAYOF_TYPE
1212#define ARRAYOF_ORIGTYPE LOGICAL
1213#define ARRAYOF_TYPE arrayof_logical
1214#include "arrayof_pre.F90"
1215
1216PRIVATE
1217! from arrayof
1219PUBLIC insert_unique, append_unique
1220
1222 count_distinct_sorted, pack_distinct_sorted, &
1223 count_distinct, pack_distinct, count_and_pack_distinct, &
1224 map_distinct, map_inv_distinct, &
1225 firsttrue, lasttrue, pack_distinct_c, map
1226
1227CONTAINS
1228
1229
1232FUNCTION firsttrue(v) RESULT(i)
1233LOGICAL,INTENT(in) :: v(:)
1234INTEGER :: i
1235
1236DO i = 1, SIZE(v)
1237 IF (v(i)) RETURN
1238ENDDO
1239i = 0
1240
1241END FUNCTION firsttrue
1242
1243
1246FUNCTION lasttrue(v) RESULT(i)
1247LOGICAL,INTENT(in) :: v(:)
1248INTEGER :: i
1249
1250DO i = SIZE(v), 1, -1
1251 IF (v(i)) RETURN
1252ENDDO
1253
1254END FUNCTION lasttrue
1255
1256
1257! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1258#undef VOL7D_POLY_TYPE_AUTO
1259#undef VOL7D_NO_PACK
1260
1261#undef VOL7D_POLY_TYPE
1262#undef VOL7D_POLY_TYPES
1263#define VOL7D_POLY_TYPE INTEGER
1264#define VOL7D_POLY_TYPES _i
1265#define ENABLE_SORT
1266#include "array_utilities_inc.F90"
1267#undef ENABLE_SORT
1268
1269#undef VOL7D_POLY_TYPE
1270#undef VOL7D_POLY_TYPES
1271#define VOL7D_POLY_TYPE REAL
1272#define VOL7D_POLY_TYPES _r
1273#define ENABLE_SORT
1274#include "array_utilities_inc.F90"
1275#undef ENABLE_SORT
1276
1277#undef VOL7D_POLY_TYPE
1278#undef VOL7D_POLY_TYPES
1279#define VOL7D_POLY_TYPE DOUBLEPRECISION
1280#define VOL7D_POLY_TYPES _d
1281#define ENABLE_SORT
1282#include "array_utilities_inc.F90"
1283#undef ENABLE_SORT
1284
1285#define VOL7D_NO_PACK
1286#undef VOL7D_POLY_TYPE
1287#undef VOL7D_POLY_TYPES
1288#define VOL7D_POLY_TYPE CHARACTER(len=*)
1289#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1290#define VOL7D_POLY_TYPES _c
1291#define ENABLE_SORT
1292#include "array_utilities_inc.F90"
1293#undef VOL7D_POLY_TYPE_AUTO
1294#undef ENABLE_SORT
1295
1296SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1297CHARACTER(len=*),INTENT(in) :: vect(:)
1298LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1299CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1300
1301INTEGER :: count_distinct
1302INTEGER :: i, j, dim
1303LOGICAL :: lback
1304
1305dim = SIZE(pack_distinct)
1306IF (PRESENT(back)) THEN
1307 lback = back
1308ELSE
1309 lback = .false.
1310ENDIF
1311count_distinct = 0
1312
1313IF (PRESENT (mask)) THEN
1314 IF (lback) THEN
1315 vectm1: DO i = 1, SIZE(vect)
1316 IF (.NOT.mask(i)) cycle vectm1
1317! DO j = i-1, 1, -1
1318! IF (vect(j) == vect(i)) CYCLE vectm1
1319 DO j = count_distinct, 1, -1
1320 IF (pack_distinct(j) == vect(i)) cycle vectm1
1321 ENDDO
1322 count_distinct = count_distinct + 1
1323 IF (count_distinct > dim) EXIT
1324 pack_distinct(count_distinct) = vect(i)
1325 ENDDO vectm1
1326 ELSE
1327 vectm2: DO i = 1, SIZE(vect)
1328 IF (.NOT.mask(i)) cycle vectm2
1329! DO j = 1, i-1
1330! IF (vect(j) == vect(i)) CYCLE vectm2
1331 DO j = 1, count_distinct
1332 IF (pack_distinct(j) == vect(i)) cycle vectm2
1333 ENDDO
1334 count_distinct = count_distinct + 1
1335 IF (count_distinct > dim) EXIT
1336 pack_distinct(count_distinct) = vect(i)
1337 ENDDO vectm2
1338 ENDIF
1339ELSE
1340 IF (lback) THEN
1341 vect1: DO i = 1, SIZE(vect)
1342! DO j = i-1, 1, -1
1343! IF (vect(j) == vect(i)) CYCLE vect1
1344 DO j = count_distinct, 1, -1
1345 IF (pack_distinct(j) == vect(i)) cycle vect1
1346 ENDDO
1347 count_distinct = count_distinct + 1
1348 IF (count_distinct > dim) EXIT
1349 pack_distinct(count_distinct) = vect(i)
1350 ENDDO vect1
1351 ELSE
1352 vect2: DO i = 1, SIZE(vect)
1353! DO j = 1, i-1
1354! IF (vect(j) == vect(i)) CYCLE vect2
1355 DO j = 1, count_distinct
1356 IF (pack_distinct(j) == vect(i)) cycle vect2
1357 ENDDO
1358 count_distinct = count_distinct + 1
1359 IF (count_distinct > dim) EXIT
1360 pack_distinct(count_distinct) = vect(i)
1361 ENDDO vect2
1362 ENDIF
1363ENDIF
1364
1365END SUBROUTINE pack_distinct_c
1366
1368FUNCTION map(mask) RESULT(mapidx)
1369LOGICAL,INTENT(in) :: mask(:)
1370INTEGER :: mapidx(count(mask))
1371
1372INTEGER :: i,j
1373
1374j = 0
1375DO i=1, SIZE(mask)
1376 j = j + 1
1377 IF (mask(i)) mapidx(j)=i
1378ENDDO
1379
1380END FUNCTION map
1381
1382#define ARRAYOF_ORIGEQ 1
1383
1384#undef ARRAYOF_ORIGTYPE
1385#undef ARRAYOF_TYPE
1386#define ARRAYOF_ORIGTYPE INTEGER
1387#define ARRAYOF_TYPE arrayof_integer
1388#include "arrayof_post.F90"
1389
1390#undef ARRAYOF_ORIGTYPE
1391#undef ARRAYOF_TYPE
1392#define ARRAYOF_ORIGTYPE REAL
1393#define ARRAYOF_TYPE arrayof_real
1394#include "arrayof_post.F90"
1395
1396#undef ARRAYOF_ORIGTYPE
1397#undef ARRAYOF_TYPE
1398#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1399#define ARRAYOF_TYPE arrayof_doubleprecision
1400#include "arrayof_post.F90"
1401
1402#undef ARRAYOF_ORIGEQ
1403
1404#undef ARRAYOF_ORIGTYPE
1405#undef ARRAYOF_TYPE
1406#define ARRAYOF_ORIGTYPE LOGICAL
1407#define ARRAYOF_TYPE arrayof_logical
1408#include "arrayof_post.F90"
1409
Quick method to append an element to the array. Definition: array_utilities.F90:508 Destructor for finalizing an array object. Definition: array_utilities.F90:521 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:499 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:531 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:514 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:212 |