libsim Versione 7.2.1

◆ index_i()

integer function index_i ( integer, dimension(:), intent(in) vect,
integer, intent(in) search,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back,
integer, intent(in), optional cache )

Cerca l'indice del primo o ultimo elemento di vect uguale a search.

Definizione alla linea 1451 del file array_utilities.F90.

1453! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1454! authors:
1455! Davide Cesari <dcesari@arpa.emr.it>
1456! Paolo Patruno <ppatruno@arpa.emr.it>
1457
1458! This program is free software; you can redistribute it and/or
1459! modify it under the terms of the GNU General Public License as
1460! published by the Free Software Foundation; either version 2 of
1461! the License, or (at your option) any later version.
1462
1463! This program is distributed in the hope that it will be useful,
1464! but WITHOUT ANY WARRANTY; without even the implied warranty of
1465! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1466! GNU General Public License for more details.
1467
1468! You should have received a copy of the GNU General Public License
1469! along with this program. If not, see <http://www.gnu.org/licenses/>.
1470
1471
1472
1475#include "config.h"
1476MODULE array_utilities
1477
1478IMPLICIT NONE
1479
1480! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1481!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1482
1483#undef VOL7D_POLY_TYPE_AUTO
1484
1485#undef VOL7D_POLY_TYPE
1486#undef VOL7D_POLY_TYPES
1487#define VOL7D_POLY_TYPE INTEGER
1488#define VOL7D_POLY_TYPES _i
1489#define ENABLE_SORT
1490#include "array_utilities_pre.F90"
1491#undef ENABLE_SORT
1492
1493#undef VOL7D_POLY_TYPE
1494#undef VOL7D_POLY_TYPES
1495#define VOL7D_POLY_TYPE REAL
1496#define VOL7D_POLY_TYPES _r
1497#define ENABLE_SORT
1498#include "array_utilities_pre.F90"
1499#undef ENABLE_SORT
1500
1501#undef VOL7D_POLY_TYPE
1502#undef VOL7D_POLY_TYPES
1503#define VOL7D_POLY_TYPE DOUBLEPRECISION
1504#define VOL7D_POLY_TYPES _d
1505#define ENABLE_SORT
1506#include "array_utilities_pre.F90"
1507#undef ENABLE_SORT
1508
1509#define VOL7D_NO_PACK
1510#undef VOL7D_POLY_TYPE
1511#undef VOL7D_POLY_TYPES
1512#define VOL7D_POLY_TYPE CHARACTER(len=*)
1513#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1514#define VOL7D_POLY_TYPES _c
1515#define ENABLE_SORT
1516#include "array_utilities_pre.F90"
1517#undef VOL7D_POLY_TYPE_AUTO
1518#undef ENABLE_SORT
1519
1520
1521#define ARRAYOF_ORIGEQ 1
1522
1523#define ARRAYOF_ORIGTYPE INTEGER
1524#define ARRAYOF_TYPE arrayof_integer
1525#include "arrayof_pre.F90"
1526
1527#undef ARRAYOF_ORIGTYPE
1528#undef ARRAYOF_TYPE
1529#define ARRAYOF_ORIGTYPE REAL
1530#define ARRAYOF_TYPE arrayof_real
1531#include "arrayof_pre.F90"
1532
1533#undef ARRAYOF_ORIGTYPE
1534#undef ARRAYOF_TYPE
1535#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1536#define ARRAYOF_TYPE arrayof_doubleprecision
1537#include "arrayof_pre.F90"
1538
1539#undef ARRAYOF_ORIGEQ
1540
1541#undef ARRAYOF_ORIGTYPE
1542#undef ARRAYOF_TYPE
1543#define ARRAYOF_ORIGTYPE LOGICAL
1544#define ARRAYOF_TYPE arrayof_logical
1545#include "arrayof_pre.F90"
1546
1547PRIVATE
1548! from arrayof
1550PUBLIC insert_unique, append_unique
1551
1552PUBLIC sort, index, index_c, &
1553 count_distinct_sorted, pack_distinct_sorted, &
1554 count_distinct, pack_distinct, count_and_pack_distinct, &
1555 map_distinct, map_inv_distinct, &
1556 firsttrue, lasttrue, pack_distinct_c, map
1557
1558CONTAINS
1559
1560
1563FUNCTION firsttrue(v) RESULT(i)
1564LOGICAL,INTENT(in) :: v(:)
1565INTEGER :: i
1566
1567DO i = 1, SIZE(v)
1568 IF (v(i)) RETURN
1569ENDDO
1570i = 0
1571
1572END FUNCTION firsttrue
1573
1574
1577FUNCTION lasttrue(v) RESULT(i)
1578LOGICAL,INTENT(in) :: v(:)
1579INTEGER :: i
1580
1581DO i = SIZE(v), 1, -1
1582 IF (v(i)) RETURN
1583ENDDO
1584
1585END FUNCTION lasttrue
1586
1587
1588! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1589#undef VOL7D_POLY_TYPE_AUTO
1590#undef VOL7D_NO_PACK
1591
1592#undef VOL7D_POLY_TYPE
1593#undef VOL7D_POLY_TYPES
1594#define VOL7D_POLY_TYPE INTEGER
1595#define VOL7D_POLY_TYPES _i
1596#define ENABLE_SORT
1597#include "array_utilities_inc.F90"
1598#undef ENABLE_SORT
1599
1600#undef VOL7D_POLY_TYPE
1601#undef VOL7D_POLY_TYPES
1602#define VOL7D_POLY_TYPE REAL
1603#define VOL7D_POLY_TYPES _r
1604#define ENABLE_SORT
1605#include "array_utilities_inc.F90"
1606#undef ENABLE_SORT
1607
1608#undef VOL7D_POLY_TYPE
1609#undef VOL7D_POLY_TYPES
1610#define VOL7D_POLY_TYPE DOUBLEPRECISION
1611#define VOL7D_POLY_TYPES _d
1612#define ENABLE_SORT
1613#include "array_utilities_inc.F90"
1614#undef ENABLE_SORT
1615
1616#define VOL7D_NO_PACK
1617#undef VOL7D_POLY_TYPE
1618#undef VOL7D_POLY_TYPES
1619#define VOL7D_POLY_TYPE CHARACTER(len=*)
1620#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1621#define VOL7D_POLY_TYPES _c
1622#define ENABLE_SORT
1623#include "array_utilities_inc.F90"
1624#undef VOL7D_POLY_TYPE_AUTO
1625#undef ENABLE_SORT
1626
1627SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1628CHARACTER(len=*),INTENT(in) :: vect(:)
1629LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1630CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1631
1632INTEGER :: count_distinct
1633INTEGER :: i, j, dim
1634LOGICAL :: lback
1635
1636dim = SIZE(pack_distinct)
1637IF (PRESENT(back)) THEN
1638 lback = back
1639ELSE
1640 lback = .false.
1641ENDIF
1642count_distinct = 0
1643
1644IF (PRESENT (mask)) THEN
1645 IF (lback) THEN
1646 vectm1: DO i = 1, SIZE(vect)
1647 IF (.NOT.mask(i)) cycle vectm1
1648! DO j = i-1, 1, -1
1649! IF (vect(j) == vect(i)) CYCLE vectm1
1650 DO j = count_distinct, 1, -1
1651 IF (pack_distinct(j) == vect(i)) cycle vectm1
1652 ENDDO
1653 count_distinct = count_distinct + 1
1654 IF (count_distinct > dim) EXIT
1655 pack_distinct(count_distinct) = vect(i)
1656 ENDDO vectm1
1657 ELSE
1658 vectm2: DO i = 1, SIZE(vect)
1659 IF (.NOT.mask(i)) cycle vectm2
1660! DO j = 1, i-1
1661! IF (vect(j) == vect(i)) CYCLE vectm2
1662 DO j = 1, count_distinct
1663 IF (pack_distinct(j) == vect(i)) cycle vectm2
1664 ENDDO
1665 count_distinct = count_distinct + 1
1666 IF (count_distinct > dim) EXIT
1667 pack_distinct(count_distinct) = vect(i)
1668 ENDDO vectm2
1669 ENDIF
1670ELSE
1671 IF (lback) THEN
1672 vect1: DO i = 1, SIZE(vect)
1673! DO j = i-1, 1, -1
1674! IF (vect(j) == vect(i)) CYCLE vect1
1675 DO j = count_distinct, 1, -1
1676 IF (pack_distinct(j) == vect(i)) cycle vect1
1677 ENDDO
1678 count_distinct = count_distinct + 1
1679 IF (count_distinct > dim) EXIT
1680 pack_distinct(count_distinct) = vect(i)
1681 ENDDO vect1
1682 ELSE
1683 vect2: DO i = 1, SIZE(vect)
1684! DO j = 1, i-1
1685! IF (vect(j) == vect(i)) CYCLE vect2
1686 DO j = 1, count_distinct
1687 IF (pack_distinct(j) == vect(i)) cycle vect2
1688 ENDDO
1689 count_distinct = count_distinct + 1
1690 IF (count_distinct > dim) EXIT
1691 pack_distinct(count_distinct) = vect(i)
1692 ENDDO vect2
1693 ENDIF
1694ENDIF
1695
1696END SUBROUTINE pack_distinct_c
1697
1699FUNCTION map(mask) RESULT(mapidx)
1700LOGICAL,INTENT(in) :: mask(:)
1701INTEGER :: mapidx(count(mask))
1702
1703INTEGER :: i,j
1704
1705j = 0
1706DO i=1, SIZE(mask)
1707 j = j + 1
1708 IF (mask(i)) mapidx(j)=i
1709ENDDO
1710
1711END FUNCTION map
1712
1713#define ARRAYOF_ORIGEQ 1
1714
1715#undef ARRAYOF_ORIGTYPE
1716#undef ARRAYOF_TYPE
1717#define ARRAYOF_ORIGTYPE INTEGER
1718#define ARRAYOF_TYPE arrayof_integer
1719#include "arrayof_post.F90"
1720
1721#undef ARRAYOF_ORIGTYPE
1722#undef ARRAYOF_TYPE
1723#define ARRAYOF_ORIGTYPE REAL
1724#define ARRAYOF_TYPE arrayof_real
1725#include "arrayof_post.F90"
1726
1727#undef ARRAYOF_ORIGTYPE
1728#undef ARRAYOF_TYPE
1729#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1730#define ARRAYOF_TYPE arrayof_doubleprecision
1731#include "arrayof_post.F90"
1732
1733#undef ARRAYOF_ORIGEQ
1734
1735#undef ARRAYOF_ORIGTYPE
1736#undef ARRAYOF_TYPE
1737#define ARRAYOF_ORIGTYPE LOGICAL
1738#define ARRAYOF_TYPE arrayof_logical
1739#include "arrayof_post.F90"
1740
1741END 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.