libsim Versione 7.1.11

◆ count_distinct_sorted_r()

integer function count_distinct_sorted_r ( real, dimension(:), intent(in)  vect,
logical, dimension(:), intent(in), optional  mask 
)
private

conta gli elementi distinti in un sorted array

Definizione alla linea 2147 del file array_utilities.F90.

2148! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2149! authors:
2150! Davide Cesari <dcesari@arpa.emr.it>
2151! Paolo Patruno <ppatruno@arpa.emr.it>
2152
2153! This program is free software; you can redistribute it and/or
2154! modify it under the terms of the GNU General Public License as
2155! published by the Free Software Foundation; either version 2 of
2156! the License, or (at your option) any later version.
2157
2158! This program is distributed in the hope that it will be useful,
2159! but WITHOUT ANY WARRANTY; without even the implied warranty of
2160! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2161! GNU General Public License for more details.
2162
2163! You should have received a copy of the GNU General Public License
2164! along with this program. If not, see <http://www.gnu.org/licenses/>.
2165
2166
2167
2170#include "config.h"
2171MODULE array_utilities
2172
2173IMPLICIT NONE
2174
2175! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2176!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2177
2178#undef VOL7D_POLY_TYPE_AUTO
2179
2180#undef VOL7D_POLY_TYPE
2181#undef VOL7D_POLY_TYPES
2182#define VOL7D_POLY_TYPE INTEGER
2183#define VOL7D_POLY_TYPES _i
2184#define ENABLE_SORT
2185#include "array_utilities_pre.F90"
2186#undef ENABLE_SORT
2187
2188#undef VOL7D_POLY_TYPE
2189#undef VOL7D_POLY_TYPES
2190#define VOL7D_POLY_TYPE REAL
2191#define VOL7D_POLY_TYPES _r
2192#define ENABLE_SORT
2193#include "array_utilities_pre.F90"
2194#undef ENABLE_SORT
2195
2196#undef VOL7D_POLY_TYPE
2197#undef VOL7D_POLY_TYPES
2198#define VOL7D_POLY_TYPE DOUBLEPRECISION
2199#define VOL7D_POLY_TYPES _d
2200#define ENABLE_SORT
2201#include "array_utilities_pre.F90"
2202#undef ENABLE_SORT
2203
2204#define VOL7D_NO_PACK
2205#undef VOL7D_POLY_TYPE
2206#undef VOL7D_POLY_TYPES
2207#define VOL7D_POLY_TYPE CHARACTER(len=*)
2208#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2209#define VOL7D_POLY_TYPES _c
2210#define ENABLE_SORT
2211#include "array_utilities_pre.F90"
2212#undef VOL7D_POLY_TYPE_AUTO
2213#undef ENABLE_SORT
2214
2215
2216#define ARRAYOF_ORIGEQ 1
2217
2218#define ARRAYOF_ORIGTYPE INTEGER
2219#define ARRAYOF_TYPE arrayof_integer
2220#include "arrayof_pre.F90"
2221
2222#undef ARRAYOF_ORIGTYPE
2223#undef ARRAYOF_TYPE
2224#define ARRAYOF_ORIGTYPE REAL
2225#define ARRAYOF_TYPE arrayof_real
2226#include "arrayof_pre.F90"
2227
2228#undef ARRAYOF_ORIGTYPE
2229#undef ARRAYOF_TYPE
2230#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2231#define ARRAYOF_TYPE arrayof_doubleprecision
2232#include "arrayof_pre.F90"
2233
2234#undef ARRAYOF_ORIGEQ
2235
2236#undef ARRAYOF_ORIGTYPE
2237#undef ARRAYOF_TYPE
2238#define ARRAYOF_ORIGTYPE LOGICAL
2239#define ARRAYOF_TYPE arrayof_logical
2240#include "arrayof_pre.F90"
2241
2242PRIVATE
2243! from arrayof
2245PUBLIC insert_unique, append_unique
2246
2247PUBLIC sort, index, index_c, &
2248 count_distinct_sorted, pack_distinct_sorted, &
2249 count_distinct, pack_distinct, count_and_pack_distinct, &
2250 map_distinct, map_inv_distinct, &
2251 firsttrue, lasttrue, pack_distinct_c, map
2252
2253CONTAINS
2254
2255
2258FUNCTION firsttrue(v) RESULT(i)
2259LOGICAL,INTENT(in) :: v(:)
2260INTEGER :: i
2261
2262DO i = 1, SIZE(v)
2263 IF (v(i)) RETURN
2264ENDDO
2265i = 0
2266
2267END FUNCTION firsttrue
2268
2269
2272FUNCTION lasttrue(v) RESULT(i)
2273LOGICAL,INTENT(in) :: v(:)
2274INTEGER :: i
2275
2276DO i = SIZE(v), 1, -1
2277 IF (v(i)) RETURN
2278ENDDO
2279
2280END FUNCTION lasttrue
2281
2282
2283! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2284#undef VOL7D_POLY_TYPE_AUTO
2285#undef VOL7D_NO_PACK
2286
2287#undef VOL7D_POLY_TYPE
2288#undef VOL7D_POLY_TYPES
2289#define VOL7D_POLY_TYPE INTEGER
2290#define VOL7D_POLY_TYPES _i
2291#define ENABLE_SORT
2292#include "array_utilities_inc.F90"
2293#undef ENABLE_SORT
2294
2295#undef VOL7D_POLY_TYPE
2296#undef VOL7D_POLY_TYPES
2297#define VOL7D_POLY_TYPE REAL
2298#define VOL7D_POLY_TYPES _r
2299#define ENABLE_SORT
2300#include "array_utilities_inc.F90"
2301#undef ENABLE_SORT
2302
2303#undef VOL7D_POLY_TYPE
2304#undef VOL7D_POLY_TYPES
2305#define VOL7D_POLY_TYPE DOUBLEPRECISION
2306#define VOL7D_POLY_TYPES _d
2307#define ENABLE_SORT
2308#include "array_utilities_inc.F90"
2309#undef ENABLE_SORT
2310
2311#define VOL7D_NO_PACK
2312#undef VOL7D_POLY_TYPE
2313#undef VOL7D_POLY_TYPES
2314#define VOL7D_POLY_TYPE CHARACTER(len=*)
2315#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2316#define VOL7D_POLY_TYPES _c
2317#define ENABLE_SORT
2318#include "array_utilities_inc.F90"
2319#undef VOL7D_POLY_TYPE_AUTO
2320#undef ENABLE_SORT
2321
2322SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2323CHARACTER(len=*),INTENT(in) :: vect(:)
2324LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2325CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2326
2327INTEGER :: count_distinct
2328INTEGER :: i, j, dim
2329LOGICAL :: lback
2330
2331dim = SIZE(pack_distinct)
2332IF (PRESENT(back)) THEN
2333 lback = back
2334ELSE
2335 lback = .false.
2336ENDIF
2337count_distinct = 0
2338
2339IF (PRESENT (mask)) THEN
2340 IF (lback) THEN
2341 vectm1: DO i = 1, SIZE(vect)
2342 IF (.NOT.mask(i)) cycle vectm1
2343! DO j = i-1, 1, -1
2344! IF (vect(j) == vect(i)) CYCLE vectm1
2345 DO j = count_distinct, 1, -1
2346 IF (pack_distinct(j) == vect(i)) cycle vectm1
2347 ENDDO
2348 count_distinct = count_distinct + 1
2349 IF (count_distinct > dim) EXIT
2350 pack_distinct(count_distinct) = vect(i)
2351 ENDDO vectm1
2352 ELSE
2353 vectm2: DO i = 1, SIZE(vect)
2354 IF (.NOT.mask(i)) cycle vectm2
2355! DO j = 1, i-1
2356! IF (vect(j) == vect(i)) CYCLE vectm2
2357 DO j = 1, count_distinct
2358 IF (pack_distinct(j) == vect(i)) cycle vectm2
2359 ENDDO
2360 count_distinct = count_distinct + 1
2361 IF (count_distinct > dim) EXIT
2362 pack_distinct(count_distinct) = vect(i)
2363 ENDDO vectm2
2364 ENDIF
2365ELSE
2366 IF (lback) THEN
2367 vect1: DO i = 1, SIZE(vect)
2368! DO j = i-1, 1, -1
2369! IF (vect(j) == vect(i)) CYCLE vect1
2370 DO j = count_distinct, 1, -1
2371 IF (pack_distinct(j) == vect(i)) cycle vect1
2372 ENDDO
2373 count_distinct = count_distinct + 1
2374 IF (count_distinct > dim) EXIT
2375 pack_distinct(count_distinct) = vect(i)
2376 ENDDO vect1
2377 ELSE
2378 vect2: DO i = 1, SIZE(vect)
2379! DO j = 1, i-1
2380! IF (vect(j) == vect(i)) CYCLE vect2
2381 DO j = 1, count_distinct
2382 IF (pack_distinct(j) == vect(i)) cycle vect2
2383 ENDDO
2384 count_distinct = count_distinct + 1
2385 IF (count_distinct > dim) EXIT
2386 pack_distinct(count_distinct) = vect(i)
2387 ENDDO vect2
2388 ENDIF
2389ENDIF
2390
2391END SUBROUTINE pack_distinct_c
2392
2394FUNCTION map(mask) RESULT(mapidx)
2395LOGICAL,INTENT(in) :: mask(:)
2396INTEGER :: mapidx(count(mask))
2397
2398INTEGER :: i,j
2399
2400j = 0
2401DO i=1, SIZE(mask)
2402 j = j + 1
2403 IF (mask(i)) mapidx(j)=i
2404ENDDO
2405
2406END FUNCTION map
2407
2408#define ARRAYOF_ORIGEQ 1
2409
2410#undef ARRAYOF_ORIGTYPE
2411#undef ARRAYOF_TYPE
2412#define ARRAYOF_ORIGTYPE INTEGER
2413#define ARRAYOF_TYPE arrayof_integer
2414#include "arrayof_post.F90"
2415
2416#undef ARRAYOF_ORIGTYPE
2417#undef ARRAYOF_TYPE
2418#define ARRAYOF_ORIGTYPE REAL
2419#define ARRAYOF_TYPE arrayof_real
2420#include "arrayof_post.F90"
2421
2422#undef ARRAYOF_ORIGTYPE
2423#undef ARRAYOF_TYPE
2424#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2425#define ARRAYOF_TYPE arrayof_doubleprecision
2426#include "arrayof_post.F90"
2427
2428#undef ARRAYOF_ORIGEQ
2429
2430#undef ARRAYOF_ORIGTYPE
2431#undef ARRAYOF_TYPE
2432#define ARRAYOF_ORIGTYPE LOGICAL
2433#define ARRAYOF_TYPE arrayof_logical
2434#include "arrayof_post.F90"
2435
2436END 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.