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