libsim Versione 7.1.11
|
◆ sort_d()
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 3986 del file array_utilities.F90. 3987! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3988! authors:
3989! Davide Cesari <dcesari@arpa.emr.it>
3990! Paolo Patruno <ppatruno@arpa.emr.it>
3991
3992! This program is free software; you can redistribute it and/or
3993! modify it under the terms of the GNU General Public License as
3994! published by the Free Software Foundation; either version 2 of
3995! the License, or (at your option) any later version.
3996
3997! This program is distributed in the hope that it will be useful,
3998! but WITHOUT ANY WARRANTY; without even the implied warranty of
3999! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4000! GNU General Public License for more details.
4001
4002! You should have received a copy of the GNU General Public License
4003! along with this program. If not, see <http://www.gnu.org/licenses/>.
4004
4005
4006
4009#include "config.h"
4011
4012IMPLICIT NONE
4013
4014! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4015!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4016
4017#undef VOL7D_POLY_TYPE_AUTO
4018
4019#undef VOL7D_POLY_TYPE
4020#undef VOL7D_POLY_TYPES
4021#define VOL7D_POLY_TYPE INTEGER
4022#define VOL7D_POLY_TYPES _i
4023#define ENABLE_SORT
4024#include "array_utilities_pre.F90"
4025#undef ENABLE_SORT
4026
4027#undef VOL7D_POLY_TYPE
4028#undef VOL7D_POLY_TYPES
4029#define VOL7D_POLY_TYPE REAL
4030#define VOL7D_POLY_TYPES _r
4031#define ENABLE_SORT
4032#include "array_utilities_pre.F90"
4033#undef ENABLE_SORT
4034
4035#undef VOL7D_POLY_TYPE
4036#undef VOL7D_POLY_TYPES
4037#define VOL7D_POLY_TYPE DOUBLEPRECISION
4038#define VOL7D_POLY_TYPES _d
4039#define ENABLE_SORT
4040#include "array_utilities_pre.F90"
4041#undef ENABLE_SORT
4042
4043#define VOL7D_NO_PACK
4044#undef VOL7D_POLY_TYPE
4045#undef VOL7D_POLY_TYPES
4046#define VOL7D_POLY_TYPE CHARACTER(len=*)
4047#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4048#define VOL7D_POLY_TYPES _c
4049#define ENABLE_SORT
4050#include "array_utilities_pre.F90"
4051#undef VOL7D_POLY_TYPE_AUTO
4052#undef ENABLE_SORT
4053
4054
4055#define ARRAYOF_ORIGEQ 1
4056
4057#define ARRAYOF_ORIGTYPE INTEGER
4058#define ARRAYOF_TYPE arrayof_integer
4059#include "arrayof_pre.F90"
4060
4061#undef ARRAYOF_ORIGTYPE
4062#undef ARRAYOF_TYPE
4063#define ARRAYOF_ORIGTYPE REAL
4064#define ARRAYOF_TYPE arrayof_real
4065#include "arrayof_pre.F90"
4066
4067#undef ARRAYOF_ORIGTYPE
4068#undef ARRAYOF_TYPE
4069#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4070#define ARRAYOF_TYPE arrayof_doubleprecision
4071#include "arrayof_pre.F90"
4072
4073#undef ARRAYOF_ORIGEQ
4074
4075#undef ARRAYOF_ORIGTYPE
4076#undef ARRAYOF_TYPE
4077#define ARRAYOF_ORIGTYPE LOGICAL
4078#define ARRAYOF_TYPE arrayof_logical
4079#include "arrayof_pre.F90"
4080
4081PRIVATE
4082! from arrayof
4084PUBLIC insert_unique, append_unique
4085
4087 count_distinct_sorted, pack_distinct_sorted, &
4088 count_distinct, pack_distinct, count_and_pack_distinct, &
4089 map_distinct, map_inv_distinct, &
4090 firsttrue, lasttrue, pack_distinct_c, map
4091
4092CONTAINS
4093
4094
4097FUNCTION firsttrue(v) RESULT(i)
4098LOGICAL,INTENT(in) :: v(:)
4099INTEGER :: i
4100
4101DO i = 1, SIZE(v)
4102 IF (v(i)) RETURN
4103ENDDO
4104i = 0
4105
4106END FUNCTION firsttrue
4107
4108
4111FUNCTION lasttrue(v) RESULT(i)
4112LOGICAL,INTENT(in) :: v(:)
4113INTEGER :: i
4114
4115DO i = SIZE(v), 1, -1
4116 IF (v(i)) RETURN
4117ENDDO
4118
4119END FUNCTION lasttrue
4120
4121
4122! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4123#undef VOL7D_POLY_TYPE_AUTO
4124#undef VOL7D_NO_PACK
4125
4126#undef VOL7D_POLY_TYPE
4127#undef VOL7D_POLY_TYPES
4128#define VOL7D_POLY_TYPE INTEGER
4129#define VOL7D_POLY_TYPES _i
4130#define ENABLE_SORT
4131#include "array_utilities_inc.F90"
4132#undef ENABLE_SORT
4133
4134#undef VOL7D_POLY_TYPE
4135#undef VOL7D_POLY_TYPES
4136#define VOL7D_POLY_TYPE REAL
4137#define VOL7D_POLY_TYPES _r
4138#define ENABLE_SORT
4139#include "array_utilities_inc.F90"
4140#undef ENABLE_SORT
4141
4142#undef VOL7D_POLY_TYPE
4143#undef VOL7D_POLY_TYPES
4144#define VOL7D_POLY_TYPE DOUBLEPRECISION
4145#define VOL7D_POLY_TYPES _d
4146#define ENABLE_SORT
4147#include "array_utilities_inc.F90"
4148#undef ENABLE_SORT
4149
4150#define VOL7D_NO_PACK
4151#undef VOL7D_POLY_TYPE
4152#undef VOL7D_POLY_TYPES
4153#define VOL7D_POLY_TYPE CHARACTER(len=*)
4154#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4155#define VOL7D_POLY_TYPES _c
4156#define ENABLE_SORT
4157#include "array_utilities_inc.F90"
4158#undef VOL7D_POLY_TYPE_AUTO
4159#undef ENABLE_SORT
4160
4161SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
4162CHARACTER(len=*),INTENT(in) :: vect(:)
4163LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
4164CHARACTER(len=LEN(vect)) :: pack_distinct(:)
4165
4166INTEGER :: count_distinct
4167INTEGER :: i, j, dim
4168LOGICAL :: lback
4169
4170dim = SIZE(pack_distinct)
4171IF (PRESENT(back)) THEN
4172 lback = back
4173ELSE
4174 lback = .false.
4175ENDIF
4176count_distinct = 0
4177
4178IF (PRESENT (mask)) THEN
4179 IF (lback) THEN
4180 vectm1: DO i = 1, SIZE(vect)
4181 IF (.NOT.mask(i)) cycle vectm1
4182! DO j = i-1, 1, -1
4183! IF (vect(j) == vect(i)) CYCLE vectm1
4184 DO j = count_distinct, 1, -1
4185 IF (pack_distinct(j) == vect(i)) cycle vectm1
4186 ENDDO
4187 count_distinct = count_distinct + 1
4188 IF (count_distinct > dim) EXIT
4189 pack_distinct(count_distinct) = vect(i)
4190 ENDDO vectm1
4191 ELSE
4192 vectm2: DO i = 1, SIZE(vect)
4193 IF (.NOT.mask(i)) cycle vectm2
4194! DO j = 1, i-1
4195! IF (vect(j) == vect(i)) CYCLE vectm2
4196 DO j = 1, count_distinct
4197 IF (pack_distinct(j) == vect(i)) cycle vectm2
4198 ENDDO
4199 count_distinct = count_distinct + 1
4200 IF (count_distinct > dim) EXIT
4201 pack_distinct(count_distinct) = vect(i)
4202 ENDDO vectm2
4203 ENDIF
4204ELSE
4205 IF (lback) THEN
4206 vect1: DO i = 1, SIZE(vect)
4207! DO j = i-1, 1, -1
4208! IF (vect(j) == vect(i)) CYCLE vect1
4209 DO j = count_distinct, 1, -1
4210 IF (pack_distinct(j) == vect(i)) cycle vect1
4211 ENDDO
4212 count_distinct = count_distinct + 1
4213 IF (count_distinct > dim) EXIT
4214 pack_distinct(count_distinct) = vect(i)
4215 ENDDO vect1
4216 ELSE
4217 vect2: DO i = 1, SIZE(vect)
4218! DO j = 1, i-1
4219! IF (vect(j) == vect(i)) CYCLE vect2
4220 DO j = 1, count_distinct
4221 IF (pack_distinct(j) == vect(i)) cycle vect2
4222 ENDDO
4223 count_distinct = count_distinct + 1
4224 IF (count_distinct > dim) EXIT
4225 pack_distinct(count_distinct) = vect(i)
4226 ENDDO vect2
4227 ENDIF
4228ENDIF
4229
4230END SUBROUTINE pack_distinct_c
4231
4233FUNCTION map(mask) RESULT(mapidx)
4234LOGICAL,INTENT(in) :: mask(:)
4235INTEGER :: mapidx(count(mask))
4236
4237INTEGER :: i,j
4238
4239j = 0
4240DO i=1, SIZE(mask)
4241 j = j + 1
4242 IF (mask(i)) mapidx(j)=i
4243ENDDO
4244
4245END FUNCTION map
4246
4247#define ARRAYOF_ORIGEQ 1
4248
4249#undef ARRAYOF_ORIGTYPE
4250#undef ARRAYOF_TYPE
4251#define ARRAYOF_ORIGTYPE INTEGER
4252#define ARRAYOF_TYPE arrayof_integer
4253#include "arrayof_post.F90"
4254
4255#undef ARRAYOF_ORIGTYPE
4256#undef ARRAYOF_TYPE
4257#define ARRAYOF_ORIGTYPE REAL
4258#define ARRAYOF_TYPE arrayof_real
4259#include "arrayof_post.F90"
4260
4261#undef ARRAYOF_ORIGTYPE
4262#undef ARRAYOF_TYPE
4263#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4264#define ARRAYOF_TYPE arrayof_doubleprecision
4265#include "arrayof_post.F90"
4266
4267#undef ARRAYOF_ORIGEQ
4268
4269#undef ARRAYOF_ORIGTYPE
4270#undef ARRAYOF_TYPE
4271#define ARRAYOF_ORIGTYPE LOGICAL
4272#define ARRAYOF_TYPE arrayof_logical
4273#include "arrayof_post.F90"
4274
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 |