libsim Versione 7.2.4
|
◆ 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 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"
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
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
Quick method to append an element to the array. Definition array_utilities.F90:508 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 |