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