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