libsim Versione 7.1.11
|
◆ map_inv_distinct_i()
map inv distinct Definizione alla linea 1371 del file array_utilities.F90. 1373! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1374! authors:
1375! Davide Cesari <dcesari@arpa.emr.it>
1376! Paolo Patruno <ppatruno@arpa.emr.it>
1377
1378! This program is free software; you can redistribute it and/or
1379! modify it under the terms of the GNU General Public License as
1380! published by the Free Software Foundation; either version 2 of
1381! the License, or (at your option) any later version.
1382
1383! This program is distributed in the hope that it will be useful,
1384! but WITHOUT ANY WARRANTY; without even the implied warranty of
1385! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1386! GNU General Public License for more details.
1387
1388! You should have received a copy of the GNU General Public License
1389! along with this program. If not, see <http://www.gnu.org/licenses/>.
1390
1391
1392
1395#include "config.h"
1397
1398IMPLICIT NONE
1399
1400! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1401!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1402
1403#undef VOL7D_POLY_TYPE_AUTO
1404
1405#undef VOL7D_POLY_TYPE
1406#undef VOL7D_POLY_TYPES
1407#define VOL7D_POLY_TYPE INTEGER
1408#define VOL7D_POLY_TYPES _i
1409#define ENABLE_SORT
1410#include "array_utilities_pre.F90"
1411#undef ENABLE_SORT
1412
1413#undef VOL7D_POLY_TYPE
1414#undef VOL7D_POLY_TYPES
1415#define VOL7D_POLY_TYPE REAL
1416#define VOL7D_POLY_TYPES _r
1417#define ENABLE_SORT
1418#include "array_utilities_pre.F90"
1419#undef ENABLE_SORT
1420
1421#undef VOL7D_POLY_TYPE
1422#undef VOL7D_POLY_TYPES
1423#define VOL7D_POLY_TYPE DOUBLEPRECISION
1424#define VOL7D_POLY_TYPES _d
1425#define ENABLE_SORT
1426#include "array_utilities_pre.F90"
1427#undef ENABLE_SORT
1428
1429#define VOL7D_NO_PACK
1430#undef VOL7D_POLY_TYPE
1431#undef VOL7D_POLY_TYPES
1432#define VOL7D_POLY_TYPE CHARACTER(len=*)
1433#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1434#define VOL7D_POLY_TYPES _c
1435#define ENABLE_SORT
1436#include "array_utilities_pre.F90"
1437#undef VOL7D_POLY_TYPE_AUTO
1438#undef ENABLE_SORT
1439
1440
1441#define ARRAYOF_ORIGEQ 1
1442
1443#define ARRAYOF_ORIGTYPE INTEGER
1444#define ARRAYOF_TYPE arrayof_integer
1445#include "arrayof_pre.F90"
1446
1447#undef ARRAYOF_ORIGTYPE
1448#undef ARRAYOF_TYPE
1449#define ARRAYOF_ORIGTYPE REAL
1450#define ARRAYOF_TYPE arrayof_real
1451#include "arrayof_pre.F90"
1452
1453#undef ARRAYOF_ORIGTYPE
1454#undef ARRAYOF_TYPE
1455#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1456#define ARRAYOF_TYPE arrayof_doubleprecision
1457#include "arrayof_pre.F90"
1458
1459#undef ARRAYOF_ORIGEQ
1460
1461#undef ARRAYOF_ORIGTYPE
1462#undef ARRAYOF_TYPE
1463#define ARRAYOF_ORIGTYPE LOGICAL
1464#define ARRAYOF_TYPE arrayof_logical
1465#include "arrayof_pre.F90"
1466
1467PRIVATE
1468! from arrayof
1470PUBLIC insert_unique, append_unique
1471
1473 count_distinct_sorted, pack_distinct_sorted, &
1474 count_distinct, pack_distinct, count_and_pack_distinct, &
1475 map_distinct, map_inv_distinct, &
1476 firsttrue, lasttrue, pack_distinct_c, map
1477
1478CONTAINS
1479
1480
1483FUNCTION firsttrue(v) RESULT(i)
1484LOGICAL,INTENT(in) :: v(:)
1485INTEGER :: i
1486
1487DO i = 1, SIZE(v)
1488 IF (v(i)) RETURN
1489ENDDO
1490i = 0
1491
1492END FUNCTION firsttrue
1493
1494
1497FUNCTION lasttrue(v) RESULT(i)
1498LOGICAL,INTENT(in) :: v(:)
1499INTEGER :: i
1500
1501DO i = SIZE(v), 1, -1
1502 IF (v(i)) RETURN
1503ENDDO
1504
1505END FUNCTION lasttrue
1506
1507
1508! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1509#undef VOL7D_POLY_TYPE_AUTO
1510#undef VOL7D_NO_PACK
1511
1512#undef VOL7D_POLY_TYPE
1513#undef VOL7D_POLY_TYPES
1514#define VOL7D_POLY_TYPE INTEGER
1515#define VOL7D_POLY_TYPES _i
1516#define ENABLE_SORT
1517#include "array_utilities_inc.F90"
1518#undef ENABLE_SORT
1519
1520#undef VOL7D_POLY_TYPE
1521#undef VOL7D_POLY_TYPES
1522#define VOL7D_POLY_TYPE REAL
1523#define VOL7D_POLY_TYPES _r
1524#define ENABLE_SORT
1525#include "array_utilities_inc.F90"
1526#undef ENABLE_SORT
1527
1528#undef VOL7D_POLY_TYPE
1529#undef VOL7D_POLY_TYPES
1530#define VOL7D_POLY_TYPE DOUBLEPRECISION
1531#define VOL7D_POLY_TYPES _d
1532#define ENABLE_SORT
1533#include "array_utilities_inc.F90"
1534#undef ENABLE_SORT
1535
1536#define VOL7D_NO_PACK
1537#undef VOL7D_POLY_TYPE
1538#undef VOL7D_POLY_TYPES
1539#define VOL7D_POLY_TYPE CHARACTER(len=*)
1540#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1541#define VOL7D_POLY_TYPES _c
1542#define ENABLE_SORT
1543#include "array_utilities_inc.F90"
1544#undef VOL7D_POLY_TYPE_AUTO
1545#undef ENABLE_SORT
1546
1547SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1548CHARACTER(len=*),INTENT(in) :: vect(:)
1549LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1550CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1551
1552INTEGER :: count_distinct
1553INTEGER :: i, j, dim
1554LOGICAL :: lback
1555
1556dim = SIZE(pack_distinct)
1557IF (PRESENT(back)) THEN
1558 lback = back
1559ELSE
1560 lback = .false.
1561ENDIF
1562count_distinct = 0
1563
1564IF (PRESENT (mask)) THEN
1565 IF (lback) THEN
1566 vectm1: DO i = 1, SIZE(vect)
1567 IF (.NOT.mask(i)) cycle vectm1
1568! DO j = i-1, 1, -1
1569! IF (vect(j) == vect(i)) CYCLE vectm1
1570 DO j = count_distinct, 1, -1
1571 IF (pack_distinct(j) == vect(i)) cycle vectm1
1572 ENDDO
1573 count_distinct = count_distinct + 1
1574 IF (count_distinct > dim) EXIT
1575 pack_distinct(count_distinct) = vect(i)
1576 ENDDO vectm1
1577 ELSE
1578 vectm2: DO i = 1, SIZE(vect)
1579 IF (.NOT.mask(i)) cycle vectm2
1580! DO j = 1, i-1
1581! IF (vect(j) == vect(i)) CYCLE vectm2
1582 DO j = 1, count_distinct
1583 IF (pack_distinct(j) == vect(i)) cycle vectm2
1584 ENDDO
1585 count_distinct = count_distinct + 1
1586 IF (count_distinct > dim) EXIT
1587 pack_distinct(count_distinct) = vect(i)
1588 ENDDO vectm2
1589 ENDIF
1590ELSE
1591 IF (lback) THEN
1592 vect1: DO i = 1, SIZE(vect)
1593! DO j = i-1, 1, -1
1594! IF (vect(j) == vect(i)) CYCLE vect1
1595 DO j = count_distinct, 1, -1
1596 IF (pack_distinct(j) == vect(i)) cycle vect1
1597 ENDDO
1598 count_distinct = count_distinct + 1
1599 IF (count_distinct > dim) EXIT
1600 pack_distinct(count_distinct) = vect(i)
1601 ENDDO vect1
1602 ELSE
1603 vect2: DO i = 1, SIZE(vect)
1604! DO j = 1, i-1
1605! IF (vect(j) == vect(i)) CYCLE vect2
1606 DO j = 1, count_distinct
1607 IF (pack_distinct(j) == vect(i)) cycle vect2
1608 ENDDO
1609 count_distinct = count_distinct + 1
1610 IF (count_distinct > dim) EXIT
1611 pack_distinct(count_distinct) = vect(i)
1612 ENDDO vect2
1613 ENDIF
1614ENDIF
1615
1616END SUBROUTINE pack_distinct_c
1617
1619FUNCTION map(mask) RESULT(mapidx)
1620LOGICAL,INTENT(in) :: mask(:)
1621INTEGER :: mapidx(count(mask))
1622
1623INTEGER :: i,j
1624
1625j = 0
1626DO i=1, SIZE(mask)
1627 j = j + 1
1628 IF (mask(i)) mapidx(j)=i
1629ENDDO
1630
1631END FUNCTION map
1632
1633#define ARRAYOF_ORIGEQ 1
1634
1635#undef ARRAYOF_ORIGTYPE
1636#undef ARRAYOF_TYPE
1637#define ARRAYOF_ORIGTYPE INTEGER
1638#define ARRAYOF_TYPE arrayof_integer
1639#include "arrayof_post.F90"
1640
1641#undef ARRAYOF_ORIGTYPE
1642#undef ARRAYOF_TYPE
1643#define ARRAYOF_ORIGTYPE REAL
1644#define ARRAYOF_TYPE arrayof_real
1645#include "arrayof_post.F90"
1646
1647#undef ARRAYOF_ORIGTYPE
1648#undef ARRAYOF_TYPE
1649#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1650#define ARRAYOF_TYPE arrayof_doubleprecision
1651#include "arrayof_post.F90"
1652
1653#undef ARRAYOF_ORIGEQ
1654
1655#undef ARRAYOF_ORIGTYPE
1656#undef ARRAYOF_TYPE
1657#define ARRAYOF_ORIGTYPE LOGICAL
1658#define ARRAYOF_TYPE arrayof_logical
1659#include "arrayof_post.F90"
1660
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 |