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