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