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