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