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