libsim Versione 7.1.11

◆ sort_r()

subroutine sort_r ( real, dimension (:), intent(inout)  xdont)
private

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.

Parametri
[in,out]xdontvector to sort inline

Definizione alla linea 2821 del file array_utilities.F90.

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