libsim Versione 7.2.6
|
◆ sort_r()
Sorts inline into ascending order - Quicksort Quicksort chooses a "pivot" in the set, and explores the array from both ends, looking for a value > pivot with the increasing index, for a value <= pivot with the decreasing index, and swapping them when it has found one of each. The array is then subdivided in 2 ([3]) subsets: { values <= pivot} {pivot} {values > pivot} One then call recursively the program to sort each subset. When the size of the subarray is small enough or the maximum level of recursion is gained, one uses an insertion sort that is faster for very small sets.
Definizione alla linea 2815 del file array_utilities.F90. 2816! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2817! authors:
2818! Davide Cesari <dcesari@arpa.emr.it>
2819! Paolo Patruno <ppatruno@arpa.emr.it>
2820
2821! This program is free software; you can redistribute it and/or
2822! modify it under the terms of the GNU General Public License as
2823! published by the Free Software Foundation; either version 2 of
2824! the License, or (at your option) any later version.
2825
2826! This program is distributed in the hope that it will be useful,
2827! but WITHOUT ANY WARRANTY; without even the implied warranty of
2828! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2829! GNU General Public License for more details.
2830
2831! You should have received a copy of the GNU General Public License
2832! along with this program. If not, see <http://www.gnu.org/licenses/>.
2833
2834
2835
2836!> This module defines usefull general purpose function and subroutine
2837!!\ingroup base
2838#include "config.h"
2840
2841IMPLICIT NONE
2842
2843! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2844!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2845
2846#undef VOL7D_POLY_TYPE_AUTO
2847
2848#undef VOL7D_POLY_TYPE
2849#undef VOL7D_POLY_TYPES
2850#define VOL7D_POLY_TYPE INTEGER
2851#define VOL7D_POLY_TYPES _i
2852#define ENABLE_SORT
2853#include "array_utilities_pre.F90"
2854#undef ENABLE_SORT
2855
2856#undef VOL7D_POLY_TYPE
2857#undef VOL7D_POLY_TYPES
2858#define VOL7D_POLY_TYPE REAL
2859#define VOL7D_POLY_TYPES _r
2860#define ENABLE_SORT
2861#include "array_utilities_pre.F90"
2862#undef ENABLE_SORT
2863
2864#undef VOL7D_POLY_TYPE
2865#undef VOL7D_POLY_TYPES
2866#define VOL7D_POLY_TYPE DOUBLEPRECISION
2867#define VOL7D_POLY_TYPES _d
2868#define ENABLE_SORT
2869#include "array_utilities_pre.F90"
2870#undef ENABLE_SORT
2871
2872#define VOL7D_NO_PACK
2873#undef VOL7D_POLY_TYPE
2874#undef VOL7D_POLY_TYPES
2875#define VOL7D_POLY_TYPE CHARACTER(len=*)
2876#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2877#define VOL7D_POLY_TYPES _c
2878#define ENABLE_SORT
2879#include "array_utilities_pre.F90"
2880#undef VOL7D_POLY_TYPE_AUTO
2881#undef ENABLE_SORT
2882
2883
2884#define ARRAYOF_ORIGEQ 1
2885
2886#define ARRAYOF_ORIGTYPE INTEGER
2887#define ARRAYOF_TYPE arrayof_integer
2888#include "arrayof_pre.F90"
2889
2890#undef ARRAYOF_ORIGTYPE
2891#undef ARRAYOF_TYPE
2892#define ARRAYOF_ORIGTYPE REAL
2893#define ARRAYOF_TYPE arrayof_real
2894#include "arrayof_pre.F90"
2895
2896#undef ARRAYOF_ORIGTYPE
2897#undef ARRAYOF_TYPE
2898#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2899#define ARRAYOF_TYPE arrayof_doubleprecision
2900#include "arrayof_pre.F90"
2901
2902#undef ARRAYOF_ORIGEQ
2903
2904#undef ARRAYOF_ORIGTYPE
2905#undef ARRAYOF_TYPE
2906#define ARRAYOF_ORIGTYPE LOGICAL
2907#define ARRAYOF_TYPE arrayof_logical
2908#include "arrayof_pre.F90"
2909
2910PRIVATE
2911! from arrayof
2913PUBLIC insert_unique, append_unique
2914
2916 count_distinct_sorted, pack_distinct_sorted, &
2917 count_distinct, pack_distinct, count_and_pack_distinct, &
2918 map_distinct, map_inv_distinct, &
2919 firsttrue, lasttrue, pack_distinct_c, map
2920
2921CONTAINS
2922
2923
2924!> Return the index ot the first true element of the input logical array \a v.
2925!! If no \c .TRUE. elements are found, it returns 0.
2926FUNCTION firsttrue(v) RESULT(i)
2927LOGICAL,INTENT(in) :: v(:) !< logical array to test
2928INTEGER :: i
2929
2930DO i = 1, SIZE(v)
2931 IF (v(i)) RETURN
2932ENDDO
2933i = 0
2934
2935END FUNCTION firsttrue
2936
2937
2938!> Return the index ot the last true element of the input logical array \a v.
2939!! If no \c .TRUE. elements are found, it returns 0.
2940FUNCTION lasttrue(v) RESULT(i)
2941LOGICAL,INTENT(in) :: v(:) !< logical array to test
2942INTEGER :: i
2943
2944DO i = SIZE(v), 1, -1
2945 IF (v(i)) RETURN
2946ENDDO
2947
2948END FUNCTION lasttrue
2949
2950
2951! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2952#undef VOL7D_POLY_TYPE_AUTO
2953#undef VOL7D_NO_PACK
2954
2955#undef VOL7D_POLY_TYPE
2956#undef VOL7D_POLY_TYPES
2957#define VOL7D_POLY_TYPE INTEGER
2958#define VOL7D_POLY_TYPES _i
2959#define ENABLE_SORT
2960#include "array_utilities_inc.F90"
2961#undef ENABLE_SORT
2962
2963#undef VOL7D_POLY_TYPE
2964#undef VOL7D_POLY_TYPES
2965#define VOL7D_POLY_TYPE REAL
2966#define VOL7D_POLY_TYPES _r
2967#define ENABLE_SORT
2968#include "array_utilities_inc.F90"
2969#undef ENABLE_SORT
2970
2971#undef VOL7D_POLY_TYPE
2972#undef VOL7D_POLY_TYPES
2973#define VOL7D_POLY_TYPE DOUBLEPRECISION
2974#define VOL7D_POLY_TYPES _d
2975#define ENABLE_SORT
2976#include "array_utilities_inc.F90"
2977#undef ENABLE_SORT
2978
2979#define VOL7D_NO_PACK
2980#undef VOL7D_POLY_TYPE
2981#undef VOL7D_POLY_TYPES
2982#define VOL7D_POLY_TYPE CHARACTER(len=*)
2983#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2984#define VOL7D_POLY_TYPES _c
2985#define ENABLE_SORT
2986#include "array_utilities_inc.F90"
2987#undef VOL7D_POLY_TYPE_AUTO
2988#undef ENABLE_SORT
2989
2990SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2991CHARACTER(len=*),INTENT(in) :: vect(:)
2992LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2993CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2994
2995INTEGER :: count_distinct
2996INTEGER :: i, j, dim
2997LOGICAL :: lback
2998
2999dim = SIZE(pack_distinct)
3000IF (PRESENT(back)) THEN
3001 lback = back
3002ELSE
3003 lback = .false.
3004ENDIF
3005count_distinct = 0
3006
3007IF (PRESENT (mask)) THEN
3008 IF (lback) THEN
3009 vectm1: DO i = 1, SIZE(vect)
3010 IF (.NOT.mask(i)) cycle vectm1
3011! DO j = i-1, 1, -1
3012! IF (vect(j) == vect(i)) CYCLE vectm1
3013 DO j = count_distinct, 1, -1
3014 IF (pack_distinct(j) == vect(i)) cycle vectm1
3015 ENDDO
3016 count_distinct = count_distinct + 1
3017 IF (count_distinct > dim) EXIT
3018 pack_distinct(count_distinct) = vect(i)
3019 ENDDO vectm1
3020 ELSE
3021 vectm2: DO i = 1, SIZE(vect)
3022 IF (.NOT.mask(i)) cycle vectm2
3023! DO j = 1, i-1
3024! IF (vect(j) == vect(i)) CYCLE vectm2
3025 DO j = 1, count_distinct
3026 IF (pack_distinct(j) == vect(i)) cycle vectm2
3027 ENDDO
3028 count_distinct = count_distinct + 1
3029 IF (count_distinct > dim) EXIT
3030 pack_distinct(count_distinct) = vect(i)
3031 ENDDO vectm2
3032 ENDIF
3033ELSE
3034 IF (lback) THEN
3035 vect1: DO i = 1, SIZE(vect)
3036! DO j = i-1, 1, -1
3037! IF (vect(j) == vect(i)) CYCLE vect1
3038 DO j = count_distinct, 1, -1
3039 IF (pack_distinct(j) == vect(i)) cycle vect1
3040 ENDDO
3041 count_distinct = count_distinct + 1
3042 IF (count_distinct > dim) EXIT
3043 pack_distinct(count_distinct) = vect(i)
3044 ENDDO vect1
3045 ELSE
3046 vect2: DO i = 1, SIZE(vect)
3047! DO j = 1, i-1
3048! IF (vect(j) == vect(i)) CYCLE vect2
3049 DO j = 1, count_distinct
3050 IF (pack_distinct(j) == vect(i)) cycle vect2
3051 ENDDO
3052 count_distinct = count_distinct + 1
3053 IF (count_distinct > dim) EXIT
3054 pack_distinct(count_distinct) = vect(i)
3055 ENDDO vect2
3056 ENDIF
3057ENDIF
3058
3059END SUBROUTINE pack_distinct_c
3060
3061!> Return the index of the array only where the mask is true
3062FUNCTION map(mask) RESULT(mapidx)
3063LOGICAL,INTENT(in) :: mask(:)
3064INTEGER :: mapidx(count(mask))
3065
3066INTEGER :: i,j
3067
3068j = 0
3069DO i=1, SIZE(mask)
3070 j = j + 1
3071 IF (mask(i)) mapidx(j)=i
3072ENDDO
3073
3074END FUNCTION map
3075
3076#define ARRAYOF_ORIGEQ 1
3077
3078#undef ARRAYOF_ORIGTYPE
3079#undef ARRAYOF_TYPE
3080#define ARRAYOF_ORIGTYPE INTEGER
3081#define ARRAYOF_TYPE arrayof_integer
3082#include "arrayof_post.F90"
3083
3084#undef ARRAYOF_ORIGTYPE
3085#undef ARRAYOF_TYPE
3086#define ARRAYOF_ORIGTYPE REAL
3087#define ARRAYOF_TYPE arrayof_real
3088#include "arrayof_post.F90"
3089
3090#undef ARRAYOF_ORIGTYPE
3091#undef ARRAYOF_TYPE
3092#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3093#define ARRAYOF_TYPE arrayof_doubleprecision
3094#include "arrayof_post.F90"
3095
3096#undef ARRAYOF_ORIGEQ
3097
3098#undef ARRAYOF_ORIGTYPE
3099#undef ARRAYOF_TYPE
3100#define ARRAYOF_ORIGTYPE LOGICAL
3101#define ARRAYOF_TYPE arrayof_logical
3102#include "arrayof_post.F90"
3103
Quick method to append an element to the array. Definition array_utilities.F90:508 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 |