libsim Versione 7.2.1

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

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