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