libsim Versione 7.1.11

◆ index_r()

integer function index_r ( real, dimension(:), intent(in)  vect,
real, intent(in)  search,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back,
integer, intent(in), optional  cache 
)
private

Cerca l'indice del primo o ultimo elemento di vect uguale a search.

Definizione alla linea 2622 del file array_utilities.F90.

2624! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2625! authors:
2626! Davide Cesari <dcesari@arpa.emr.it>
2627! Paolo Patruno <ppatruno@arpa.emr.it>
2628
2629! This program is free software; you can redistribute it and/or
2630! modify it under the terms of the GNU General Public License as
2631! published by the Free Software Foundation; either version 2 of
2632! the License, or (at your option) any later version.
2633
2634! This program is distributed in the hope that it will be useful,
2635! but WITHOUT ANY WARRANTY; without even the implied warranty of
2636! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2637! GNU General Public License for more details.
2638
2639! You should have received a copy of the GNU General Public License
2640! along with this program. If not, see <http://www.gnu.org/licenses/>.
2641
2642
2643
2646#include "config.h"
2647MODULE array_utilities
2648
2649IMPLICIT NONE
2650
2651! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2652!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2653
2654#undef VOL7D_POLY_TYPE_AUTO
2655
2656#undef VOL7D_POLY_TYPE
2657#undef VOL7D_POLY_TYPES
2658#define VOL7D_POLY_TYPE INTEGER
2659#define VOL7D_POLY_TYPES _i
2660#define ENABLE_SORT
2661#include "array_utilities_pre.F90"
2662#undef ENABLE_SORT
2663
2664#undef VOL7D_POLY_TYPE
2665#undef VOL7D_POLY_TYPES
2666#define VOL7D_POLY_TYPE REAL
2667#define VOL7D_POLY_TYPES _r
2668#define ENABLE_SORT
2669#include "array_utilities_pre.F90"
2670#undef ENABLE_SORT
2671
2672#undef VOL7D_POLY_TYPE
2673#undef VOL7D_POLY_TYPES
2674#define VOL7D_POLY_TYPE DOUBLEPRECISION
2675#define VOL7D_POLY_TYPES _d
2676#define ENABLE_SORT
2677#include "array_utilities_pre.F90"
2678#undef ENABLE_SORT
2679
2680#define VOL7D_NO_PACK
2681#undef VOL7D_POLY_TYPE
2682#undef VOL7D_POLY_TYPES
2683#define VOL7D_POLY_TYPE CHARACTER(len=*)
2684#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2685#define VOL7D_POLY_TYPES _c
2686#define ENABLE_SORT
2687#include "array_utilities_pre.F90"
2688#undef VOL7D_POLY_TYPE_AUTO
2689#undef ENABLE_SORT
2690
2691
2692#define ARRAYOF_ORIGEQ 1
2693
2694#define ARRAYOF_ORIGTYPE INTEGER
2695#define ARRAYOF_TYPE arrayof_integer
2696#include "arrayof_pre.F90"
2697
2698#undef ARRAYOF_ORIGTYPE
2699#undef ARRAYOF_TYPE
2700#define ARRAYOF_ORIGTYPE REAL
2701#define ARRAYOF_TYPE arrayof_real
2702#include "arrayof_pre.F90"
2703
2704#undef ARRAYOF_ORIGTYPE
2705#undef ARRAYOF_TYPE
2706#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2707#define ARRAYOF_TYPE arrayof_doubleprecision
2708#include "arrayof_pre.F90"
2709
2710#undef ARRAYOF_ORIGEQ
2711
2712#undef ARRAYOF_ORIGTYPE
2713#undef ARRAYOF_TYPE
2714#define ARRAYOF_ORIGTYPE LOGICAL
2715#define ARRAYOF_TYPE arrayof_logical
2716#include "arrayof_pre.F90"
2717
2718PRIVATE
2719! from arrayof
2721PUBLIC insert_unique, append_unique
2722
2723PUBLIC sort, index, index_c, &
2724 count_distinct_sorted, pack_distinct_sorted, &
2725 count_distinct, pack_distinct, count_and_pack_distinct, &
2726 map_distinct, map_inv_distinct, &
2727 firsttrue, lasttrue, pack_distinct_c, map
2728
2729CONTAINS
2730
2731
2734FUNCTION firsttrue(v) RESULT(i)
2735LOGICAL,INTENT(in) :: v(:)
2736INTEGER :: i
2737
2738DO i = 1, SIZE(v)
2739 IF (v(i)) RETURN
2740ENDDO
2741i = 0
2742
2743END FUNCTION firsttrue
2744
2745
2748FUNCTION lasttrue(v) RESULT(i)
2749LOGICAL,INTENT(in) :: v(:)
2750INTEGER :: i
2751
2752DO i = SIZE(v), 1, -1
2753 IF (v(i)) RETURN
2754ENDDO
2755
2756END FUNCTION lasttrue
2757
2758
2759! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2760#undef VOL7D_POLY_TYPE_AUTO
2761#undef VOL7D_NO_PACK
2762
2763#undef VOL7D_POLY_TYPE
2764#undef VOL7D_POLY_TYPES
2765#define VOL7D_POLY_TYPE INTEGER
2766#define VOL7D_POLY_TYPES _i
2767#define ENABLE_SORT
2768#include "array_utilities_inc.F90"
2769#undef ENABLE_SORT
2770
2771#undef VOL7D_POLY_TYPE
2772#undef VOL7D_POLY_TYPES
2773#define VOL7D_POLY_TYPE REAL
2774#define VOL7D_POLY_TYPES _r
2775#define ENABLE_SORT
2776#include "array_utilities_inc.F90"
2777#undef ENABLE_SORT
2778
2779#undef VOL7D_POLY_TYPE
2780#undef VOL7D_POLY_TYPES
2781#define VOL7D_POLY_TYPE DOUBLEPRECISION
2782#define VOL7D_POLY_TYPES _d
2783#define ENABLE_SORT
2784#include "array_utilities_inc.F90"
2785#undef ENABLE_SORT
2786
2787#define VOL7D_NO_PACK
2788#undef VOL7D_POLY_TYPE
2789#undef VOL7D_POLY_TYPES
2790#define VOL7D_POLY_TYPE CHARACTER(len=*)
2791#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2792#define VOL7D_POLY_TYPES _c
2793#define ENABLE_SORT
2794#include "array_utilities_inc.F90"
2795#undef VOL7D_POLY_TYPE_AUTO
2796#undef ENABLE_SORT
2797
2798SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2799CHARACTER(len=*),INTENT(in) :: vect(:)
2800LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2801CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2802
2803INTEGER :: count_distinct
2804INTEGER :: i, j, dim
2805LOGICAL :: lback
2806
2807dim = SIZE(pack_distinct)
2808IF (PRESENT(back)) THEN
2809 lback = back
2810ELSE
2811 lback = .false.
2812ENDIF
2813count_distinct = 0
2814
2815IF (PRESENT (mask)) THEN
2816 IF (lback) THEN
2817 vectm1: DO i = 1, SIZE(vect)
2818 IF (.NOT.mask(i)) cycle vectm1
2819! DO j = i-1, 1, -1
2820! IF (vect(j) == vect(i)) CYCLE vectm1
2821 DO j = count_distinct, 1, -1
2822 IF (pack_distinct(j) == vect(i)) cycle vectm1
2823 ENDDO
2824 count_distinct = count_distinct + 1
2825 IF (count_distinct > dim) EXIT
2826 pack_distinct(count_distinct) = vect(i)
2827 ENDDO vectm1
2828 ELSE
2829 vectm2: DO i = 1, SIZE(vect)
2830 IF (.NOT.mask(i)) cycle vectm2
2831! DO j = 1, i-1
2832! IF (vect(j) == vect(i)) CYCLE vectm2
2833 DO j = 1, count_distinct
2834 IF (pack_distinct(j) == vect(i)) cycle vectm2
2835 ENDDO
2836 count_distinct = count_distinct + 1
2837 IF (count_distinct > dim) EXIT
2838 pack_distinct(count_distinct) = vect(i)
2839 ENDDO vectm2
2840 ENDIF
2841ELSE
2842 IF (lback) THEN
2843 vect1: DO i = 1, SIZE(vect)
2844! DO j = i-1, 1, -1
2845! IF (vect(j) == vect(i)) CYCLE vect1
2846 DO j = count_distinct, 1, -1
2847 IF (pack_distinct(j) == vect(i)) cycle vect1
2848 ENDDO
2849 count_distinct = count_distinct + 1
2850 IF (count_distinct > dim) EXIT
2851 pack_distinct(count_distinct) = vect(i)
2852 ENDDO vect1
2853 ELSE
2854 vect2: DO i = 1, SIZE(vect)
2855! DO j = 1, i-1
2856! IF (vect(j) == vect(i)) CYCLE vect2
2857 DO j = 1, count_distinct
2858 IF (pack_distinct(j) == vect(i)) cycle vect2
2859 ENDDO
2860 count_distinct = count_distinct + 1
2861 IF (count_distinct > dim) EXIT
2862 pack_distinct(count_distinct) = vect(i)
2863 ENDDO vect2
2864 ENDIF
2865ENDIF
2866
2867END SUBROUTINE pack_distinct_c
2868
2870FUNCTION map(mask) RESULT(mapidx)
2871LOGICAL,INTENT(in) :: mask(:)
2872INTEGER :: mapidx(count(mask))
2873
2874INTEGER :: i,j
2875
2876j = 0
2877DO i=1, SIZE(mask)
2878 j = j + 1
2879 IF (mask(i)) mapidx(j)=i
2880ENDDO
2881
2882END FUNCTION map
2883
2884#define ARRAYOF_ORIGEQ 1
2885
2886#undef ARRAYOF_ORIGTYPE
2887#undef ARRAYOF_TYPE
2888#define ARRAYOF_ORIGTYPE INTEGER
2889#define ARRAYOF_TYPE arrayof_integer
2890#include "arrayof_post.F90"
2891
2892#undef ARRAYOF_ORIGTYPE
2893#undef ARRAYOF_TYPE
2894#define ARRAYOF_ORIGTYPE REAL
2895#define ARRAYOF_TYPE arrayof_real
2896#include "arrayof_post.F90"
2897
2898#undef ARRAYOF_ORIGTYPE
2899#undef ARRAYOF_TYPE
2900#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2901#define ARRAYOF_TYPE arrayof_doubleprecision
2902#include "arrayof_post.F90"
2903
2904#undef ARRAYOF_ORIGEQ
2905
2906#undef ARRAYOF_ORIGTYPE
2907#undef ARRAYOF_TYPE
2908#define ARRAYOF_ORIGTYPE LOGICAL
2909#define ARRAYOF_TYPE arrayof_logical
2910#include "arrayof_post.F90"
2911
2912END 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.