libsim Versione 7.2.4

◆ map_inv_distinct_i()

integer function, dimension(dim) map_inv_distinct_i ( integer, dimension(:), intent(in) vect,
integer, intent(in) dim,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back )
private

map inv distinct

Definizione alla linea 1365 del file array_utilities.F90.

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

Generated with Doxygen.