libsim Versione 7.2.1
|
◆ pack_distinct_sorted_r()
compatta gli elementi distinti di vect in un sorted array Definizione alla linea 2252 del file array_utilities.F90. 2254! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2255! authors:
2256! Davide Cesari <dcesari@arpa.emr.it>
2257! Paolo Patruno <ppatruno@arpa.emr.it>
2258
2259! This program is free software; you can redistribute it and/or
2260! modify it under the terms of the GNU General Public License as
2261! published by the Free Software Foundation; either version 2 of
2262! the License, or (at your option) any later version.
2263
2264! This program is distributed in the hope that it will be useful,
2265! but WITHOUT ANY WARRANTY; without even the implied warranty of
2266! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2267! GNU General Public License for more details.
2268
2269! You should have received a copy of the GNU General Public License
2270! along with this program. If not, see <http://www.gnu.org/licenses/>.
2271
2272
2273
2276#include "config.h"
2278
2279IMPLICIT NONE
2280
2281! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2282!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2283
2284#undef VOL7D_POLY_TYPE_AUTO
2285
2286#undef VOL7D_POLY_TYPE
2287#undef VOL7D_POLY_TYPES
2288#define VOL7D_POLY_TYPE INTEGER
2289#define VOL7D_POLY_TYPES _i
2290#define ENABLE_SORT
2291#include "array_utilities_pre.F90"
2292#undef ENABLE_SORT
2293
2294#undef VOL7D_POLY_TYPE
2295#undef VOL7D_POLY_TYPES
2296#define VOL7D_POLY_TYPE REAL
2297#define VOL7D_POLY_TYPES _r
2298#define ENABLE_SORT
2299#include "array_utilities_pre.F90"
2300#undef ENABLE_SORT
2301
2302#undef VOL7D_POLY_TYPE
2303#undef VOL7D_POLY_TYPES
2304#define VOL7D_POLY_TYPE DOUBLEPRECISION
2305#define VOL7D_POLY_TYPES _d
2306#define ENABLE_SORT
2307#include "array_utilities_pre.F90"
2308#undef ENABLE_SORT
2309
2310#define VOL7D_NO_PACK
2311#undef VOL7D_POLY_TYPE
2312#undef VOL7D_POLY_TYPES
2313#define VOL7D_POLY_TYPE CHARACTER(len=*)
2314#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2315#define VOL7D_POLY_TYPES _c
2316#define ENABLE_SORT
2317#include "array_utilities_pre.F90"
2318#undef VOL7D_POLY_TYPE_AUTO
2319#undef ENABLE_SORT
2320
2321
2322#define ARRAYOF_ORIGEQ 1
2323
2324#define ARRAYOF_ORIGTYPE INTEGER
2325#define ARRAYOF_TYPE arrayof_integer
2326#include "arrayof_pre.F90"
2327
2328#undef ARRAYOF_ORIGTYPE
2329#undef ARRAYOF_TYPE
2330#define ARRAYOF_ORIGTYPE REAL
2331#define ARRAYOF_TYPE arrayof_real
2332#include "arrayof_pre.F90"
2333
2334#undef ARRAYOF_ORIGTYPE
2335#undef ARRAYOF_TYPE
2336#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2337#define ARRAYOF_TYPE arrayof_doubleprecision
2338#include "arrayof_pre.F90"
2339
2340#undef ARRAYOF_ORIGEQ
2341
2342#undef ARRAYOF_ORIGTYPE
2343#undef ARRAYOF_TYPE
2344#define ARRAYOF_ORIGTYPE LOGICAL
2345#define ARRAYOF_TYPE arrayof_logical
2346#include "arrayof_pre.F90"
2347
2348PRIVATE
2349! from arrayof
2351PUBLIC insert_unique, append_unique
2352
2354 count_distinct_sorted, pack_distinct_sorted, &
2355 count_distinct, pack_distinct, count_and_pack_distinct, &
2356 map_distinct, map_inv_distinct, &
2357 firsttrue, lasttrue, pack_distinct_c, map
2358
2359CONTAINS
2360
2361
2364FUNCTION firsttrue(v) RESULT(i)
2365LOGICAL,INTENT(in) :: v(:)
2366INTEGER :: i
2367
2368DO i = 1, SIZE(v)
2369 IF (v(i)) RETURN
2370ENDDO
2371i = 0
2372
2373END FUNCTION firsttrue
2374
2375
2378FUNCTION lasttrue(v) RESULT(i)
2379LOGICAL,INTENT(in) :: v(:)
2380INTEGER :: i
2381
2382DO i = SIZE(v), 1, -1
2383 IF (v(i)) RETURN
2384ENDDO
2385
2386END FUNCTION lasttrue
2387
2388
2389! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2390#undef VOL7D_POLY_TYPE_AUTO
2391#undef VOL7D_NO_PACK
2392
2393#undef VOL7D_POLY_TYPE
2394#undef VOL7D_POLY_TYPES
2395#define VOL7D_POLY_TYPE INTEGER
2396#define VOL7D_POLY_TYPES _i
2397#define ENABLE_SORT
2398#include "array_utilities_inc.F90"
2399#undef ENABLE_SORT
2400
2401#undef VOL7D_POLY_TYPE
2402#undef VOL7D_POLY_TYPES
2403#define VOL7D_POLY_TYPE REAL
2404#define VOL7D_POLY_TYPES _r
2405#define ENABLE_SORT
2406#include "array_utilities_inc.F90"
2407#undef ENABLE_SORT
2408
2409#undef VOL7D_POLY_TYPE
2410#undef VOL7D_POLY_TYPES
2411#define VOL7D_POLY_TYPE DOUBLEPRECISION
2412#define VOL7D_POLY_TYPES _d
2413#define ENABLE_SORT
2414#include "array_utilities_inc.F90"
2415#undef ENABLE_SORT
2416
2417#define VOL7D_NO_PACK
2418#undef VOL7D_POLY_TYPE
2419#undef VOL7D_POLY_TYPES
2420#define VOL7D_POLY_TYPE CHARACTER(len=*)
2421#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2422#define VOL7D_POLY_TYPES _c
2423#define ENABLE_SORT
2424#include "array_utilities_inc.F90"
2425#undef VOL7D_POLY_TYPE_AUTO
2426#undef ENABLE_SORT
2427
2428SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2429CHARACTER(len=*),INTENT(in) :: vect(:)
2430LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2431CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2432
2433INTEGER :: count_distinct
2434INTEGER :: i, j, dim
2435LOGICAL :: lback
2436
2437dim = SIZE(pack_distinct)
2438IF (PRESENT(back)) THEN
2439 lback = back
2440ELSE
2441 lback = .false.
2442ENDIF
2443count_distinct = 0
2444
2445IF (PRESENT (mask)) THEN
2446 IF (lback) THEN
2447 vectm1: DO i = 1, SIZE(vect)
2448 IF (.NOT.mask(i)) cycle vectm1
2449! DO j = i-1, 1, -1
2450! IF (vect(j) == vect(i)) CYCLE vectm1
2451 DO j = count_distinct, 1, -1
2452 IF (pack_distinct(j) == vect(i)) cycle vectm1
2453 ENDDO
2454 count_distinct = count_distinct + 1
2455 IF (count_distinct > dim) EXIT
2456 pack_distinct(count_distinct) = vect(i)
2457 ENDDO vectm1
2458 ELSE
2459 vectm2: DO i = 1, SIZE(vect)
2460 IF (.NOT.mask(i)) cycle vectm2
2461! DO j = 1, i-1
2462! IF (vect(j) == vect(i)) CYCLE vectm2
2463 DO j = 1, count_distinct
2464 IF (pack_distinct(j) == vect(i)) cycle vectm2
2465 ENDDO
2466 count_distinct = count_distinct + 1
2467 IF (count_distinct > dim) EXIT
2468 pack_distinct(count_distinct) = vect(i)
2469 ENDDO vectm2
2470 ENDIF
2471ELSE
2472 IF (lback) THEN
2473 vect1: DO i = 1, SIZE(vect)
2474! DO j = i-1, 1, -1
2475! IF (vect(j) == vect(i)) CYCLE vect1
2476 DO j = count_distinct, 1, -1
2477 IF (pack_distinct(j) == vect(i)) cycle vect1
2478 ENDDO
2479 count_distinct = count_distinct + 1
2480 IF (count_distinct > dim) EXIT
2481 pack_distinct(count_distinct) = vect(i)
2482 ENDDO vect1
2483 ELSE
2484 vect2: DO i = 1, SIZE(vect)
2485! DO j = 1, i-1
2486! IF (vect(j) == vect(i)) CYCLE vect2
2487 DO j = 1, count_distinct
2488 IF (pack_distinct(j) == vect(i)) cycle vect2
2489 ENDDO
2490 count_distinct = count_distinct + 1
2491 IF (count_distinct > dim) EXIT
2492 pack_distinct(count_distinct) = vect(i)
2493 ENDDO vect2
2494 ENDIF
2495ENDIF
2496
2497END SUBROUTINE pack_distinct_c
2498
2500FUNCTION map(mask) RESULT(mapidx)
2501LOGICAL,INTENT(in) :: mask(:)
2502INTEGER :: mapidx(count(mask))
2503
2504INTEGER :: i,j
2505
2506j = 0
2507DO i=1, SIZE(mask)
2508 j = j + 1
2509 IF (mask(i)) mapidx(j)=i
2510ENDDO
2511
2512END FUNCTION map
2513
2514#define ARRAYOF_ORIGEQ 1
2515
2516#undef ARRAYOF_ORIGTYPE
2517#undef ARRAYOF_TYPE
2518#define ARRAYOF_ORIGTYPE INTEGER
2519#define ARRAYOF_TYPE arrayof_integer
2520#include "arrayof_post.F90"
2521
2522#undef ARRAYOF_ORIGTYPE
2523#undef ARRAYOF_TYPE
2524#define ARRAYOF_ORIGTYPE REAL
2525#define ARRAYOF_TYPE arrayof_real
2526#include "arrayof_post.F90"
2527
2528#undef ARRAYOF_ORIGTYPE
2529#undef ARRAYOF_TYPE
2530#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2531#define ARRAYOF_TYPE arrayof_doubleprecision
2532#include "arrayof_post.F90"
2533
2534#undef ARRAYOF_ORIGEQ
2535
2536#undef ARRAYOF_ORIGTYPE
2537#undef ARRAYOF_TYPE
2538#define ARRAYOF_ORIGTYPE LOGICAL
2539#define ARRAYOF_TYPE arrayof_logical
2540#include "arrayof_post.F90"
2541
Quick method to append an element to the array. Definition: array_utilities.F90:508 Destructor for finalizing an array object. Definition: array_utilities.F90:521 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 |