libsim Versione 7.2.0

◆ pack_distinct_r()

real function, dimension(dim) pack_distinct_r ( real, dimension(:), intent(in)  vect,
integer, intent(in)  dim,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back 
)
private

compatta gli elementi distinti di vect in un array

Definizione alla linea 2285 del file array_utilities.F90.

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