libsim Versione 7.1.11

◆ inssor_i()

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

Sorts into increasing order (Insertion sort) Sorts XDONT into increasing order (Insertion sort) This subroutine uses insertion sort.

It does not use any work array and is faster when XDONT is of very small size (< 20), or already almost sorted, so it is used in a final pass when the partial quicksorting has left a sequence of small subsets and that sorting is only necessary within each subset to complete the process. Michel Olagnon - Apr. 2000

Definizione alla linea 1781 del file array_utilities.F90.

1782! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1783! authors:
1784! Davide Cesari <dcesari@arpa.emr.it>
1785! Paolo Patruno <ppatruno@arpa.emr.it>
1786
1787! This program is free software; you can redistribute it and/or
1788! modify it under the terms of the GNU General Public License as
1789! published by the Free Software Foundation; either version 2 of
1790! the License, or (at your option) any later version.
1791
1792! This program is distributed in the hope that it will be useful,
1793! but WITHOUT ANY WARRANTY; without even the implied warranty of
1794! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1795! GNU General Public License for more details.
1796
1797! You should have received a copy of the GNU General Public License
1798! along with this program. If not, see <http://www.gnu.org/licenses/>.
1799
1800
1801
1804#include "config.h"
1805MODULE array_utilities
1806
1807IMPLICIT NONE
1808
1809! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1810!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1811
1812#undef VOL7D_POLY_TYPE_AUTO
1813
1814#undef VOL7D_POLY_TYPE
1815#undef VOL7D_POLY_TYPES
1816#define VOL7D_POLY_TYPE INTEGER
1817#define VOL7D_POLY_TYPES _i
1818#define ENABLE_SORT
1819#include "array_utilities_pre.F90"
1820#undef ENABLE_SORT
1821
1822#undef VOL7D_POLY_TYPE
1823#undef VOL7D_POLY_TYPES
1824#define VOL7D_POLY_TYPE REAL
1825#define VOL7D_POLY_TYPES _r
1826#define ENABLE_SORT
1827#include "array_utilities_pre.F90"
1828#undef ENABLE_SORT
1829
1830#undef VOL7D_POLY_TYPE
1831#undef VOL7D_POLY_TYPES
1832#define VOL7D_POLY_TYPE DOUBLEPRECISION
1833#define VOL7D_POLY_TYPES _d
1834#define ENABLE_SORT
1835#include "array_utilities_pre.F90"
1836#undef ENABLE_SORT
1837
1838#define VOL7D_NO_PACK
1839#undef VOL7D_POLY_TYPE
1840#undef VOL7D_POLY_TYPES
1841#define VOL7D_POLY_TYPE CHARACTER(len=*)
1842#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1843#define VOL7D_POLY_TYPES _c
1844#define ENABLE_SORT
1845#include "array_utilities_pre.F90"
1846#undef VOL7D_POLY_TYPE_AUTO
1847#undef ENABLE_SORT
1848
1849
1850#define ARRAYOF_ORIGEQ 1
1851
1852#define ARRAYOF_ORIGTYPE INTEGER
1853#define ARRAYOF_TYPE arrayof_integer
1854#include "arrayof_pre.F90"
1855
1856#undef ARRAYOF_ORIGTYPE
1857#undef ARRAYOF_TYPE
1858#define ARRAYOF_ORIGTYPE REAL
1859#define ARRAYOF_TYPE arrayof_real
1860#include "arrayof_pre.F90"
1861
1862#undef ARRAYOF_ORIGTYPE
1863#undef ARRAYOF_TYPE
1864#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1865#define ARRAYOF_TYPE arrayof_doubleprecision
1866#include "arrayof_pre.F90"
1867
1868#undef ARRAYOF_ORIGEQ
1869
1870#undef ARRAYOF_ORIGTYPE
1871#undef ARRAYOF_TYPE
1872#define ARRAYOF_ORIGTYPE LOGICAL
1873#define ARRAYOF_TYPE arrayof_logical
1874#include "arrayof_pre.F90"
1875
1876PRIVATE
1877! from arrayof
1879PUBLIC insert_unique, append_unique
1880
1881PUBLIC sort, index, index_c, &
1882 count_distinct_sorted, pack_distinct_sorted, &
1883 count_distinct, pack_distinct, count_and_pack_distinct, &
1884 map_distinct, map_inv_distinct, &
1885 firsttrue, lasttrue, pack_distinct_c, map
1886
1887CONTAINS
1888
1889
1892FUNCTION firsttrue(v) RESULT(i)
1893LOGICAL,INTENT(in) :: v(:)
1894INTEGER :: i
1895
1896DO i = 1, SIZE(v)
1897 IF (v(i)) RETURN
1898ENDDO
1899i = 0
1900
1901END FUNCTION firsttrue
1902
1903
1906FUNCTION lasttrue(v) RESULT(i)
1907LOGICAL,INTENT(in) :: v(:)
1908INTEGER :: i
1909
1910DO i = SIZE(v), 1, -1
1911 IF (v(i)) RETURN
1912ENDDO
1913
1914END FUNCTION lasttrue
1915
1916
1917! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1918#undef VOL7D_POLY_TYPE_AUTO
1919#undef VOL7D_NO_PACK
1920
1921#undef VOL7D_POLY_TYPE
1922#undef VOL7D_POLY_TYPES
1923#define VOL7D_POLY_TYPE INTEGER
1924#define VOL7D_POLY_TYPES _i
1925#define ENABLE_SORT
1926#include "array_utilities_inc.F90"
1927#undef ENABLE_SORT
1928
1929#undef VOL7D_POLY_TYPE
1930#undef VOL7D_POLY_TYPES
1931#define VOL7D_POLY_TYPE REAL
1932#define VOL7D_POLY_TYPES _r
1933#define ENABLE_SORT
1934#include "array_utilities_inc.F90"
1935#undef ENABLE_SORT
1936
1937#undef VOL7D_POLY_TYPE
1938#undef VOL7D_POLY_TYPES
1939#define VOL7D_POLY_TYPE DOUBLEPRECISION
1940#define VOL7D_POLY_TYPES _d
1941#define ENABLE_SORT
1942#include "array_utilities_inc.F90"
1943#undef ENABLE_SORT
1944
1945#define VOL7D_NO_PACK
1946#undef VOL7D_POLY_TYPE
1947#undef VOL7D_POLY_TYPES
1948#define VOL7D_POLY_TYPE CHARACTER(len=*)
1949#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1950#define VOL7D_POLY_TYPES _c
1951#define ENABLE_SORT
1952#include "array_utilities_inc.F90"
1953#undef VOL7D_POLY_TYPE_AUTO
1954#undef ENABLE_SORT
1955
1956SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1957CHARACTER(len=*),INTENT(in) :: vect(:)
1958LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1959CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1960
1961INTEGER :: count_distinct
1962INTEGER :: i, j, dim
1963LOGICAL :: lback
1964
1965dim = SIZE(pack_distinct)
1966IF (PRESENT(back)) THEN
1967 lback = back
1968ELSE
1969 lback = .false.
1970ENDIF
1971count_distinct = 0
1972
1973IF (PRESENT (mask)) THEN
1974 IF (lback) THEN
1975 vectm1: DO i = 1, SIZE(vect)
1976 IF (.NOT.mask(i)) cycle vectm1
1977! DO j = i-1, 1, -1
1978! IF (vect(j) == vect(i)) CYCLE vectm1
1979 DO j = count_distinct, 1, -1
1980 IF (pack_distinct(j) == vect(i)) cycle vectm1
1981 ENDDO
1982 count_distinct = count_distinct + 1
1983 IF (count_distinct > dim) EXIT
1984 pack_distinct(count_distinct) = vect(i)
1985 ENDDO vectm1
1986 ELSE
1987 vectm2: DO i = 1, SIZE(vect)
1988 IF (.NOT.mask(i)) cycle vectm2
1989! DO j = 1, i-1
1990! IF (vect(j) == vect(i)) CYCLE vectm2
1991 DO j = 1, count_distinct
1992 IF (pack_distinct(j) == vect(i)) cycle vectm2
1993 ENDDO
1994 count_distinct = count_distinct + 1
1995 IF (count_distinct > dim) EXIT
1996 pack_distinct(count_distinct) = vect(i)
1997 ENDDO vectm2
1998 ENDIF
1999ELSE
2000 IF (lback) THEN
2001 vect1: DO i = 1, SIZE(vect)
2002! DO j = i-1, 1, -1
2003! IF (vect(j) == vect(i)) CYCLE vect1
2004 DO j = count_distinct, 1, -1
2005 IF (pack_distinct(j) == vect(i)) cycle vect1
2006 ENDDO
2007 count_distinct = count_distinct + 1
2008 IF (count_distinct > dim) EXIT
2009 pack_distinct(count_distinct) = vect(i)
2010 ENDDO vect1
2011 ELSE
2012 vect2: DO i = 1, SIZE(vect)
2013! DO j = 1, i-1
2014! IF (vect(j) == vect(i)) CYCLE vect2
2015 DO j = 1, count_distinct
2016 IF (pack_distinct(j) == vect(i)) cycle vect2
2017 ENDDO
2018 count_distinct = count_distinct + 1
2019 IF (count_distinct > dim) EXIT
2020 pack_distinct(count_distinct) = vect(i)
2021 ENDDO vect2
2022 ENDIF
2023ENDIF
2024
2025END SUBROUTINE pack_distinct_c
2026
2028FUNCTION map(mask) RESULT(mapidx)
2029LOGICAL,INTENT(in) :: mask(:)
2030INTEGER :: mapidx(count(mask))
2031
2032INTEGER :: i,j
2033
2034j = 0
2035DO i=1, SIZE(mask)
2036 j = j + 1
2037 IF (mask(i)) mapidx(j)=i
2038ENDDO
2039
2040END FUNCTION map
2041
2042#define ARRAYOF_ORIGEQ 1
2043
2044#undef ARRAYOF_ORIGTYPE
2045#undef ARRAYOF_TYPE
2046#define ARRAYOF_ORIGTYPE INTEGER
2047#define ARRAYOF_TYPE arrayof_integer
2048#include "arrayof_post.F90"
2049
2050#undef ARRAYOF_ORIGTYPE
2051#undef ARRAYOF_TYPE
2052#define ARRAYOF_ORIGTYPE REAL
2053#define ARRAYOF_TYPE arrayof_real
2054#include "arrayof_post.F90"
2055
2056#undef ARRAYOF_ORIGTYPE
2057#undef ARRAYOF_TYPE
2058#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2059#define ARRAYOF_TYPE arrayof_doubleprecision
2060#include "arrayof_post.F90"
2061
2062#undef ARRAYOF_ORIGEQ
2063
2064#undef ARRAYOF_ORIGTYPE
2065#undef ARRAYOF_TYPE
2066#define ARRAYOF_ORIGTYPE LOGICAL
2067#define ARRAYOF_TYPE arrayof_logical
2068#include "arrayof_post.F90"
2069
2070END 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.