libsim Versione 7.1.11
|
◆ inssor_r()
Sorts into increasing order (Insertion sort) Sorts XDONT into increasing order (Insertion sort) This subroutine uses insertion sort. It does not use any work array and is faster when XDONT is of very small size (< 20), or already almost sorted, so it is used in a final pass when the partial quicksorting has left a sequence of small subsets and that sorting is only necessary within each subset to complete the process. Michel Olagnon - Apr. 2000 Definizione alla linea 2946 del file array_utilities.F90. 2947! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2948! authors:
2949! Davide Cesari <dcesari@arpa.emr.it>
2950! Paolo Patruno <ppatruno@arpa.emr.it>
2951
2952! This program is free software; you can redistribute it and/or
2953! modify it under the terms of the GNU General Public License as
2954! published by the Free Software Foundation; either version 2 of
2955! the License, or (at your option) any later version.
2956
2957! This program is distributed in the hope that it will be useful,
2958! but WITHOUT ANY WARRANTY; without even the implied warranty of
2959! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2960! GNU General Public License for more details.
2961
2962! You should have received a copy of the GNU General Public License
2963! along with this program. If not, see <http://www.gnu.org/licenses/>.
2964
2965
2966
2969#include "config.h"
2971
2972IMPLICIT NONE
2973
2974! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2975!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2976
2977#undef VOL7D_POLY_TYPE_AUTO
2978
2979#undef VOL7D_POLY_TYPE
2980#undef VOL7D_POLY_TYPES
2981#define VOL7D_POLY_TYPE INTEGER
2982#define VOL7D_POLY_TYPES _i
2983#define ENABLE_SORT
2984#include "array_utilities_pre.F90"
2985#undef ENABLE_SORT
2986
2987#undef VOL7D_POLY_TYPE
2988#undef VOL7D_POLY_TYPES
2989#define VOL7D_POLY_TYPE REAL
2990#define VOL7D_POLY_TYPES _r
2991#define ENABLE_SORT
2992#include "array_utilities_pre.F90"
2993#undef ENABLE_SORT
2994
2995#undef VOL7D_POLY_TYPE
2996#undef VOL7D_POLY_TYPES
2997#define VOL7D_POLY_TYPE DOUBLEPRECISION
2998#define VOL7D_POLY_TYPES _d
2999#define ENABLE_SORT
3000#include "array_utilities_pre.F90"
3001#undef ENABLE_SORT
3002
3003#define VOL7D_NO_PACK
3004#undef VOL7D_POLY_TYPE
3005#undef VOL7D_POLY_TYPES
3006#define VOL7D_POLY_TYPE CHARACTER(len=*)
3007#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3008#define VOL7D_POLY_TYPES _c
3009#define ENABLE_SORT
3010#include "array_utilities_pre.F90"
3011#undef VOL7D_POLY_TYPE_AUTO
3012#undef ENABLE_SORT
3013
3014
3015#define ARRAYOF_ORIGEQ 1
3016
3017#define ARRAYOF_ORIGTYPE INTEGER
3018#define ARRAYOF_TYPE arrayof_integer
3019#include "arrayof_pre.F90"
3020
3021#undef ARRAYOF_ORIGTYPE
3022#undef ARRAYOF_TYPE
3023#define ARRAYOF_ORIGTYPE REAL
3024#define ARRAYOF_TYPE arrayof_real
3025#include "arrayof_pre.F90"
3026
3027#undef ARRAYOF_ORIGTYPE
3028#undef ARRAYOF_TYPE
3029#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3030#define ARRAYOF_TYPE arrayof_doubleprecision
3031#include "arrayof_pre.F90"
3032
3033#undef ARRAYOF_ORIGEQ
3034
3035#undef ARRAYOF_ORIGTYPE
3036#undef ARRAYOF_TYPE
3037#define ARRAYOF_ORIGTYPE LOGICAL
3038#define ARRAYOF_TYPE arrayof_logical
3039#include "arrayof_pre.F90"
3040
3041PRIVATE
3042! from arrayof
3044PUBLIC insert_unique, append_unique
3045
3047 count_distinct_sorted, pack_distinct_sorted, &
3048 count_distinct, pack_distinct, count_and_pack_distinct, &
3049 map_distinct, map_inv_distinct, &
3050 firsttrue, lasttrue, pack_distinct_c, map
3051
3052CONTAINS
3053
3054
3057FUNCTION firsttrue(v) RESULT(i)
3058LOGICAL,INTENT(in) :: v(:)
3059INTEGER :: i
3060
3061DO i = 1, SIZE(v)
3062 IF (v(i)) RETURN
3063ENDDO
3064i = 0
3065
3066END FUNCTION firsttrue
3067
3068
3071FUNCTION lasttrue(v) RESULT(i)
3072LOGICAL,INTENT(in) :: v(:)
3073INTEGER :: i
3074
3075DO i = SIZE(v), 1, -1
3076 IF (v(i)) RETURN
3077ENDDO
3078
3079END FUNCTION lasttrue
3080
3081
3082! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
3083#undef VOL7D_POLY_TYPE_AUTO
3084#undef VOL7D_NO_PACK
3085
3086#undef VOL7D_POLY_TYPE
3087#undef VOL7D_POLY_TYPES
3088#define VOL7D_POLY_TYPE INTEGER
3089#define VOL7D_POLY_TYPES _i
3090#define ENABLE_SORT
3091#include "array_utilities_inc.F90"
3092#undef ENABLE_SORT
3093
3094#undef VOL7D_POLY_TYPE
3095#undef VOL7D_POLY_TYPES
3096#define VOL7D_POLY_TYPE REAL
3097#define VOL7D_POLY_TYPES _r
3098#define ENABLE_SORT
3099#include "array_utilities_inc.F90"
3100#undef ENABLE_SORT
3101
3102#undef VOL7D_POLY_TYPE
3103#undef VOL7D_POLY_TYPES
3104#define VOL7D_POLY_TYPE DOUBLEPRECISION
3105#define VOL7D_POLY_TYPES _d
3106#define ENABLE_SORT
3107#include "array_utilities_inc.F90"
3108#undef ENABLE_SORT
3109
3110#define VOL7D_NO_PACK
3111#undef VOL7D_POLY_TYPE
3112#undef VOL7D_POLY_TYPES
3113#define VOL7D_POLY_TYPE CHARACTER(len=*)
3114#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3115#define VOL7D_POLY_TYPES _c
3116#define ENABLE_SORT
3117#include "array_utilities_inc.F90"
3118#undef VOL7D_POLY_TYPE_AUTO
3119#undef ENABLE_SORT
3120
3121SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
3122CHARACTER(len=*),INTENT(in) :: vect(:)
3123LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
3124CHARACTER(len=LEN(vect)) :: pack_distinct(:)
3125
3126INTEGER :: count_distinct
3127INTEGER :: i, j, dim
3128LOGICAL :: lback
3129
3130dim = SIZE(pack_distinct)
3131IF (PRESENT(back)) THEN
3132 lback = back
3133ELSE
3134 lback = .false.
3135ENDIF
3136count_distinct = 0
3137
3138IF (PRESENT (mask)) THEN
3139 IF (lback) THEN
3140 vectm1: DO i = 1, SIZE(vect)
3141 IF (.NOT.mask(i)) cycle vectm1
3142! DO j = i-1, 1, -1
3143! IF (vect(j) == vect(i)) CYCLE vectm1
3144 DO j = count_distinct, 1, -1
3145 IF (pack_distinct(j) == vect(i)) cycle vectm1
3146 ENDDO
3147 count_distinct = count_distinct + 1
3148 IF (count_distinct > dim) EXIT
3149 pack_distinct(count_distinct) = vect(i)
3150 ENDDO vectm1
3151 ELSE
3152 vectm2: DO i = 1, SIZE(vect)
3153 IF (.NOT.mask(i)) cycle vectm2
3154! DO j = 1, i-1
3155! IF (vect(j) == vect(i)) CYCLE vectm2
3156 DO j = 1, count_distinct
3157 IF (pack_distinct(j) == vect(i)) cycle vectm2
3158 ENDDO
3159 count_distinct = count_distinct + 1
3160 IF (count_distinct > dim) EXIT
3161 pack_distinct(count_distinct) = vect(i)
3162 ENDDO vectm2
3163 ENDIF
3164ELSE
3165 IF (lback) THEN
3166 vect1: DO i = 1, SIZE(vect)
3167! DO j = i-1, 1, -1
3168! IF (vect(j) == vect(i)) CYCLE vect1
3169 DO j = count_distinct, 1, -1
3170 IF (pack_distinct(j) == vect(i)) cycle vect1
3171 ENDDO
3172 count_distinct = count_distinct + 1
3173 IF (count_distinct > dim) EXIT
3174 pack_distinct(count_distinct) = vect(i)
3175 ENDDO vect1
3176 ELSE
3177 vect2: DO i = 1, SIZE(vect)
3178! DO j = 1, i-1
3179! IF (vect(j) == vect(i)) CYCLE vect2
3180 DO j = 1, count_distinct
3181 IF (pack_distinct(j) == vect(i)) cycle vect2
3182 ENDDO
3183 count_distinct = count_distinct + 1
3184 IF (count_distinct > dim) EXIT
3185 pack_distinct(count_distinct) = vect(i)
3186 ENDDO vect2
3187 ENDIF
3188ENDIF
3189
3190END SUBROUTINE pack_distinct_c
3191
3193FUNCTION map(mask) RESULT(mapidx)
3194LOGICAL,INTENT(in) :: mask(:)
3195INTEGER :: mapidx(count(mask))
3196
3197INTEGER :: i,j
3198
3199j = 0
3200DO i=1, SIZE(mask)
3201 j = j + 1
3202 IF (mask(i)) mapidx(j)=i
3203ENDDO
3204
3205END FUNCTION map
3206
3207#define ARRAYOF_ORIGEQ 1
3208
3209#undef ARRAYOF_ORIGTYPE
3210#undef ARRAYOF_TYPE
3211#define ARRAYOF_ORIGTYPE INTEGER
3212#define ARRAYOF_TYPE arrayof_integer
3213#include "arrayof_post.F90"
3214
3215#undef ARRAYOF_ORIGTYPE
3216#undef ARRAYOF_TYPE
3217#define ARRAYOF_ORIGTYPE REAL
3218#define ARRAYOF_TYPE arrayof_real
3219#include "arrayof_post.F90"
3220
3221#undef ARRAYOF_ORIGTYPE
3222#undef ARRAYOF_TYPE
3223#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3224#define ARRAYOF_TYPE arrayof_doubleprecision
3225#include "arrayof_post.F90"
3226
3227#undef ARRAYOF_ORIGEQ
3228
3229#undef ARRAYOF_ORIGTYPE
3230#undef ARRAYOF_TYPE
3231#define ARRAYOF_ORIGTYPE LOGICAL
3232#define ARRAYOF_TYPE arrayof_logical
3233#include "arrayof_post.F90"
3234
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 |