libsim Versione 7.1.11

◆ arrayof_doubleprecision_remove()

subroutine, private arrayof_doubleprecision_remove ( type(arrayof_doubleprecision this,
integer, intent(in), optional  nelem,
integer, intent(in), optional  pos 
)
private

Method for removing elements of the array at a desired position.

If necessary, the array is reallocated to reduce space.

Parametri
thisarray object in which an element has to be removed
[in]nelemnumber of elements to remove, if not provided, a single element is removed
[in]posposition of the element to be removed, if it is out of range, it is clipped, if it is not provided, objects are removed at the end

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"
6228MODULE array_utilities
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
6304PUBLIC sort, index, index_c, &
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
6493END 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.