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