libsim Versione 7.2.0
|
◆ inssor_d()
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 4105 del file array_utilities.F90. 4106! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4107! authors:
4108! Davide Cesari <dcesari@arpa.emr.it>
4109! Paolo Patruno <ppatruno@arpa.emr.it>
4110
4111! This program is free software; you can redistribute it and/or
4112! modify it under the terms of the GNU General Public License as
4113! published by the Free Software Foundation; either version 2 of
4114! the License, or (at your option) any later version.
4115
4116! This program is distributed in the hope that it will be useful,
4117! but WITHOUT ANY WARRANTY; without even the implied warranty of
4118! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4119! GNU General Public License for more details.
4120
4121! You should have received a copy of the GNU General Public License
4122! along with this program. If not, see <http://www.gnu.org/licenses/>.
4123
4124
4125
4128#include "config.h"
4130
4131IMPLICIT NONE
4132
4133! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4134!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4135
4136#undef VOL7D_POLY_TYPE_AUTO
4137
4138#undef VOL7D_POLY_TYPE
4139#undef VOL7D_POLY_TYPES
4140#define VOL7D_POLY_TYPE INTEGER
4141#define VOL7D_POLY_TYPES _i
4142#define ENABLE_SORT
4143#include "array_utilities_pre.F90"
4144#undef ENABLE_SORT
4145
4146#undef VOL7D_POLY_TYPE
4147#undef VOL7D_POLY_TYPES
4148#define VOL7D_POLY_TYPE REAL
4149#define VOL7D_POLY_TYPES _r
4150#define ENABLE_SORT
4151#include "array_utilities_pre.F90"
4152#undef ENABLE_SORT
4153
4154#undef VOL7D_POLY_TYPE
4155#undef VOL7D_POLY_TYPES
4156#define VOL7D_POLY_TYPE DOUBLEPRECISION
4157#define VOL7D_POLY_TYPES _d
4158#define ENABLE_SORT
4159#include "array_utilities_pre.F90"
4160#undef ENABLE_SORT
4161
4162#define VOL7D_NO_PACK
4163#undef VOL7D_POLY_TYPE
4164#undef VOL7D_POLY_TYPES
4165#define VOL7D_POLY_TYPE CHARACTER(len=*)
4166#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4167#define VOL7D_POLY_TYPES _c
4168#define ENABLE_SORT
4169#include "array_utilities_pre.F90"
4170#undef VOL7D_POLY_TYPE_AUTO
4171#undef ENABLE_SORT
4172
4173
4174#define ARRAYOF_ORIGEQ 1
4175
4176#define ARRAYOF_ORIGTYPE INTEGER
4177#define ARRAYOF_TYPE arrayof_integer
4178#include "arrayof_pre.F90"
4179
4180#undef ARRAYOF_ORIGTYPE
4181#undef ARRAYOF_TYPE
4182#define ARRAYOF_ORIGTYPE REAL
4183#define ARRAYOF_TYPE arrayof_real
4184#include "arrayof_pre.F90"
4185
4186#undef ARRAYOF_ORIGTYPE
4187#undef ARRAYOF_TYPE
4188#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4189#define ARRAYOF_TYPE arrayof_doubleprecision
4190#include "arrayof_pre.F90"
4191
4192#undef ARRAYOF_ORIGEQ
4193
4194#undef ARRAYOF_ORIGTYPE
4195#undef ARRAYOF_TYPE
4196#define ARRAYOF_ORIGTYPE LOGICAL
4197#define ARRAYOF_TYPE arrayof_logical
4198#include "arrayof_pre.F90"
4199
4200PRIVATE
4201! from arrayof
4203PUBLIC insert_unique, append_unique
4204
4206 count_distinct_sorted, pack_distinct_sorted, &
4207 count_distinct, pack_distinct, count_and_pack_distinct, &
4208 map_distinct, map_inv_distinct, &
4209 firsttrue, lasttrue, pack_distinct_c, map
4210
4211CONTAINS
4212
4213
4216FUNCTION firsttrue(v) RESULT(i)
4217LOGICAL,INTENT(in) :: v(:)
4218INTEGER :: i
4219
4220DO i = 1, SIZE(v)
4221 IF (v(i)) RETURN
4222ENDDO
4223i = 0
4224
4225END FUNCTION firsttrue
4226
4227
4230FUNCTION lasttrue(v) RESULT(i)
4231LOGICAL,INTENT(in) :: v(:)
4232INTEGER :: i
4233
4234DO i = SIZE(v), 1, -1
4235 IF (v(i)) RETURN
4236ENDDO
4237
4238END FUNCTION lasttrue
4239
4240
4241! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4242#undef VOL7D_POLY_TYPE_AUTO
4243#undef VOL7D_NO_PACK
4244
4245#undef VOL7D_POLY_TYPE
4246#undef VOL7D_POLY_TYPES
4247#define VOL7D_POLY_TYPE INTEGER
4248#define VOL7D_POLY_TYPES _i
4249#define ENABLE_SORT
4250#include "array_utilities_inc.F90"
4251#undef ENABLE_SORT
4252
4253#undef VOL7D_POLY_TYPE
4254#undef VOL7D_POLY_TYPES
4255#define VOL7D_POLY_TYPE REAL
4256#define VOL7D_POLY_TYPES _r
4257#define ENABLE_SORT
4258#include "array_utilities_inc.F90"
4259#undef ENABLE_SORT
4260
4261#undef VOL7D_POLY_TYPE
4262#undef VOL7D_POLY_TYPES
4263#define VOL7D_POLY_TYPE DOUBLEPRECISION
4264#define VOL7D_POLY_TYPES _d
4265#define ENABLE_SORT
4266#include "array_utilities_inc.F90"
4267#undef ENABLE_SORT
4268
4269#define VOL7D_NO_PACK
4270#undef VOL7D_POLY_TYPE
4271#undef VOL7D_POLY_TYPES
4272#define VOL7D_POLY_TYPE CHARACTER(len=*)
4273#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4274#define VOL7D_POLY_TYPES _c
4275#define ENABLE_SORT
4276#include "array_utilities_inc.F90"
4277#undef VOL7D_POLY_TYPE_AUTO
4278#undef ENABLE_SORT
4279
4280SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
4281CHARACTER(len=*),INTENT(in) :: vect(:)
4282LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
4283CHARACTER(len=LEN(vect)) :: pack_distinct(:)
4284
4285INTEGER :: count_distinct
4286INTEGER :: i, j, dim
4287LOGICAL :: lback
4288
4289dim = SIZE(pack_distinct)
4290IF (PRESENT(back)) THEN
4291 lback = back
4292ELSE
4293 lback = .false.
4294ENDIF
4295count_distinct = 0
4296
4297IF (PRESENT (mask)) THEN
4298 IF (lback) THEN
4299 vectm1: DO i = 1, SIZE(vect)
4300 IF (.NOT.mask(i)) cycle vectm1
4301! DO j = i-1, 1, -1
4302! IF (vect(j) == vect(i)) CYCLE vectm1
4303 DO j = count_distinct, 1, -1
4304 IF (pack_distinct(j) == vect(i)) cycle vectm1
4305 ENDDO
4306 count_distinct = count_distinct + 1
4307 IF (count_distinct > dim) EXIT
4308 pack_distinct(count_distinct) = vect(i)
4309 ENDDO vectm1
4310 ELSE
4311 vectm2: DO i = 1, SIZE(vect)
4312 IF (.NOT.mask(i)) cycle vectm2
4313! DO j = 1, i-1
4314! IF (vect(j) == vect(i)) CYCLE vectm2
4315 DO j = 1, count_distinct
4316 IF (pack_distinct(j) == vect(i)) cycle vectm2
4317 ENDDO
4318 count_distinct = count_distinct + 1
4319 IF (count_distinct > dim) EXIT
4320 pack_distinct(count_distinct) = vect(i)
4321 ENDDO vectm2
4322 ENDIF
4323ELSE
4324 IF (lback) THEN
4325 vect1: DO i = 1, SIZE(vect)
4326! DO j = i-1, 1, -1
4327! IF (vect(j) == vect(i)) CYCLE vect1
4328 DO j = count_distinct, 1, -1
4329 IF (pack_distinct(j) == vect(i)) cycle vect1
4330 ENDDO
4331 count_distinct = count_distinct + 1
4332 IF (count_distinct > dim) EXIT
4333 pack_distinct(count_distinct) = vect(i)
4334 ENDDO vect1
4335 ELSE
4336 vect2: DO i = 1, SIZE(vect)
4337! DO j = 1, i-1
4338! IF (vect(j) == vect(i)) CYCLE vect2
4339 DO j = 1, count_distinct
4340 IF (pack_distinct(j) == vect(i)) cycle vect2
4341 ENDDO
4342 count_distinct = count_distinct + 1
4343 IF (count_distinct > dim) EXIT
4344 pack_distinct(count_distinct) = vect(i)
4345 ENDDO vect2
4346 ENDIF
4347ENDIF
4348
4349END SUBROUTINE pack_distinct_c
4350
4352FUNCTION map(mask) RESULT(mapidx)
4353LOGICAL,INTENT(in) :: mask(:)
4354INTEGER :: mapidx(count(mask))
4355
4356INTEGER :: i,j
4357
4358j = 0
4359DO i=1, SIZE(mask)
4360 j = j + 1
4361 IF (mask(i)) mapidx(j)=i
4362ENDDO
4363
4364END FUNCTION map
4365
4366#define ARRAYOF_ORIGEQ 1
4367
4368#undef ARRAYOF_ORIGTYPE
4369#undef ARRAYOF_TYPE
4370#define ARRAYOF_ORIGTYPE INTEGER
4371#define ARRAYOF_TYPE arrayof_integer
4372#include "arrayof_post.F90"
4373
4374#undef ARRAYOF_ORIGTYPE
4375#undef ARRAYOF_TYPE
4376#define ARRAYOF_ORIGTYPE REAL
4377#define ARRAYOF_TYPE arrayof_real
4378#include "arrayof_post.F90"
4379
4380#undef ARRAYOF_ORIGTYPE
4381#undef ARRAYOF_TYPE
4382#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4383#define ARRAYOF_TYPE arrayof_doubleprecision
4384#include "arrayof_post.F90"
4385
4386#undef ARRAYOF_ORIGEQ
4387
4388#undef ARRAYOF_ORIGTYPE
4389#undef ARRAYOF_TYPE
4390#define ARRAYOF_ORIGTYPE LOGICAL
4391#define ARRAYOF_TYPE arrayof_logical
4392#include "arrayof_post.F90"
4393
Quick method to append an element to the array. Definition: array_utilities.F90:508 Destructor for finalizing an array object. Definition: array_utilities.F90:521 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 |