libsim Versione 7.2.1

◆ arrayof_doubleprecision_insert_unique()

subroutine, private arrayof_doubleprecision_insert_unique ( type(arrayof_doubleprecision) this,
doubleprecision, intent(in) content,
integer, intent(in), optional pos )
private

Method for inserting an element of the array at a desired position only if it is not present in the array yet.

If necessary, the array is reallocated to accomodate the new element.

Parametri
thisarray object to extend
[in]contentobject of TYPE DOUBLEPRECISION to insert
[in]posposition where to insert, if it is out of range, it is clipped, if it is not provided, the object is appended

Definizione alla linea 6152 del file array_utilities.F90.

6153! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6154! authors:
6155! Davide Cesari <dcesari@arpa.emr.it>
6156! Paolo Patruno <ppatruno@arpa.emr.it>
6157
6158! This program is free software; you can redistribute it and/or
6159! modify it under the terms of the GNU General Public License as
6160! published by the Free Software Foundation; either version 2 of
6161! the License, or (at your option) any later version.
6162
6163! This program is distributed in the hope that it will be useful,
6164! but WITHOUT ANY WARRANTY; without even the implied warranty of
6165! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6166! GNU General Public License for more details.
6167
6168! You should have received a copy of the GNU General Public License
6169! along with this program. If not, see <http://www.gnu.org/licenses/>.
6170
6171
6172
6175#include "config.h"
6176MODULE array_utilities
6177
6178IMPLICIT NONE
6179
6180! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6181!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6182
6183#undef VOL7D_POLY_TYPE_AUTO
6184
6185#undef VOL7D_POLY_TYPE
6186#undef VOL7D_POLY_TYPES
6187#define VOL7D_POLY_TYPE INTEGER
6188#define VOL7D_POLY_TYPES _i
6189#define ENABLE_SORT
6190#include "array_utilities_pre.F90"
6191#undef ENABLE_SORT
6192
6193#undef VOL7D_POLY_TYPE
6194#undef VOL7D_POLY_TYPES
6195#define VOL7D_POLY_TYPE REAL
6196#define VOL7D_POLY_TYPES _r
6197#define ENABLE_SORT
6198#include "array_utilities_pre.F90"
6199#undef ENABLE_SORT
6200
6201#undef VOL7D_POLY_TYPE
6202#undef VOL7D_POLY_TYPES
6203#define VOL7D_POLY_TYPE DOUBLEPRECISION
6204#define VOL7D_POLY_TYPES _d
6205#define ENABLE_SORT
6206#include "array_utilities_pre.F90"
6207#undef ENABLE_SORT
6208
6209#define VOL7D_NO_PACK
6210#undef VOL7D_POLY_TYPE
6211#undef VOL7D_POLY_TYPES
6212#define VOL7D_POLY_TYPE CHARACTER(len=*)
6213#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6214#define VOL7D_POLY_TYPES _c
6215#define ENABLE_SORT
6216#include "array_utilities_pre.F90"
6217#undef VOL7D_POLY_TYPE_AUTO
6218#undef ENABLE_SORT
6219
6220
6221#define ARRAYOF_ORIGEQ 1
6222
6223#define ARRAYOF_ORIGTYPE INTEGER
6224#define ARRAYOF_TYPE arrayof_integer
6225#include "arrayof_pre.F90"
6226
6227#undef ARRAYOF_ORIGTYPE
6228#undef ARRAYOF_TYPE
6229#define ARRAYOF_ORIGTYPE REAL
6230#define ARRAYOF_TYPE arrayof_real
6231#include "arrayof_pre.F90"
6232
6233#undef ARRAYOF_ORIGTYPE
6234#undef ARRAYOF_TYPE
6235#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6236#define ARRAYOF_TYPE arrayof_doubleprecision
6237#include "arrayof_pre.F90"
6238
6239#undef ARRAYOF_ORIGEQ
6240
6241#undef ARRAYOF_ORIGTYPE
6242#undef ARRAYOF_TYPE
6243#define ARRAYOF_ORIGTYPE LOGICAL
6244#define ARRAYOF_TYPE arrayof_logical
6245#include "arrayof_pre.F90"
6246
6247PRIVATE
6248! from arrayof
6250PUBLIC insert_unique, append_unique
6251
6252PUBLIC sort, index, index_c, &
6253 count_distinct_sorted, pack_distinct_sorted, &
6254 count_distinct, pack_distinct, count_and_pack_distinct, &
6255 map_distinct, map_inv_distinct, &
6256 firsttrue, lasttrue, pack_distinct_c, map
6257
6258CONTAINS
6259
6260
6263FUNCTION firsttrue(v) RESULT(i)
6264LOGICAL,INTENT(in) :: v(:)
6265INTEGER :: i
6266
6267DO i = 1, SIZE(v)
6268 IF (v(i)) RETURN
6269ENDDO
6270i = 0
6271
6272END FUNCTION firsttrue
6273
6274
6277FUNCTION lasttrue(v) RESULT(i)
6278LOGICAL,INTENT(in) :: v(:)
6279INTEGER :: i
6280
6281DO i = SIZE(v), 1, -1
6282 IF (v(i)) RETURN
6283ENDDO
6284
6285END FUNCTION lasttrue
6286
6287
6288! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6289#undef VOL7D_POLY_TYPE_AUTO
6290#undef VOL7D_NO_PACK
6291
6292#undef VOL7D_POLY_TYPE
6293#undef VOL7D_POLY_TYPES
6294#define VOL7D_POLY_TYPE INTEGER
6295#define VOL7D_POLY_TYPES _i
6296#define ENABLE_SORT
6297#include "array_utilities_inc.F90"
6298#undef ENABLE_SORT
6299
6300#undef VOL7D_POLY_TYPE
6301#undef VOL7D_POLY_TYPES
6302#define VOL7D_POLY_TYPE REAL
6303#define VOL7D_POLY_TYPES _r
6304#define ENABLE_SORT
6305#include "array_utilities_inc.F90"
6306#undef ENABLE_SORT
6307
6308#undef VOL7D_POLY_TYPE
6309#undef VOL7D_POLY_TYPES
6310#define VOL7D_POLY_TYPE DOUBLEPRECISION
6311#define VOL7D_POLY_TYPES _d
6312#define ENABLE_SORT
6313#include "array_utilities_inc.F90"
6314#undef ENABLE_SORT
6315
6316#define VOL7D_NO_PACK
6317#undef VOL7D_POLY_TYPE
6318#undef VOL7D_POLY_TYPES
6319#define VOL7D_POLY_TYPE CHARACTER(len=*)
6320#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6321#define VOL7D_POLY_TYPES _c
6322#define ENABLE_SORT
6323#include "array_utilities_inc.F90"
6324#undef VOL7D_POLY_TYPE_AUTO
6325#undef ENABLE_SORT
6326
6327SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6328CHARACTER(len=*),INTENT(in) :: vect(:)
6329LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6330CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6331
6332INTEGER :: count_distinct
6333INTEGER :: i, j, dim
6334LOGICAL :: lback
6335
6336dim = SIZE(pack_distinct)
6337IF (PRESENT(back)) THEN
6338 lback = back
6339ELSE
6340 lback = .false.
6341ENDIF
6342count_distinct = 0
6343
6344IF (PRESENT (mask)) THEN
6345 IF (lback) THEN
6346 vectm1: DO i = 1, SIZE(vect)
6347 IF (.NOT.mask(i)) cycle vectm1
6348! DO j = i-1, 1, -1
6349! IF (vect(j) == vect(i)) CYCLE vectm1
6350 DO j = count_distinct, 1, -1
6351 IF (pack_distinct(j) == vect(i)) cycle vectm1
6352 ENDDO
6353 count_distinct = count_distinct + 1
6354 IF (count_distinct > dim) EXIT
6355 pack_distinct(count_distinct) = vect(i)
6356 ENDDO vectm1
6357 ELSE
6358 vectm2: DO i = 1, SIZE(vect)
6359 IF (.NOT.mask(i)) cycle vectm2
6360! DO j = 1, i-1
6361! IF (vect(j) == vect(i)) CYCLE vectm2
6362 DO j = 1, count_distinct
6363 IF (pack_distinct(j) == vect(i)) cycle vectm2
6364 ENDDO
6365 count_distinct = count_distinct + 1
6366 IF (count_distinct > dim) EXIT
6367 pack_distinct(count_distinct) = vect(i)
6368 ENDDO vectm2
6369 ENDIF
6370ELSE
6371 IF (lback) THEN
6372 vect1: DO i = 1, SIZE(vect)
6373! DO j = i-1, 1, -1
6374! IF (vect(j) == vect(i)) CYCLE vect1
6375 DO j = count_distinct, 1, -1
6376 IF (pack_distinct(j) == vect(i)) cycle vect1
6377 ENDDO
6378 count_distinct = count_distinct + 1
6379 IF (count_distinct > dim) EXIT
6380 pack_distinct(count_distinct) = vect(i)
6381 ENDDO vect1
6382 ELSE
6383 vect2: DO i = 1, SIZE(vect)
6384! DO j = 1, i-1
6385! IF (vect(j) == vect(i)) CYCLE vect2
6386 DO j = 1, count_distinct
6387 IF (pack_distinct(j) == vect(i)) cycle vect2
6388 ENDDO
6389 count_distinct = count_distinct + 1
6390 IF (count_distinct > dim) EXIT
6391 pack_distinct(count_distinct) = vect(i)
6392 ENDDO vect2
6393 ENDIF
6394ENDIF
6395
6396END SUBROUTINE pack_distinct_c
6397
6399FUNCTION map(mask) RESULT(mapidx)
6400LOGICAL,INTENT(in) :: mask(:)
6401INTEGER :: mapidx(count(mask))
6402
6403INTEGER :: i,j
6404
6405j = 0
6406DO i=1, SIZE(mask)
6407 j = j + 1
6408 IF (mask(i)) mapidx(j)=i
6409ENDDO
6410
6411END FUNCTION map
6412
6413#define ARRAYOF_ORIGEQ 1
6414
6415#undef ARRAYOF_ORIGTYPE
6416#undef ARRAYOF_TYPE
6417#define ARRAYOF_ORIGTYPE INTEGER
6418#define ARRAYOF_TYPE arrayof_integer
6419#include "arrayof_post.F90"
6420
6421#undef ARRAYOF_ORIGTYPE
6422#undef ARRAYOF_TYPE
6423#define ARRAYOF_ORIGTYPE REAL
6424#define ARRAYOF_TYPE arrayof_real
6425#include "arrayof_post.F90"
6426
6427#undef ARRAYOF_ORIGTYPE
6428#undef ARRAYOF_TYPE
6429#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6430#define ARRAYOF_TYPE arrayof_doubleprecision
6431#include "arrayof_post.F90"
6432
6433#undef ARRAYOF_ORIGEQ
6434
6435#undef ARRAYOF_ORIGTYPE
6436#undef ARRAYOF_TYPE
6437#define ARRAYOF_ORIGTYPE LOGICAL
6438#define ARRAYOF_TYPE arrayof_logical
6439#include "arrayof_post.F90"
6440
6441END MODULE array_utilities
Quick method to append an element to the array.
Destructor for finalizing an array object.
Method for inserting elements of the array at a desired position.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Method for removing elements of the array at a desired position.
Index method.
This module defines usefull general purpose function and subroutine.

Generated with Doxygen.