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