libsim Versione 7.1.11

◆ map_distinct_r()

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

map distinct

Definizione alla linea 2440 del file array_utilities.F90.

2441! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2442! authors:
2443! Davide Cesari <dcesari@arpa.emr.it>
2444! Paolo Patruno <ppatruno@arpa.emr.it>
2445
2446! This program is free software; you can redistribute it and/or
2447! modify it under the terms of the GNU General Public License as
2448! published by the Free Software Foundation; either version 2 of
2449! the License, or (at your option) any later version.
2450
2451! This program is distributed in the hope that it will be useful,
2452! but WITHOUT ANY WARRANTY; without even the implied warranty of
2453! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2454! GNU General Public License for more details.
2455
2456! You should have received a copy of the GNU General Public License
2457! along with this program. If not, see <http://www.gnu.org/licenses/>.
2458
2459
2460
2463#include "config.h"
2464MODULE array_utilities
2465
2466IMPLICIT NONE
2467
2468! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2469!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2470
2471#undef VOL7D_POLY_TYPE_AUTO
2472
2473#undef VOL7D_POLY_TYPE
2474#undef VOL7D_POLY_TYPES
2475#define VOL7D_POLY_TYPE INTEGER
2476#define VOL7D_POLY_TYPES _i
2477#define ENABLE_SORT
2478#include "array_utilities_pre.F90"
2479#undef ENABLE_SORT
2480
2481#undef VOL7D_POLY_TYPE
2482#undef VOL7D_POLY_TYPES
2483#define VOL7D_POLY_TYPE REAL
2484#define VOL7D_POLY_TYPES _r
2485#define ENABLE_SORT
2486#include "array_utilities_pre.F90"
2487#undef ENABLE_SORT
2488
2489#undef VOL7D_POLY_TYPE
2490#undef VOL7D_POLY_TYPES
2491#define VOL7D_POLY_TYPE DOUBLEPRECISION
2492#define VOL7D_POLY_TYPES _d
2493#define ENABLE_SORT
2494#include "array_utilities_pre.F90"
2495#undef ENABLE_SORT
2496
2497#define VOL7D_NO_PACK
2498#undef VOL7D_POLY_TYPE
2499#undef VOL7D_POLY_TYPES
2500#define VOL7D_POLY_TYPE CHARACTER(len=*)
2501#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2502#define VOL7D_POLY_TYPES _c
2503#define ENABLE_SORT
2504#include "array_utilities_pre.F90"
2505#undef VOL7D_POLY_TYPE_AUTO
2506#undef ENABLE_SORT
2507
2508
2509#define ARRAYOF_ORIGEQ 1
2510
2511#define ARRAYOF_ORIGTYPE INTEGER
2512#define ARRAYOF_TYPE arrayof_integer
2513#include "arrayof_pre.F90"
2514
2515#undef ARRAYOF_ORIGTYPE
2516#undef ARRAYOF_TYPE
2517#define ARRAYOF_ORIGTYPE REAL
2518#define ARRAYOF_TYPE arrayof_real
2519#include "arrayof_pre.F90"
2520
2521#undef ARRAYOF_ORIGTYPE
2522#undef ARRAYOF_TYPE
2523#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2524#define ARRAYOF_TYPE arrayof_doubleprecision
2525#include "arrayof_pre.F90"
2526
2527#undef ARRAYOF_ORIGEQ
2528
2529#undef ARRAYOF_ORIGTYPE
2530#undef ARRAYOF_TYPE
2531#define ARRAYOF_ORIGTYPE LOGICAL
2532#define ARRAYOF_TYPE arrayof_logical
2533#include "arrayof_pre.F90"
2534
2535PRIVATE
2536! from arrayof
2538PUBLIC insert_unique, append_unique
2539
2540PUBLIC sort, index, index_c, &
2541 count_distinct_sorted, pack_distinct_sorted, &
2542 count_distinct, pack_distinct, count_and_pack_distinct, &
2543 map_distinct, map_inv_distinct, &
2544 firsttrue, lasttrue, pack_distinct_c, map
2545
2546CONTAINS
2547
2548
2551FUNCTION firsttrue(v) RESULT(i)
2552LOGICAL,INTENT(in) :: v(:)
2553INTEGER :: i
2554
2555DO i = 1, SIZE(v)
2556 IF (v(i)) RETURN
2557ENDDO
2558i = 0
2559
2560END FUNCTION firsttrue
2561
2562
2565FUNCTION lasttrue(v) RESULT(i)
2566LOGICAL,INTENT(in) :: v(:)
2567INTEGER :: i
2568
2569DO i = SIZE(v), 1, -1
2570 IF (v(i)) RETURN
2571ENDDO
2572
2573END FUNCTION lasttrue
2574
2575
2576! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2577#undef VOL7D_POLY_TYPE_AUTO
2578#undef VOL7D_NO_PACK
2579
2580#undef VOL7D_POLY_TYPE
2581#undef VOL7D_POLY_TYPES
2582#define VOL7D_POLY_TYPE INTEGER
2583#define VOL7D_POLY_TYPES _i
2584#define ENABLE_SORT
2585#include "array_utilities_inc.F90"
2586#undef ENABLE_SORT
2587
2588#undef VOL7D_POLY_TYPE
2589#undef VOL7D_POLY_TYPES
2590#define VOL7D_POLY_TYPE REAL
2591#define VOL7D_POLY_TYPES _r
2592#define ENABLE_SORT
2593#include "array_utilities_inc.F90"
2594#undef ENABLE_SORT
2595
2596#undef VOL7D_POLY_TYPE
2597#undef VOL7D_POLY_TYPES
2598#define VOL7D_POLY_TYPE DOUBLEPRECISION
2599#define VOL7D_POLY_TYPES _d
2600#define ENABLE_SORT
2601#include "array_utilities_inc.F90"
2602#undef ENABLE_SORT
2603
2604#define VOL7D_NO_PACK
2605#undef VOL7D_POLY_TYPE
2606#undef VOL7D_POLY_TYPES
2607#define VOL7D_POLY_TYPE CHARACTER(len=*)
2608#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2609#define VOL7D_POLY_TYPES _c
2610#define ENABLE_SORT
2611#include "array_utilities_inc.F90"
2612#undef VOL7D_POLY_TYPE_AUTO
2613#undef ENABLE_SORT
2614
2615SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2616CHARACTER(len=*),INTENT(in) :: vect(:)
2617LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2618CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2619
2620INTEGER :: count_distinct
2621INTEGER :: i, j, dim
2622LOGICAL :: lback
2623
2624dim = SIZE(pack_distinct)
2625IF (PRESENT(back)) THEN
2626 lback = back
2627ELSE
2628 lback = .false.
2629ENDIF
2630count_distinct = 0
2631
2632IF (PRESENT (mask)) THEN
2633 IF (lback) THEN
2634 vectm1: DO i = 1, SIZE(vect)
2635 IF (.NOT.mask(i)) cycle vectm1
2636! DO j = i-1, 1, -1
2637! IF (vect(j) == vect(i)) CYCLE vectm1
2638 DO j = count_distinct, 1, -1
2639 IF (pack_distinct(j) == vect(i)) cycle vectm1
2640 ENDDO
2641 count_distinct = count_distinct + 1
2642 IF (count_distinct > dim) EXIT
2643 pack_distinct(count_distinct) = vect(i)
2644 ENDDO vectm1
2645 ELSE
2646 vectm2: DO i = 1, SIZE(vect)
2647 IF (.NOT.mask(i)) cycle vectm2
2648! DO j = 1, i-1
2649! IF (vect(j) == vect(i)) CYCLE vectm2
2650 DO j = 1, count_distinct
2651 IF (pack_distinct(j) == vect(i)) cycle vectm2
2652 ENDDO
2653 count_distinct = count_distinct + 1
2654 IF (count_distinct > dim) EXIT
2655 pack_distinct(count_distinct) = vect(i)
2656 ENDDO vectm2
2657 ENDIF
2658ELSE
2659 IF (lback) THEN
2660 vect1: DO i = 1, SIZE(vect)
2661! DO j = i-1, 1, -1
2662! IF (vect(j) == vect(i)) CYCLE vect1
2663 DO j = count_distinct, 1, -1
2664 IF (pack_distinct(j) == vect(i)) cycle vect1
2665 ENDDO
2666 count_distinct = count_distinct + 1
2667 IF (count_distinct > dim) EXIT
2668 pack_distinct(count_distinct) = vect(i)
2669 ENDDO vect1
2670 ELSE
2671 vect2: DO i = 1, SIZE(vect)
2672! DO j = 1, i-1
2673! IF (vect(j) == vect(i)) CYCLE vect2
2674 DO j = 1, count_distinct
2675 IF (pack_distinct(j) == vect(i)) cycle vect2
2676 ENDDO
2677 count_distinct = count_distinct + 1
2678 IF (count_distinct > dim) EXIT
2679 pack_distinct(count_distinct) = vect(i)
2680 ENDDO vect2
2681 ENDIF
2682ENDIF
2683
2684END SUBROUTINE pack_distinct_c
2685
2687FUNCTION map(mask) RESULT(mapidx)
2688LOGICAL,INTENT(in) :: mask(:)
2689INTEGER :: mapidx(count(mask))
2690
2691INTEGER :: i,j
2692
2693j = 0
2694DO i=1, SIZE(mask)
2695 j = j + 1
2696 IF (mask(i)) mapidx(j)=i
2697ENDDO
2698
2699END FUNCTION map
2700
2701#define ARRAYOF_ORIGEQ 1
2702
2703#undef ARRAYOF_ORIGTYPE
2704#undef ARRAYOF_TYPE
2705#define ARRAYOF_ORIGTYPE INTEGER
2706#define ARRAYOF_TYPE arrayof_integer
2707#include "arrayof_post.F90"
2708
2709#undef ARRAYOF_ORIGTYPE
2710#undef ARRAYOF_TYPE
2711#define ARRAYOF_ORIGTYPE REAL
2712#define ARRAYOF_TYPE arrayof_real
2713#include "arrayof_post.F90"
2714
2715#undef ARRAYOF_ORIGTYPE
2716#undef ARRAYOF_TYPE
2717#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2718#define ARRAYOF_TYPE arrayof_doubleprecision
2719#include "arrayof_post.F90"
2720
2721#undef ARRAYOF_ORIGEQ
2722
2723#undef ARRAYOF_ORIGTYPE
2724#undef ARRAYOF_TYPE
2725#define ARRAYOF_ORIGTYPE LOGICAL
2726#define ARRAYOF_TYPE arrayof_logical
2727#include "arrayof_post.F90"
2728
2729END 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.