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