libsim Versione 7.1.11

◆ index_sorted_i()

recursive integer function index_sorted_i ( integer, dimension(:), intent(in)  vect,
integer, intent(in)  search 
)
private

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

Definizione alla linea 1534 del file array_utilities.F90.

1536! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1537! authors:
1538! Davide Cesari <dcesari@arpa.emr.it>
1539! Paolo Patruno <ppatruno@arpa.emr.it>
1540
1541! This program is free software; you can redistribute it and/or
1542! modify it under the terms of the GNU General Public License as
1543! published by the Free Software Foundation; either version 2 of
1544! the License, or (at your option) any later version.
1545
1546! This program is distributed in the hope that it will be useful,
1547! but WITHOUT ANY WARRANTY; without even the implied warranty of
1548! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1549! GNU General Public License for more details.
1550
1551! You should have received a copy of the GNU General Public License
1552! along with this program. If not, see <http://www.gnu.org/licenses/>.
1553
1554
1555
1558#include "config.h"
1559MODULE array_utilities
1560
1561IMPLICIT NONE
1562
1563! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1564!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1565
1566#undef VOL7D_POLY_TYPE_AUTO
1567
1568#undef VOL7D_POLY_TYPE
1569#undef VOL7D_POLY_TYPES
1570#define VOL7D_POLY_TYPE INTEGER
1571#define VOL7D_POLY_TYPES _i
1572#define ENABLE_SORT
1573#include "array_utilities_pre.F90"
1574#undef ENABLE_SORT
1575
1576#undef VOL7D_POLY_TYPE
1577#undef VOL7D_POLY_TYPES
1578#define VOL7D_POLY_TYPE REAL
1579#define VOL7D_POLY_TYPES _r
1580#define ENABLE_SORT
1581#include "array_utilities_pre.F90"
1582#undef ENABLE_SORT
1583
1584#undef VOL7D_POLY_TYPE
1585#undef VOL7D_POLY_TYPES
1586#define VOL7D_POLY_TYPE DOUBLEPRECISION
1587#define VOL7D_POLY_TYPES _d
1588#define ENABLE_SORT
1589#include "array_utilities_pre.F90"
1590#undef ENABLE_SORT
1591
1592#define VOL7D_NO_PACK
1593#undef VOL7D_POLY_TYPE
1594#undef VOL7D_POLY_TYPES
1595#define VOL7D_POLY_TYPE CHARACTER(len=*)
1596#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1597#define VOL7D_POLY_TYPES _c
1598#define ENABLE_SORT
1599#include "array_utilities_pre.F90"
1600#undef VOL7D_POLY_TYPE_AUTO
1601#undef ENABLE_SORT
1602
1603
1604#define ARRAYOF_ORIGEQ 1
1605
1606#define ARRAYOF_ORIGTYPE INTEGER
1607#define ARRAYOF_TYPE arrayof_integer
1608#include "arrayof_pre.F90"
1609
1610#undef ARRAYOF_ORIGTYPE
1611#undef ARRAYOF_TYPE
1612#define ARRAYOF_ORIGTYPE REAL
1613#define ARRAYOF_TYPE arrayof_real
1614#include "arrayof_pre.F90"
1615
1616#undef ARRAYOF_ORIGTYPE
1617#undef ARRAYOF_TYPE
1618#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1619#define ARRAYOF_TYPE arrayof_doubleprecision
1620#include "arrayof_pre.F90"
1621
1622#undef ARRAYOF_ORIGEQ
1623
1624#undef ARRAYOF_ORIGTYPE
1625#undef ARRAYOF_TYPE
1626#define ARRAYOF_ORIGTYPE LOGICAL
1627#define ARRAYOF_TYPE arrayof_logical
1628#include "arrayof_pre.F90"
1629
1630PRIVATE
1631! from arrayof
1633PUBLIC insert_unique, append_unique
1634
1635PUBLIC sort, index, index_c, &
1636 count_distinct_sorted, pack_distinct_sorted, &
1637 count_distinct, pack_distinct, count_and_pack_distinct, &
1638 map_distinct, map_inv_distinct, &
1639 firsttrue, lasttrue, pack_distinct_c, map
1640
1641CONTAINS
1642
1643
1646FUNCTION firsttrue(v) RESULT(i)
1647LOGICAL,INTENT(in) :: v(:)
1648INTEGER :: i
1649
1650DO i = 1, SIZE(v)
1651 IF (v(i)) RETURN
1652ENDDO
1653i = 0
1654
1655END FUNCTION firsttrue
1656
1657
1660FUNCTION lasttrue(v) RESULT(i)
1661LOGICAL,INTENT(in) :: v(:)
1662INTEGER :: i
1663
1664DO i = SIZE(v), 1, -1
1665 IF (v(i)) RETURN
1666ENDDO
1667
1668END FUNCTION lasttrue
1669
1670
1671! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1672#undef VOL7D_POLY_TYPE_AUTO
1673#undef VOL7D_NO_PACK
1674
1675#undef VOL7D_POLY_TYPE
1676#undef VOL7D_POLY_TYPES
1677#define VOL7D_POLY_TYPE INTEGER
1678#define VOL7D_POLY_TYPES _i
1679#define ENABLE_SORT
1680#include "array_utilities_inc.F90"
1681#undef ENABLE_SORT
1682
1683#undef VOL7D_POLY_TYPE
1684#undef VOL7D_POLY_TYPES
1685#define VOL7D_POLY_TYPE REAL
1686#define VOL7D_POLY_TYPES _r
1687#define ENABLE_SORT
1688#include "array_utilities_inc.F90"
1689#undef ENABLE_SORT
1690
1691#undef VOL7D_POLY_TYPE
1692#undef VOL7D_POLY_TYPES
1693#define VOL7D_POLY_TYPE DOUBLEPRECISION
1694#define VOL7D_POLY_TYPES _d
1695#define ENABLE_SORT
1696#include "array_utilities_inc.F90"
1697#undef ENABLE_SORT
1698
1699#define VOL7D_NO_PACK
1700#undef VOL7D_POLY_TYPE
1701#undef VOL7D_POLY_TYPES
1702#define VOL7D_POLY_TYPE CHARACTER(len=*)
1703#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1704#define VOL7D_POLY_TYPES _c
1705#define ENABLE_SORT
1706#include "array_utilities_inc.F90"
1707#undef VOL7D_POLY_TYPE_AUTO
1708#undef ENABLE_SORT
1709
1710SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1711CHARACTER(len=*),INTENT(in) :: vect(:)
1712LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1713CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1714
1715INTEGER :: count_distinct
1716INTEGER :: i, j, dim
1717LOGICAL :: lback
1718
1719dim = SIZE(pack_distinct)
1720IF (PRESENT(back)) THEN
1721 lback = back
1722ELSE
1723 lback = .false.
1724ENDIF
1725count_distinct = 0
1726
1727IF (PRESENT (mask)) THEN
1728 IF (lback) THEN
1729 vectm1: DO i = 1, SIZE(vect)
1730 IF (.NOT.mask(i)) cycle vectm1
1731! DO j = i-1, 1, -1
1732! IF (vect(j) == vect(i)) CYCLE vectm1
1733 DO j = count_distinct, 1, -1
1734 IF (pack_distinct(j) == vect(i)) cycle vectm1
1735 ENDDO
1736 count_distinct = count_distinct + 1
1737 IF (count_distinct > dim) EXIT
1738 pack_distinct(count_distinct) = vect(i)
1739 ENDDO vectm1
1740 ELSE
1741 vectm2: DO i = 1, SIZE(vect)
1742 IF (.NOT.mask(i)) cycle vectm2
1743! DO j = 1, i-1
1744! IF (vect(j) == vect(i)) CYCLE vectm2
1745 DO j = 1, count_distinct
1746 IF (pack_distinct(j) == vect(i)) cycle vectm2
1747 ENDDO
1748 count_distinct = count_distinct + 1
1749 IF (count_distinct > dim) EXIT
1750 pack_distinct(count_distinct) = vect(i)
1751 ENDDO vectm2
1752 ENDIF
1753ELSE
1754 IF (lback) THEN
1755 vect1: DO i = 1, SIZE(vect)
1756! DO j = i-1, 1, -1
1757! IF (vect(j) == vect(i)) CYCLE vect1
1758 DO j = count_distinct, 1, -1
1759 IF (pack_distinct(j) == vect(i)) cycle vect1
1760 ENDDO
1761 count_distinct = count_distinct + 1
1762 IF (count_distinct > dim) EXIT
1763 pack_distinct(count_distinct) = vect(i)
1764 ENDDO vect1
1765 ELSE
1766 vect2: DO i = 1, SIZE(vect)
1767! DO j = 1, i-1
1768! IF (vect(j) == vect(i)) CYCLE vect2
1769 DO j = 1, count_distinct
1770 IF (pack_distinct(j) == vect(i)) cycle vect2
1771 ENDDO
1772 count_distinct = count_distinct + 1
1773 IF (count_distinct > dim) EXIT
1774 pack_distinct(count_distinct) = vect(i)
1775 ENDDO vect2
1776 ENDIF
1777ENDIF
1778
1779END SUBROUTINE pack_distinct_c
1780
1782FUNCTION map(mask) RESULT(mapidx)
1783LOGICAL,INTENT(in) :: mask(:)
1784INTEGER :: mapidx(count(mask))
1785
1786INTEGER :: i,j
1787
1788j = 0
1789DO i=1, SIZE(mask)
1790 j = j + 1
1791 IF (mask(i)) mapidx(j)=i
1792ENDDO
1793
1794END FUNCTION map
1795
1796#define ARRAYOF_ORIGEQ 1
1797
1798#undef ARRAYOF_ORIGTYPE
1799#undef ARRAYOF_TYPE
1800#define ARRAYOF_ORIGTYPE INTEGER
1801#define ARRAYOF_TYPE arrayof_integer
1802#include "arrayof_post.F90"
1803
1804#undef ARRAYOF_ORIGTYPE
1805#undef ARRAYOF_TYPE
1806#define ARRAYOF_ORIGTYPE REAL
1807#define ARRAYOF_TYPE arrayof_real
1808#include "arrayof_post.F90"
1809
1810#undef ARRAYOF_ORIGTYPE
1811#undef ARRAYOF_TYPE
1812#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1813#define ARRAYOF_TYPE arrayof_doubleprecision
1814#include "arrayof_post.F90"
1815
1816#undef ARRAYOF_ORIGEQ
1817
1818#undef ARRAYOF_ORIGTYPE
1819#undef ARRAYOF_TYPE
1820#define ARRAYOF_ORIGTYPE LOGICAL
1821#define ARRAYOF_TYPE arrayof_logical
1822#include "arrayof_post.F90"
1823
1824END 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.