libsim Versione 7.2.0
|
◆ index_sorted_r()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 2693 del file array_utilities.F90. 2695! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2696! authors:
2697! Davide Cesari <dcesari@arpa.emr.it>
2698! Paolo Patruno <ppatruno@arpa.emr.it>
2699
2700! This program is free software; you can redistribute it and/or
2701! modify it under the terms of the GNU General Public License as
2702! published by the Free Software Foundation; either version 2 of
2703! the License, or (at your option) any later version.
2704
2705! This program is distributed in the hope that it will be useful,
2706! but WITHOUT ANY WARRANTY; without even the implied warranty of
2707! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2708! GNU General Public License for more details.
2709
2710! You should have received a copy of the GNU General Public License
2711! along with this program. If not, see <http://www.gnu.org/licenses/>.
2712
2713
2714
2717#include "config.h"
2719
2720IMPLICIT NONE
2721
2722! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2723!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2724
2725#undef VOL7D_POLY_TYPE_AUTO
2726
2727#undef VOL7D_POLY_TYPE
2728#undef VOL7D_POLY_TYPES
2729#define VOL7D_POLY_TYPE INTEGER
2730#define VOL7D_POLY_TYPES _i
2731#define ENABLE_SORT
2732#include "array_utilities_pre.F90"
2733#undef ENABLE_SORT
2734
2735#undef VOL7D_POLY_TYPE
2736#undef VOL7D_POLY_TYPES
2737#define VOL7D_POLY_TYPE REAL
2738#define VOL7D_POLY_TYPES _r
2739#define ENABLE_SORT
2740#include "array_utilities_pre.F90"
2741#undef ENABLE_SORT
2742
2743#undef VOL7D_POLY_TYPE
2744#undef VOL7D_POLY_TYPES
2745#define VOL7D_POLY_TYPE DOUBLEPRECISION
2746#define VOL7D_POLY_TYPES _d
2747#define ENABLE_SORT
2748#include "array_utilities_pre.F90"
2749#undef ENABLE_SORT
2750
2751#define VOL7D_NO_PACK
2752#undef VOL7D_POLY_TYPE
2753#undef VOL7D_POLY_TYPES
2754#define VOL7D_POLY_TYPE CHARACTER(len=*)
2755#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2756#define VOL7D_POLY_TYPES _c
2757#define ENABLE_SORT
2758#include "array_utilities_pre.F90"
2759#undef VOL7D_POLY_TYPE_AUTO
2760#undef ENABLE_SORT
2761
2762
2763#define ARRAYOF_ORIGEQ 1
2764
2765#define ARRAYOF_ORIGTYPE INTEGER
2766#define ARRAYOF_TYPE arrayof_integer
2767#include "arrayof_pre.F90"
2768
2769#undef ARRAYOF_ORIGTYPE
2770#undef ARRAYOF_TYPE
2771#define ARRAYOF_ORIGTYPE REAL
2772#define ARRAYOF_TYPE arrayof_real
2773#include "arrayof_pre.F90"
2774
2775#undef ARRAYOF_ORIGTYPE
2776#undef ARRAYOF_TYPE
2777#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2778#define ARRAYOF_TYPE arrayof_doubleprecision
2779#include "arrayof_pre.F90"
2780
2781#undef ARRAYOF_ORIGEQ
2782
2783#undef ARRAYOF_ORIGTYPE
2784#undef ARRAYOF_TYPE
2785#define ARRAYOF_ORIGTYPE LOGICAL
2786#define ARRAYOF_TYPE arrayof_logical
2787#include "arrayof_pre.F90"
2788
2789PRIVATE
2790! from arrayof
2792PUBLIC insert_unique, append_unique
2793
2795 count_distinct_sorted, pack_distinct_sorted, &
2796 count_distinct, pack_distinct, count_and_pack_distinct, &
2797 map_distinct, map_inv_distinct, &
2798 firsttrue, lasttrue, pack_distinct_c, map
2799
2800CONTAINS
2801
2802
2805FUNCTION firsttrue(v) RESULT(i)
2806LOGICAL,INTENT(in) :: v(:)
2807INTEGER :: i
2808
2809DO i = 1, SIZE(v)
2810 IF (v(i)) RETURN
2811ENDDO
2812i = 0
2813
2814END FUNCTION firsttrue
2815
2816
2819FUNCTION lasttrue(v) RESULT(i)
2820LOGICAL,INTENT(in) :: v(:)
2821INTEGER :: i
2822
2823DO i = SIZE(v), 1, -1
2824 IF (v(i)) RETURN
2825ENDDO
2826
2827END FUNCTION lasttrue
2828
2829
2830! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2831#undef VOL7D_POLY_TYPE_AUTO
2832#undef VOL7D_NO_PACK
2833
2834#undef VOL7D_POLY_TYPE
2835#undef VOL7D_POLY_TYPES
2836#define VOL7D_POLY_TYPE INTEGER
2837#define VOL7D_POLY_TYPES _i
2838#define ENABLE_SORT
2839#include "array_utilities_inc.F90"
2840#undef ENABLE_SORT
2841
2842#undef VOL7D_POLY_TYPE
2843#undef VOL7D_POLY_TYPES
2844#define VOL7D_POLY_TYPE REAL
2845#define VOL7D_POLY_TYPES _r
2846#define ENABLE_SORT
2847#include "array_utilities_inc.F90"
2848#undef ENABLE_SORT
2849
2850#undef VOL7D_POLY_TYPE
2851#undef VOL7D_POLY_TYPES
2852#define VOL7D_POLY_TYPE DOUBLEPRECISION
2853#define VOL7D_POLY_TYPES _d
2854#define ENABLE_SORT
2855#include "array_utilities_inc.F90"
2856#undef ENABLE_SORT
2857
2858#define VOL7D_NO_PACK
2859#undef VOL7D_POLY_TYPE
2860#undef VOL7D_POLY_TYPES
2861#define VOL7D_POLY_TYPE CHARACTER(len=*)
2862#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2863#define VOL7D_POLY_TYPES _c
2864#define ENABLE_SORT
2865#include "array_utilities_inc.F90"
2866#undef VOL7D_POLY_TYPE_AUTO
2867#undef ENABLE_SORT
2868
2869SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2870CHARACTER(len=*),INTENT(in) :: vect(:)
2871LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2872CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2873
2874INTEGER :: count_distinct
2875INTEGER :: i, j, dim
2876LOGICAL :: lback
2877
2878dim = SIZE(pack_distinct)
2879IF (PRESENT(back)) THEN
2880 lback = back
2881ELSE
2882 lback = .false.
2883ENDIF
2884count_distinct = 0
2885
2886IF (PRESENT (mask)) THEN
2887 IF (lback) THEN
2888 vectm1: DO i = 1, SIZE(vect)
2889 IF (.NOT.mask(i)) cycle vectm1
2890! DO j = i-1, 1, -1
2891! IF (vect(j) == vect(i)) CYCLE vectm1
2892 DO j = count_distinct, 1, -1
2893 IF (pack_distinct(j) == vect(i)) cycle vectm1
2894 ENDDO
2895 count_distinct = count_distinct + 1
2896 IF (count_distinct > dim) EXIT
2897 pack_distinct(count_distinct) = vect(i)
2898 ENDDO vectm1
2899 ELSE
2900 vectm2: DO i = 1, SIZE(vect)
2901 IF (.NOT.mask(i)) cycle vectm2
2902! DO j = 1, i-1
2903! IF (vect(j) == vect(i)) CYCLE vectm2
2904 DO j = 1, count_distinct
2905 IF (pack_distinct(j) == vect(i)) cycle vectm2
2906 ENDDO
2907 count_distinct = count_distinct + 1
2908 IF (count_distinct > dim) EXIT
2909 pack_distinct(count_distinct) = vect(i)
2910 ENDDO vectm2
2911 ENDIF
2912ELSE
2913 IF (lback) THEN
2914 vect1: DO i = 1, SIZE(vect)
2915! DO j = i-1, 1, -1
2916! IF (vect(j) == vect(i)) CYCLE vect1
2917 DO j = count_distinct, 1, -1
2918 IF (pack_distinct(j) == vect(i)) cycle vect1
2919 ENDDO
2920 count_distinct = count_distinct + 1
2921 IF (count_distinct > dim) EXIT
2922 pack_distinct(count_distinct) = vect(i)
2923 ENDDO vect1
2924 ELSE
2925 vect2: DO i = 1, SIZE(vect)
2926! DO j = 1, i-1
2927! IF (vect(j) == vect(i)) CYCLE vect2
2928 DO j = 1, count_distinct
2929 IF (pack_distinct(j) == vect(i)) cycle vect2
2930 ENDDO
2931 count_distinct = count_distinct + 1
2932 IF (count_distinct > dim) EXIT
2933 pack_distinct(count_distinct) = vect(i)
2934 ENDDO vect2
2935 ENDIF
2936ENDIF
2937
2938END SUBROUTINE pack_distinct_c
2939
2941FUNCTION map(mask) RESULT(mapidx)
2942LOGICAL,INTENT(in) :: mask(:)
2943INTEGER :: mapidx(count(mask))
2944
2945INTEGER :: i,j
2946
2947j = 0
2948DO i=1, SIZE(mask)
2949 j = j + 1
2950 IF (mask(i)) mapidx(j)=i
2951ENDDO
2952
2953END FUNCTION map
2954
2955#define ARRAYOF_ORIGEQ 1
2956
2957#undef ARRAYOF_ORIGTYPE
2958#undef ARRAYOF_TYPE
2959#define ARRAYOF_ORIGTYPE INTEGER
2960#define ARRAYOF_TYPE arrayof_integer
2961#include "arrayof_post.F90"
2962
2963#undef ARRAYOF_ORIGTYPE
2964#undef ARRAYOF_TYPE
2965#define ARRAYOF_ORIGTYPE REAL
2966#define ARRAYOF_TYPE arrayof_real
2967#include "arrayof_post.F90"
2968
2969#undef ARRAYOF_ORIGTYPE
2970#undef ARRAYOF_TYPE
2971#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2972#define ARRAYOF_TYPE arrayof_doubleprecision
2973#include "arrayof_post.F90"
2974
2975#undef ARRAYOF_ORIGEQ
2976
2977#undef ARRAYOF_ORIGTYPE
2978#undef ARRAYOF_TYPE
2979#define ARRAYOF_ORIGTYPE LOGICAL
2980#define ARRAYOF_TYPE arrayof_logical
2981#include "arrayof_post.F90"
2982
Quick method to append an element to the array. Definition: array_utilities.F90:508 Destructor for finalizing an array object. Definition: array_utilities.F90:521 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:499 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:531 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:514 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:212 |