libsim Versione 7.2.1
|
◆ map_distinct_i()
map distinct Definizione alla linea 1269 del file array_utilities.F90. 1270! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1271! authors:
1272! Davide Cesari <dcesari@arpa.emr.it>
1273! Paolo Patruno <ppatruno@arpa.emr.it>
1274
1275! This program is free software; you can redistribute it and/or
1276! modify it under the terms of the GNU General Public License as
1277! published by the Free Software Foundation; either version 2 of
1278! the License, or (at your option) any later version.
1279
1280! This program is distributed in the hope that it will be useful,
1281! but WITHOUT ANY WARRANTY; without even the implied warranty of
1282! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1283! GNU General Public License for more details.
1284
1285! You should have received a copy of the GNU General Public License
1286! along with this program. If not, see <http://www.gnu.org/licenses/>.
1287
1288
1289
1292#include "config.h"
1294
1295IMPLICIT NONE
1296
1297! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1298!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1299
1300#undef VOL7D_POLY_TYPE_AUTO
1301
1302#undef VOL7D_POLY_TYPE
1303#undef VOL7D_POLY_TYPES
1304#define VOL7D_POLY_TYPE INTEGER
1305#define VOL7D_POLY_TYPES _i
1306#define ENABLE_SORT
1307#include "array_utilities_pre.F90"
1308#undef ENABLE_SORT
1309
1310#undef VOL7D_POLY_TYPE
1311#undef VOL7D_POLY_TYPES
1312#define VOL7D_POLY_TYPE REAL
1313#define VOL7D_POLY_TYPES _r
1314#define ENABLE_SORT
1315#include "array_utilities_pre.F90"
1316#undef ENABLE_SORT
1317
1318#undef VOL7D_POLY_TYPE
1319#undef VOL7D_POLY_TYPES
1320#define VOL7D_POLY_TYPE DOUBLEPRECISION
1321#define VOL7D_POLY_TYPES _d
1322#define ENABLE_SORT
1323#include "array_utilities_pre.F90"
1324#undef ENABLE_SORT
1325
1326#define VOL7D_NO_PACK
1327#undef VOL7D_POLY_TYPE
1328#undef VOL7D_POLY_TYPES
1329#define VOL7D_POLY_TYPE CHARACTER(len=*)
1330#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1331#define VOL7D_POLY_TYPES _c
1332#define ENABLE_SORT
1333#include "array_utilities_pre.F90"
1334#undef VOL7D_POLY_TYPE_AUTO
1335#undef ENABLE_SORT
1336
1337
1338#define ARRAYOF_ORIGEQ 1
1339
1340#define ARRAYOF_ORIGTYPE INTEGER
1341#define ARRAYOF_TYPE arrayof_integer
1342#include "arrayof_pre.F90"
1343
1344#undef ARRAYOF_ORIGTYPE
1345#undef ARRAYOF_TYPE
1346#define ARRAYOF_ORIGTYPE REAL
1347#define ARRAYOF_TYPE arrayof_real
1348#include "arrayof_pre.F90"
1349
1350#undef ARRAYOF_ORIGTYPE
1351#undef ARRAYOF_TYPE
1352#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1353#define ARRAYOF_TYPE arrayof_doubleprecision
1354#include "arrayof_pre.F90"
1355
1356#undef ARRAYOF_ORIGEQ
1357
1358#undef ARRAYOF_ORIGTYPE
1359#undef ARRAYOF_TYPE
1360#define ARRAYOF_ORIGTYPE LOGICAL
1361#define ARRAYOF_TYPE arrayof_logical
1362#include "arrayof_pre.F90"
1363
1364PRIVATE
1365! from arrayof
1367PUBLIC insert_unique, append_unique
1368
1370 count_distinct_sorted, pack_distinct_sorted, &
1371 count_distinct, pack_distinct, count_and_pack_distinct, &
1372 map_distinct, map_inv_distinct, &
1373 firsttrue, lasttrue, pack_distinct_c, map
1374
1375CONTAINS
1376
1377
1380FUNCTION firsttrue(v) RESULT(i)
1381LOGICAL,INTENT(in) :: v(:)
1382INTEGER :: i
1383
1384DO i = 1, SIZE(v)
1385 IF (v(i)) RETURN
1386ENDDO
1387i = 0
1388
1389END FUNCTION firsttrue
1390
1391
1394FUNCTION lasttrue(v) RESULT(i)
1395LOGICAL,INTENT(in) :: v(:)
1396INTEGER :: i
1397
1398DO i = SIZE(v), 1, -1
1399 IF (v(i)) RETURN
1400ENDDO
1401
1402END FUNCTION lasttrue
1403
1404
1405! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1406#undef VOL7D_POLY_TYPE_AUTO
1407#undef VOL7D_NO_PACK
1408
1409#undef VOL7D_POLY_TYPE
1410#undef VOL7D_POLY_TYPES
1411#define VOL7D_POLY_TYPE INTEGER
1412#define VOL7D_POLY_TYPES _i
1413#define ENABLE_SORT
1414#include "array_utilities_inc.F90"
1415#undef ENABLE_SORT
1416
1417#undef VOL7D_POLY_TYPE
1418#undef VOL7D_POLY_TYPES
1419#define VOL7D_POLY_TYPE REAL
1420#define VOL7D_POLY_TYPES _r
1421#define ENABLE_SORT
1422#include "array_utilities_inc.F90"
1423#undef ENABLE_SORT
1424
1425#undef VOL7D_POLY_TYPE
1426#undef VOL7D_POLY_TYPES
1427#define VOL7D_POLY_TYPE DOUBLEPRECISION
1428#define VOL7D_POLY_TYPES _d
1429#define ENABLE_SORT
1430#include "array_utilities_inc.F90"
1431#undef ENABLE_SORT
1432
1433#define VOL7D_NO_PACK
1434#undef VOL7D_POLY_TYPE
1435#undef VOL7D_POLY_TYPES
1436#define VOL7D_POLY_TYPE CHARACTER(len=*)
1437#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1438#define VOL7D_POLY_TYPES _c
1439#define ENABLE_SORT
1440#include "array_utilities_inc.F90"
1441#undef VOL7D_POLY_TYPE_AUTO
1442#undef ENABLE_SORT
1443
1444SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1445CHARACTER(len=*),INTENT(in) :: vect(:)
1446LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1447CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1448
1449INTEGER :: count_distinct
1450INTEGER :: i, j, dim
1451LOGICAL :: lback
1452
1453dim = SIZE(pack_distinct)
1454IF (PRESENT(back)) THEN
1455 lback = back
1456ELSE
1457 lback = .false.
1458ENDIF
1459count_distinct = 0
1460
1461IF (PRESENT (mask)) THEN
1462 IF (lback) THEN
1463 vectm1: DO i = 1, SIZE(vect)
1464 IF (.NOT.mask(i)) cycle vectm1
1465! DO j = i-1, 1, -1
1466! IF (vect(j) == vect(i)) CYCLE vectm1
1467 DO j = count_distinct, 1, -1
1468 IF (pack_distinct(j) == vect(i)) cycle vectm1
1469 ENDDO
1470 count_distinct = count_distinct + 1
1471 IF (count_distinct > dim) EXIT
1472 pack_distinct(count_distinct) = vect(i)
1473 ENDDO vectm1
1474 ELSE
1475 vectm2: DO i = 1, SIZE(vect)
1476 IF (.NOT.mask(i)) cycle vectm2
1477! DO j = 1, i-1
1478! IF (vect(j) == vect(i)) CYCLE vectm2
1479 DO j = 1, count_distinct
1480 IF (pack_distinct(j) == vect(i)) cycle vectm2
1481 ENDDO
1482 count_distinct = count_distinct + 1
1483 IF (count_distinct > dim) EXIT
1484 pack_distinct(count_distinct) = vect(i)
1485 ENDDO vectm2
1486 ENDIF
1487ELSE
1488 IF (lback) THEN
1489 vect1: DO i = 1, SIZE(vect)
1490! DO j = i-1, 1, -1
1491! IF (vect(j) == vect(i)) CYCLE vect1
1492 DO j = count_distinct, 1, -1
1493 IF (pack_distinct(j) == vect(i)) cycle vect1
1494 ENDDO
1495 count_distinct = count_distinct + 1
1496 IF (count_distinct > dim) EXIT
1497 pack_distinct(count_distinct) = vect(i)
1498 ENDDO vect1
1499 ELSE
1500 vect2: DO i = 1, SIZE(vect)
1501! DO j = 1, i-1
1502! IF (vect(j) == vect(i)) CYCLE vect2
1503 DO j = 1, count_distinct
1504 IF (pack_distinct(j) == vect(i)) cycle vect2
1505 ENDDO
1506 count_distinct = count_distinct + 1
1507 IF (count_distinct > dim) EXIT
1508 pack_distinct(count_distinct) = vect(i)
1509 ENDDO vect2
1510 ENDIF
1511ENDIF
1512
1513END SUBROUTINE pack_distinct_c
1514
1516FUNCTION map(mask) RESULT(mapidx)
1517LOGICAL,INTENT(in) :: mask(:)
1518INTEGER :: mapidx(count(mask))
1519
1520INTEGER :: i,j
1521
1522j = 0
1523DO i=1, SIZE(mask)
1524 j = j + 1
1525 IF (mask(i)) mapidx(j)=i
1526ENDDO
1527
1528END FUNCTION map
1529
1530#define ARRAYOF_ORIGEQ 1
1531
1532#undef ARRAYOF_ORIGTYPE
1533#undef ARRAYOF_TYPE
1534#define ARRAYOF_ORIGTYPE INTEGER
1535#define ARRAYOF_TYPE arrayof_integer
1536#include "arrayof_post.F90"
1537
1538#undef ARRAYOF_ORIGTYPE
1539#undef ARRAYOF_TYPE
1540#define ARRAYOF_ORIGTYPE REAL
1541#define ARRAYOF_TYPE arrayof_real
1542#include "arrayof_post.F90"
1543
1544#undef ARRAYOF_ORIGTYPE
1545#undef ARRAYOF_TYPE
1546#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1547#define ARRAYOF_TYPE arrayof_doubleprecision
1548#include "arrayof_post.F90"
1549
1550#undef ARRAYOF_ORIGEQ
1551
1552#undef ARRAYOF_ORIGTYPE
1553#undef ARRAYOF_TYPE
1554#define ARRAYOF_ORIGTYPE LOGICAL
1555#define ARRAYOF_TYPE arrayof_logical
1556#include "arrayof_post.F90"
1557
Quick method to append an element to the array. Definition array_utilities.F90:508 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 |