libsim Versione 7.1.11

◆ sort_i()

subroutine sort_i ( integer, dimension (:), intent(inout)  xdont)
private

Sorts inline into ascending order - Quicksort Quicksort chooses a "pivot" in the set, and explores the array from both ends, looking for a value > pivot with the increasing index, for a value <= pivot with the decreasing index, and swapping them when it has found one of each.

The array is then subdivided in 2 ([3]) subsets: { values <= pivot} {pivot} {values > pivot} One then call recursively the program to sort each subset. When the size of the subarray is small enough or the maximum level of recursion is gained, one uses an insertion sort that is faster for very small sets.

Parametri
[in,out]xdontvector to sort inline

Definizione alla linea 1656 del file array_utilities.F90.

1657! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1658! authors:
1659! Davide Cesari <dcesari@arpa.emr.it>
1660! Paolo Patruno <ppatruno@arpa.emr.it>
1661
1662! This program is free software; you can redistribute it and/or
1663! modify it under the terms of the GNU General Public License as
1664! published by the Free Software Foundation; either version 2 of
1665! the License, or (at your option) any later version.
1666
1667! This program is distributed in the hope that it will be useful,
1668! but WITHOUT ANY WARRANTY; without even the implied warranty of
1669! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1670! GNU General Public License for more details.
1671
1672! You should have received a copy of the GNU General Public License
1673! along with this program. If not, see <http://www.gnu.org/licenses/>.
1674
1675
1676
1679#include "config.h"
1680MODULE array_utilities
1681
1682IMPLICIT NONE
1683
1684! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1685!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1686
1687#undef VOL7D_POLY_TYPE_AUTO
1688
1689#undef VOL7D_POLY_TYPE
1690#undef VOL7D_POLY_TYPES
1691#define VOL7D_POLY_TYPE INTEGER
1692#define VOL7D_POLY_TYPES _i
1693#define ENABLE_SORT
1694#include "array_utilities_pre.F90"
1695#undef ENABLE_SORT
1696
1697#undef VOL7D_POLY_TYPE
1698#undef VOL7D_POLY_TYPES
1699#define VOL7D_POLY_TYPE REAL
1700#define VOL7D_POLY_TYPES _r
1701#define ENABLE_SORT
1702#include "array_utilities_pre.F90"
1703#undef ENABLE_SORT
1704
1705#undef VOL7D_POLY_TYPE
1706#undef VOL7D_POLY_TYPES
1707#define VOL7D_POLY_TYPE DOUBLEPRECISION
1708#define VOL7D_POLY_TYPES _d
1709#define ENABLE_SORT
1710#include "array_utilities_pre.F90"
1711#undef ENABLE_SORT
1712
1713#define VOL7D_NO_PACK
1714#undef VOL7D_POLY_TYPE
1715#undef VOL7D_POLY_TYPES
1716#define VOL7D_POLY_TYPE CHARACTER(len=*)
1717#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1718#define VOL7D_POLY_TYPES _c
1719#define ENABLE_SORT
1720#include "array_utilities_pre.F90"
1721#undef VOL7D_POLY_TYPE_AUTO
1722#undef ENABLE_SORT
1723
1724
1725#define ARRAYOF_ORIGEQ 1
1726
1727#define ARRAYOF_ORIGTYPE INTEGER
1728#define ARRAYOF_TYPE arrayof_integer
1729#include "arrayof_pre.F90"
1730
1731#undef ARRAYOF_ORIGTYPE
1732#undef ARRAYOF_TYPE
1733#define ARRAYOF_ORIGTYPE REAL
1734#define ARRAYOF_TYPE arrayof_real
1735#include "arrayof_pre.F90"
1736
1737#undef ARRAYOF_ORIGTYPE
1738#undef ARRAYOF_TYPE
1739#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1740#define ARRAYOF_TYPE arrayof_doubleprecision
1741#include "arrayof_pre.F90"
1742
1743#undef ARRAYOF_ORIGEQ
1744
1745#undef ARRAYOF_ORIGTYPE
1746#undef ARRAYOF_TYPE
1747#define ARRAYOF_ORIGTYPE LOGICAL
1748#define ARRAYOF_TYPE arrayof_logical
1749#include "arrayof_pre.F90"
1750
1751PRIVATE
1752! from arrayof
1754PUBLIC insert_unique, append_unique
1755
1756PUBLIC sort, index, index_c, &
1757 count_distinct_sorted, pack_distinct_sorted, &
1758 count_distinct, pack_distinct, count_and_pack_distinct, &
1759 map_distinct, map_inv_distinct, &
1760 firsttrue, lasttrue, pack_distinct_c, map
1761
1762CONTAINS
1763
1764
1767FUNCTION firsttrue(v) RESULT(i)
1768LOGICAL,INTENT(in) :: v(:)
1769INTEGER :: i
1770
1771DO i = 1, SIZE(v)
1772 IF (v(i)) RETURN
1773ENDDO
1774i = 0
1775
1776END FUNCTION firsttrue
1777
1778
1781FUNCTION lasttrue(v) RESULT(i)
1782LOGICAL,INTENT(in) :: v(:)
1783INTEGER :: i
1784
1785DO i = SIZE(v), 1, -1
1786 IF (v(i)) RETURN
1787ENDDO
1788
1789END FUNCTION lasttrue
1790
1791
1792! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1793#undef VOL7D_POLY_TYPE_AUTO
1794#undef VOL7D_NO_PACK
1795
1796#undef VOL7D_POLY_TYPE
1797#undef VOL7D_POLY_TYPES
1798#define VOL7D_POLY_TYPE INTEGER
1799#define VOL7D_POLY_TYPES _i
1800#define ENABLE_SORT
1801#include "array_utilities_inc.F90"
1802#undef ENABLE_SORT
1803
1804#undef VOL7D_POLY_TYPE
1805#undef VOL7D_POLY_TYPES
1806#define VOL7D_POLY_TYPE REAL
1807#define VOL7D_POLY_TYPES _r
1808#define ENABLE_SORT
1809#include "array_utilities_inc.F90"
1810#undef ENABLE_SORT
1811
1812#undef VOL7D_POLY_TYPE
1813#undef VOL7D_POLY_TYPES
1814#define VOL7D_POLY_TYPE DOUBLEPRECISION
1815#define VOL7D_POLY_TYPES _d
1816#define ENABLE_SORT
1817#include "array_utilities_inc.F90"
1818#undef ENABLE_SORT
1819
1820#define VOL7D_NO_PACK
1821#undef VOL7D_POLY_TYPE
1822#undef VOL7D_POLY_TYPES
1823#define VOL7D_POLY_TYPE CHARACTER(len=*)
1824#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1825#define VOL7D_POLY_TYPES _c
1826#define ENABLE_SORT
1827#include "array_utilities_inc.F90"
1828#undef VOL7D_POLY_TYPE_AUTO
1829#undef ENABLE_SORT
1830
1831SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1832CHARACTER(len=*),INTENT(in) :: vect(:)
1833LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1834CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1835
1836INTEGER :: count_distinct
1837INTEGER :: i, j, dim
1838LOGICAL :: lback
1839
1840dim = SIZE(pack_distinct)
1841IF (PRESENT(back)) THEN
1842 lback = back
1843ELSE
1844 lback = .false.
1845ENDIF
1846count_distinct = 0
1847
1848IF (PRESENT (mask)) THEN
1849 IF (lback) THEN
1850 vectm1: DO i = 1, SIZE(vect)
1851 IF (.NOT.mask(i)) cycle vectm1
1852! DO j = i-1, 1, -1
1853! IF (vect(j) == vect(i)) CYCLE vectm1
1854 DO j = count_distinct, 1, -1
1855 IF (pack_distinct(j) == vect(i)) cycle vectm1
1856 ENDDO
1857 count_distinct = count_distinct + 1
1858 IF (count_distinct > dim) EXIT
1859 pack_distinct(count_distinct) = vect(i)
1860 ENDDO vectm1
1861 ELSE
1862 vectm2: DO i = 1, SIZE(vect)
1863 IF (.NOT.mask(i)) cycle vectm2
1864! DO j = 1, i-1
1865! IF (vect(j) == vect(i)) CYCLE vectm2
1866 DO j = 1, count_distinct
1867 IF (pack_distinct(j) == vect(i)) cycle vectm2
1868 ENDDO
1869 count_distinct = count_distinct + 1
1870 IF (count_distinct > dim) EXIT
1871 pack_distinct(count_distinct) = vect(i)
1872 ENDDO vectm2
1873 ENDIF
1874ELSE
1875 IF (lback) THEN
1876 vect1: DO i = 1, SIZE(vect)
1877! DO j = i-1, 1, -1
1878! IF (vect(j) == vect(i)) CYCLE vect1
1879 DO j = count_distinct, 1, -1
1880 IF (pack_distinct(j) == vect(i)) cycle vect1
1881 ENDDO
1882 count_distinct = count_distinct + 1
1883 IF (count_distinct > dim) EXIT
1884 pack_distinct(count_distinct) = vect(i)
1885 ENDDO vect1
1886 ELSE
1887 vect2: DO i = 1, SIZE(vect)
1888! DO j = 1, i-1
1889! IF (vect(j) == vect(i)) CYCLE vect2
1890 DO j = 1, count_distinct
1891 IF (pack_distinct(j) == vect(i)) cycle vect2
1892 ENDDO
1893 count_distinct = count_distinct + 1
1894 IF (count_distinct > dim) EXIT
1895 pack_distinct(count_distinct) = vect(i)
1896 ENDDO vect2
1897 ENDIF
1898ENDIF
1899
1900END SUBROUTINE pack_distinct_c
1901
1903FUNCTION map(mask) RESULT(mapidx)
1904LOGICAL,INTENT(in) :: mask(:)
1905INTEGER :: mapidx(count(mask))
1906
1907INTEGER :: i,j
1908
1909j = 0
1910DO i=1, SIZE(mask)
1911 j = j + 1
1912 IF (mask(i)) mapidx(j)=i
1913ENDDO
1914
1915END FUNCTION map
1916
1917#define ARRAYOF_ORIGEQ 1
1918
1919#undef ARRAYOF_ORIGTYPE
1920#undef ARRAYOF_TYPE
1921#define ARRAYOF_ORIGTYPE INTEGER
1922#define ARRAYOF_TYPE arrayof_integer
1923#include "arrayof_post.F90"
1924
1925#undef ARRAYOF_ORIGTYPE
1926#undef ARRAYOF_TYPE
1927#define ARRAYOF_ORIGTYPE REAL
1928#define ARRAYOF_TYPE arrayof_real
1929#include "arrayof_post.F90"
1930
1931#undef ARRAYOF_ORIGTYPE
1932#undef ARRAYOF_TYPE
1933#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1934#define ARRAYOF_TYPE arrayof_doubleprecision
1935#include "arrayof_post.F90"
1936
1937#undef ARRAYOF_ORIGEQ
1938
1939#undef ARRAYOF_ORIGTYPE
1940#undef ARRAYOF_TYPE
1941#define ARRAYOF_ORIGTYPE LOGICAL
1942#define ARRAYOF_TYPE arrayof_logical
1943#include "arrayof_post.F90"
1944
1945END 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.