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