libsim Versione 7.2.4

◆ 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 2616 del file array_utilities.F90.

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