libsim Versione 7.2.1

◆ arrayof_doubleprecision_delete()

subroutine, private arrayof_doubleprecision_delete ( type(arrayof_doubleprecision this,
logical, intent(in), optional  nodealloc 
)
private

Destructor for finalizing an array object.

If defined, calls the destructor for every element of the array object; finally it deallocates all the space occupied.

Parametri
thisarray object to be destroyed
[in]nodeallocif provided and .TRUE. , the space reserved for the array is not deallocated, thus the values are retained, while the array pointer is nullified, this means that the caller must have previously assigned the pointer contents thisarray to another pointer to prevent memory leaks

Definizione alla linea 6247 del file array_utilities.F90.

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