libsim Versione 7.1.11

◆ 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 6158 del file array_utilities.F90.

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