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