libsim Versione 7.2.1

◆ map_inv_distinct_r()

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

map inv distinct

Definizione alla linea 2530 del file array_utilities.F90.

2532! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2533! authors:
2534! Davide Cesari <dcesari@arpa.emr.it>
2535! Paolo Patruno <ppatruno@arpa.emr.it>
2536
2537! This program is free software; you can redistribute it and/or
2538! modify it under the terms of the GNU General Public License as
2539! published by the Free Software Foundation; either version 2 of
2540! the License, or (at your option) any later version.
2541
2542! This program is distributed in the hope that it will be useful,
2543! but WITHOUT ANY WARRANTY; without even the implied warranty of
2544! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2545! GNU General Public License for more details.
2546
2547! You should have received a copy of the GNU General Public License
2548! along with this program. If not, see <http://www.gnu.org/licenses/>.
2549
2550
2551
2554#include "config.h"
2555MODULE array_utilities
2556
2557IMPLICIT NONE
2558
2559! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2560!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2561
2562#undef VOL7D_POLY_TYPE_AUTO
2563
2564#undef VOL7D_POLY_TYPE
2565#undef VOL7D_POLY_TYPES
2566#define VOL7D_POLY_TYPE INTEGER
2567#define VOL7D_POLY_TYPES _i
2568#define ENABLE_SORT
2569#include "array_utilities_pre.F90"
2570#undef ENABLE_SORT
2571
2572#undef VOL7D_POLY_TYPE
2573#undef VOL7D_POLY_TYPES
2574#define VOL7D_POLY_TYPE REAL
2575#define VOL7D_POLY_TYPES _r
2576#define ENABLE_SORT
2577#include "array_utilities_pre.F90"
2578#undef ENABLE_SORT
2579
2580#undef VOL7D_POLY_TYPE
2581#undef VOL7D_POLY_TYPES
2582#define VOL7D_POLY_TYPE DOUBLEPRECISION
2583#define VOL7D_POLY_TYPES _d
2584#define ENABLE_SORT
2585#include "array_utilities_pre.F90"
2586#undef ENABLE_SORT
2587
2588#define VOL7D_NO_PACK
2589#undef VOL7D_POLY_TYPE
2590#undef VOL7D_POLY_TYPES
2591#define VOL7D_POLY_TYPE CHARACTER(len=*)
2592#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2593#define VOL7D_POLY_TYPES _c
2594#define ENABLE_SORT
2595#include "array_utilities_pre.F90"
2596#undef VOL7D_POLY_TYPE_AUTO
2597#undef ENABLE_SORT
2598
2599
2600#define ARRAYOF_ORIGEQ 1
2601
2602#define ARRAYOF_ORIGTYPE INTEGER
2603#define ARRAYOF_TYPE arrayof_integer
2604#include "arrayof_pre.F90"
2605
2606#undef ARRAYOF_ORIGTYPE
2607#undef ARRAYOF_TYPE
2608#define ARRAYOF_ORIGTYPE REAL
2609#define ARRAYOF_TYPE arrayof_real
2610#include "arrayof_pre.F90"
2611
2612#undef ARRAYOF_ORIGTYPE
2613#undef ARRAYOF_TYPE
2614#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2615#define ARRAYOF_TYPE arrayof_doubleprecision
2616#include "arrayof_pre.F90"
2617
2618#undef ARRAYOF_ORIGEQ
2619
2620#undef ARRAYOF_ORIGTYPE
2621#undef ARRAYOF_TYPE
2622#define ARRAYOF_ORIGTYPE LOGICAL
2623#define ARRAYOF_TYPE arrayof_logical
2624#include "arrayof_pre.F90"
2625
2626PRIVATE
2627! from arrayof
2629PUBLIC insert_unique, append_unique
2630
2631PUBLIC sort, index, index_c, &
2632 count_distinct_sorted, pack_distinct_sorted, &
2633 count_distinct, pack_distinct, count_and_pack_distinct, &
2634 map_distinct, map_inv_distinct, &
2635 firsttrue, lasttrue, pack_distinct_c, map
2636
2637CONTAINS
2638
2639
2642FUNCTION firsttrue(v) RESULT(i)
2643LOGICAL,INTENT(in) :: v(:)
2644INTEGER :: i
2645
2646DO i = 1, SIZE(v)
2647 IF (v(i)) RETURN
2648ENDDO
2649i = 0
2650
2651END FUNCTION firsttrue
2652
2653
2656FUNCTION lasttrue(v) RESULT(i)
2657LOGICAL,INTENT(in) :: v(:)
2658INTEGER :: i
2659
2660DO i = SIZE(v), 1, -1
2661 IF (v(i)) RETURN
2662ENDDO
2663
2664END FUNCTION lasttrue
2665
2666
2667! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2668#undef VOL7D_POLY_TYPE_AUTO
2669#undef VOL7D_NO_PACK
2670
2671#undef VOL7D_POLY_TYPE
2672#undef VOL7D_POLY_TYPES
2673#define VOL7D_POLY_TYPE INTEGER
2674#define VOL7D_POLY_TYPES _i
2675#define ENABLE_SORT
2676#include "array_utilities_inc.F90"
2677#undef ENABLE_SORT
2678
2679#undef VOL7D_POLY_TYPE
2680#undef VOL7D_POLY_TYPES
2681#define VOL7D_POLY_TYPE REAL
2682#define VOL7D_POLY_TYPES _r
2683#define ENABLE_SORT
2684#include "array_utilities_inc.F90"
2685#undef ENABLE_SORT
2686
2687#undef VOL7D_POLY_TYPE
2688#undef VOL7D_POLY_TYPES
2689#define VOL7D_POLY_TYPE DOUBLEPRECISION
2690#define VOL7D_POLY_TYPES _d
2691#define ENABLE_SORT
2692#include "array_utilities_inc.F90"
2693#undef ENABLE_SORT
2694
2695#define VOL7D_NO_PACK
2696#undef VOL7D_POLY_TYPE
2697#undef VOL7D_POLY_TYPES
2698#define VOL7D_POLY_TYPE CHARACTER(len=*)
2699#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2700#define VOL7D_POLY_TYPES _c
2701#define ENABLE_SORT
2702#include "array_utilities_inc.F90"
2703#undef VOL7D_POLY_TYPE_AUTO
2704#undef ENABLE_SORT
2705
2706SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2707CHARACTER(len=*),INTENT(in) :: vect(:)
2708LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2709CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2710
2711INTEGER :: count_distinct
2712INTEGER :: i, j, dim
2713LOGICAL :: lback
2714
2715dim = SIZE(pack_distinct)
2716IF (PRESENT(back)) THEN
2717 lback = back
2718ELSE
2719 lback = .false.
2720ENDIF
2721count_distinct = 0
2722
2723IF (PRESENT (mask)) THEN
2724 IF (lback) THEN
2725 vectm1: DO i = 1, SIZE(vect)
2726 IF (.NOT.mask(i)) cycle vectm1
2727! DO j = i-1, 1, -1
2728! IF (vect(j) == vect(i)) CYCLE vectm1
2729 DO j = count_distinct, 1, -1
2730 IF (pack_distinct(j) == vect(i)) cycle vectm1
2731 ENDDO
2732 count_distinct = count_distinct + 1
2733 IF (count_distinct > dim) EXIT
2734 pack_distinct(count_distinct) = vect(i)
2735 ENDDO vectm1
2736 ELSE
2737 vectm2: DO i = 1, SIZE(vect)
2738 IF (.NOT.mask(i)) cycle vectm2
2739! DO j = 1, i-1
2740! IF (vect(j) == vect(i)) CYCLE vectm2
2741 DO j = 1, count_distinct
2742 IF (pack_distinct(j) == vect(i)) cycle vectm2
2743 ENDDO
2744 count_distinct = count_distinct + 1
2745 IF (count_distinct > dim) EXIT
2746 pack_distinct(count_distinct) = vect(i)
2747 ENDDO vectm2
2748 ENDIF
2749ELSE
2750 IF (lback) THEN
2751 vect1: DO i = 1, SIZE(vect)
2752! DO j = i-1, 1, -1
2753! IF (vect(j) == vect(i)) CYCLE vect1
2754 DO j = count_distinct, 1, -1
2755 IF (pack_distinct(j) == vect(i)) cycle vect1
2756 ENDDO
2757 count_distinct = count_distinct + 1
2758 IF (count_distinct > dim) EXIT
2759 pack_distinct(count_distinct) = vect(i)
2760 ENDDO vect1
2761 ELSE
2762 vect2: DO i = 1, SIZE(vect)
2763! DO j = 1, i-1
2764! IF (vect(j) == vect(i)) CYCLE vect2
2765 DO j = 1, count_distinct
2766 IF (pack_distinct(j) == vect(i)) cycle vect2
2767 ENDDO
2768 count_distinct = count_distinct + 1
2769 IF (count_distinct > dim) EXIT
2770 pack_distinct(count_distinct) = vect(i)
2771 ENDDO vect2
2772 ENDIF
2773ENDIF
2774
2775END SUBROUTINE pack_distinct_c
2776
2778FUNCTION map(mask) RESULT(mapidx)
2779LOGICAL,INTENT(in) :: mask(:)
2780INTEGER :: mapidx(count(mask))
2781
2782INTEGER :: i,j
2783
2784j = 0
2785DO i=1, SIZE(mask)
2786 j = j + 1
2787 IF (mask(i)) mapidx(j)=i
2788ENDDO
2789
2790END FUNCTION map
2791
2792#define ARRAYOF_ORIGEQ 1
2793
2794#undef ARRAYOF_ORIGTYPE
2795#undef ARRAYOF_TYPE
2796#define ARRAYOF_ORIGTYPE INTEGER
2797#define ARRAYOF_TYPE arrayof_integer
2798#include "arrayof_post.F90"
2799
2800#undef ARRAYOF_ORIGTYPE
2801#undef ARRAYOF_TYPE
2802#define ARRAYOF_ORIGTYPE REAL
2803#define ARRAYOF_TYPE arrayof_real
2804#include "arrayof_post.F90"
2805
2806#undef ARRAYOF_ORIGTYPE
2807#undef ARRAYOF_TYPE
2808#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2809#define ARRAYOF_TYPE arrayof_doubleprecision
2810#include "arrayof_post.F90"
2811
2812#undef ARRAYOF_ORIGEQ
2813
2814#undef ARRAYOF_ORIGTYPE
2815#undef ARRAYOF_TYPE
2816#define ARRAYOF_ORIGTYPE LOGICAL
2817#define ARRAYOF_TYPE arrayof_logical
2818#include "arrayof_post.F90"
2819
2820END 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.