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