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