libsim Versione 7.1.11
|
◆ count_distinct_r()
conta gli elementi distinti in vect Definizione alla linea 2181 del file array_utilities.F90. 2182! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2183! authors:
2184! Davide Cesari <dcesari@arpa.emr.it>
2185! Paolo Patruno <ppatruno@arpa.emr.it>
2186
2187! This program is free software; you can redistribute it and/or
2188! modify it under the terms of the GNU General Public License as
2189! published by the Free Software Foundation; either version 2 of
2190! the License, or (at your option) any later version.
2191
2192! This program is distributed in the hope that it will be useful,
2193! but WITHOUT ANY WARRANTY; without even the implied warranty of
2194! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2195! GNU General Public License for more details.
2196
2197! You should have received a copy of the GNU General Public License
2198! along with this program. If not, see <http://www.gnu.org/licenses/>.
2199
2200
2201
2204#include "config.h"
2206
2207IMPLICIT NONE
2208
2209! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2210!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2211
2212#undef VOL7D_POLY_TYPE_AUTO
2213
2214#undef VOL7D_POLY_TYPE
2215#undef VOL7D_POLY_TYPES
2216#define VOL7D_POLY_TYPE INTEGER
2217#define VOL7D_POLY_TYPES _i
2218#define ENABLE_SORT
2219#include "array_utilities_pre.F90"
2220#undef ENABLE_SORT
2221
2222#undef VOL7D_POLY_TYPE
2223#undef VOL7D_POLY_TYPES
2224#define VOL7D_POLY_TYPE REAL
2225#define VOL7D_POLY_TYPES _r
2226#define ENABLE_SORT
2227#include "array_utilities_pre.F90"
2228#undef ENABLE_SORT
2229
2230#undef VOL7D_POLY_TYPE
2231#undef VOL7D_POLY_TYPES
2232#define VOL7D_POLY_TYPE DOUBLEPRECISION
2233#define VOL7D_POLY_TYPES _d
2234#define ENABLE_SORT
2235#include "array_utilities_pre.F90"
2236#undef ENABLE_SORT
2237
2238#define VOL7D_NO_PACK
2239#undef VOL7D_POLY_TYPE
2240#undef VOL7D_POLY_TYPES
2241#define VOL7D_POLY_TYPE CHARACTER(len=*)
2242#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2243#define VOL7D_POLY_TYPES _c
2244#define ENABLE_SORT
2245#include "array_utilities_pre.F90"
2246#undef VOL7D_POLY_TYPE_AUTO
2247#undef ENABLE_SORT
2248
2249
2250#define ARRAYOF_ORIGEQ 1
2251
2252#define ARRAYOF_ORIGTYPE INTEGER
2253#define ARRAYOF_TYPE arrayof_integer
2254#include "arrayof_pre.F90"
2255
2256#undef ARRAYOF_ORIGTYPE
2257#undef ARRAYOF_TYPE
2258#define ARRAYOF_ORIGTYPE REAL
2259#define ARRAYOF_TYPE arrayof_real
2260#include "arrayof_pre.F90"
2261
2262#undef ARRAYOF_ORIGTYPE
2263#undef ARRAYOF_TYPE
2264#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2265#define ARRAYOF_TYPE arrayof_doubleprecision
2266#include "arrayof_pre.F90"
2267
2268#undef ARRAYOF_ORIGEQ
2269
2270#undef ARRAYOF_ORIGTYPE
2271#undef ARRAYOF_TYPE
2272#define ARRAYOF_ORIGTYPE LOGICAL
2273#define ARRAYOF_TYPE arrayof_logical
2274#include "arrayof_pre.F90"
2275
2276PRIVATE
2277! from arrayof
2279PUBLIC insert_unique, append_unique
2280
2282 count_distinct_sorted, pack_distinct_sorted, &
2283 count_distinct, pack_distinct, count_and_pack_distinct, &
2284 map_distinct, map_inv_distinct, &
2285 firsttrue, lasttrue, pack_distinct_c, map
2286
2287CONTAINS
2288
2289
2292FUNCTION firsttrue(v) RESULT(i)
2293LOGICAL,INTENT(in) :: v(:)
2294INTEGER :: i
2295
2296DO i = 1, SIZE(v)
2297 IF (v(i)) RETURN
2298ENDDO
2299i = 0
2300
2301END FUNCTION firsttrue
2302
2303
2306FUNCTION lasttrue(v) RESULT(i)
2307LOGICAL,INTENT(in) :: v(:)
2308INTEGER :: i
2309
2310DO i = SIZE(v), 1, -1
2311 IF (v(i)) RETURN
2312ENDDO
2313
2314END FUNCTION lasttrue
2315
2316
2317! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2318#undef VOL7D_POLY_TYPE_AUTO
2319#undef VOL7D_NO_PACK
2320
2321#undef VOL7D_POLY_TYPE
2322#undef VOL7D_POLY_TYPES
2323#define VOL7D_POLY_TYPE INTEGER
2324#define VOL7D_POLY_TYPES _i
2325#define ENABLE_SORT
2326#include "array_utilities_inc.F90"
2327#undef ENABLE_SORT
2328
2329#undef VOL7D_POLY_TYPE
2330#undef VOL7D_POLY_TYPES
2331#define VOL7D_POLY_TYPE REAL
2332#define VOL7D_POLY_TYPES _r
2333#define ENABLE_SORT
2334#include "array_utilities_inc.F90"
2335#undef ENABLE_SORT
2336
2337#undef VOL7D_POLY_TYPE
2338#undef VOL7D_POLY_TYPES
2339#define VOL7D_POLY_TYPE DOUBLEPRECISION
2340#define VOL7D_POLY_TYPES _d
2341#define ENABLE_SORT
2342#include "array_utilities_inc.F90"
2343#undef ENABLE_SORT
2344
2345#define VOL7D_NO_PACK
2346#undef VOL7D_POLY_TYPE
2347#undef VOL7D_POLY_TYPES
2348#define VOL7D_POLY_TYPE CHARACTER(len=*)
2349#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2350#define VOL7D_POLY_TYPES _c
2351#define ENABLE_SORT
2352#include "array_utilities_inc.F90"
2353#undef VOL7D_POLY_TYPE_AUTO
2354#undef ENABLE_SORT
2355
2356SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2357CHARACTER(len=*),INTENT(in) :: vect(:)
2358LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2359CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2360
2361INTEGER :: count_distinct
2362INTEGER :: i, j, dim
2363LOGICAL :: lback
2364
2365dim = SIZE(pack_distinct)
2366IF (PRESENT(back)) THEN
2367 lback = back
2368ELSE
2369 lback = .false.
2370ENDIF
2371count_distinct = 0
2372
2373IF (PRESENT (mask)) THEN
2374 IF (lback) THEN
2375 vectm1: DO i = 1, SIZE(vect)
2376 IF (.NOT.mask(i)) cycle vectm1
2377! DO j = i-1, 1, -1
2378! IF (vect(j) == vect(i)) CYCLE vectm1
2379 DO j = count_distinct, 1, -1
2380 IF (pack_distinct(j) == vect(i)) cycle vectm1
2381 ENDDO
2382 count_distinct = count_distinct + 1
2383 IF (count_distinct > dim) EXIT
2384 pack_distinct(count_distinct) = vect(i)
2385 ENDDO vectm1
2386 ELSE
2387 vectm2: DO i = 1, SIZE(vect)
2388 IF (.NOT.mask(i)) cycle vectm2
2389! DO j = 1, i-1
2390! IF (vect(j) == vect(i)) CYCLE vectm2
2391 DO j = 1, count_distinct
2392 IF (pack_distinct(j) == vect(i)) cycle vectm2
2393 ENDDO
2394 count_distinct = count_distinct + 1
2395 IF (count_distinct > dim) EXIT
2396 pack_distinct(count_distinct) = vect(i)
2397 ENDDO vectm2
2398 ENDIF
2399ELSE
2400 IF (lback) THEN
2401 vect1: DO i = 1, SIZE(vect)
2402! DO j = i-1, 1, -1
2403! IF (vect(j) == vect(i)) CYCLE vect1
2404 DO j = count_distinct, 1, -1
2405 IF (pack_distinct(j) == vect(i)) cycle vect1
2406 ENDDO
2407 count_distinct = count_distinct + 1
2408 IF (count_distinct > dim) EXIT
2409 pack_distinct(count_distinct) = vect(i)
2410 ENDDO vect1
2411 ELSE
2412 vect2: DO i = 1, SIZE(vect)
2413! DO j = 1, i-1
2414! IF (vect(j) == vect(i)) CYCLE vect2
2415 DO j = 1, count_distinct
2416 IF (pack_distinct(j) == vect(i)) cycle vect2
2417 ENDDO
2418 count_distinct = count_distinct + 1
2419 IF (count_distinct > dim) EXIT
2420 pack_distinct(count_distinct) = vect(i)
2421 ENDDO vect2
2422 ENDIF
2423ENDIF
2424
2425END SUBROUTINE pack_distinct_c
2426
2428FUNCTION map(mask) RESULT(mapidx)
2429LOGICAL,INTENT(in) :: mask(:)
2430INTEGER :: mapidx(count(mask))
2431
2432INTEGER :: i,j
2433
2434j = 0
2435DO i=1, SIZE(mask)
2436 j = j + 1
2437 IF (mask(i)) mapidx(j)=i
2438ENDDO
2439
2440END FUNCTION map
2441
2442#define ARRAYOF_ORIGEQ 1
2443
2444#undef ARRAYOF_ORIGTYPE
2445#undef ARRAYOF_TYPE
2446#define ARRAYOF_ORIGTYPE INTEGER
2447#define ARRAYOF_TYPE arrayof_integer
2448#include "arrayof_post.F90"
2449
2450#undef ARRAYOF_ORIGTYPE
2451#undef ARRAYOF_TYPE
2452#define ARRAYOF_ORIGTYPE REAL
2453#define ARRAYOF_TYPE arrayof_real
2454#include "arrayof_post.F90"
2455
2456#undef ARRAYOF_ORIGTYPE
2457#undef ARRAYOF_TYPE
2458#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2459#define ARRAYOF_TYPE arrayof_doubleprecision
2460#include "arrayof_post.F90"
2461
2462#undef ARRAYOF_ORIGEQ
2463
2464#undef ARRAYOF_ORIGTYPE
2465#undef ARRAYOF_TYPE
2466#define ARRAYOF_ORIGTYPE LOGICAL
2467#define ARRAYOF_TYPE arrayof_logical
2468#include "arrayof_post.F90"
2469
Quick method to append an element to the array. Definition: array_utilities.F90:514 Destructor for finalizing an array object. Definition: array_utilities.F90:527 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:505 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:537 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:520 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:218 |