libsim Versione 7.2.6

◆ arrayof_logical_delete()

subroutine arrayof_logical_delete ( type(arrayof_logical) this,
logical, intent(in), optional nodealloc )

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

6494! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6495! authors:
6496! Davide Cesari <dcesari@arpa.emr.it>
6497! Paolo Patruno <ppatruno@arpa.emr.it>
6498
6499! This program is free software; you can redistribute it and/or
6500! modify it under the terms of the GNU General Public License as
6501! published by the Free Software Foundation; either version 2 of
6502! the License, or (at your option) any later version.
6503
6504! This program is distributed in the hope that it will be useful,
6505! but WITHOUT ANY WARRANTY; without even the implied warranty of
6506! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6507! GNU General Public License for more details.
6508
6509! You should have received a copy of the GNU General Public License
6510! along with this program. If not, see <http://www.gnu.org/licenses/>.
6511
6512
6513
6514!> This module defines usefull general purpose function and subroutine
6515!!\ingroup base
6516#include "config.h"
6517MODULE array_utilities
6518
6519IMPLICIT NONE
6520
6521! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6522!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6523
6524#undef VOL7D_POLY_TYPE_AUTO
6525
6526#undef VOL7D_POLY_TYPE
6527#undef VOL7D_POLY_TYPES
6528#define VOL7D_POLY_TYPE INTEGER
6529#define VOL7D_POLY_TYPES _i
6530#define ENABLE_SORT
6531#include "array_utilities_pre.F90"
6532#undef ENABLE_SORT
6533
6534#undef VOL7D_POLY_TYPE
6535#undef VOL7D_POLY_TYPES
6536#define VOL7D_POLY_TYPE REAL
6537#define VOL7D_POLY_TYPES _r
6538#define ENABLE_SORT
6539#include "array_utilities_pre.F90"
6540#undef ENABLE_SORT
6541
6542#undef VOL7D_POLY_TYPE
6543#undef VOL7D_POLY_TYPES
6544#define VOL7D_POLY_TYPE DOUBLEPRECISION
6545#define VOL7D_POLY_TYPES _d
6546#define ENABLE_SORT
6547#include "array_utilities_pre.F90"
6548#undef ENABLE_SORT
6549
6550#define VOL7D_NO_PACK
6551#undef VOL7D_POLY_TYPE
6552#undef VOL7D_POLY_TYPES
6553#define VOL7D_POLY_TYPE CHARACTER(len=*)
6554#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6555#define VOL7D_POLY_TYPES _c
6556#define ENABLE_SORT
6557#include "array_utilities_pre.F90"
6558#undef VOL7D_POLY_TYPE_AUTO
6559#undef ENABLE_SORT
6560
6561
6562#define ARRAYOF_ORIGEQ 1
6563
6564#define ARRAYOF_ORIGTYPE INTEGER
6565#define ARRAYOF_TYPE arrayof_integer
6566#include "arrayof_pre.F90"
6567
6568#undef ARRAYOF_ORIGTYPE
6569#undef ARRAYOF_TYPE
6570#define ARRAYOF_ORIGTYPE REAL
6571#define ARRAYOF_TYPE arrayof_real
6572#include "arrayof_pre.F90"
6573
6574#undef ARRAYOF_ORIGTYPE
6575#undef ARRAYOF_TYPE
6576#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6577#define ARRAYOF_TYPE arrayof_doubleprecision
6578#include "arrayof_pre.F90"
6579
6580#undef ARRAYOF_ORIGEQ
6581
6582#undef ARRAYOF_ORIGTYPE
6583#undef ARRAYOF_TYPE
6584#define ARRAYOF_ORIGTYPE LOGICAL
6585#define ARRAYOF_TYPE arrayof_logical
6586#include "arrayof_pre.F90"
6587
6588PRIVATE
6589! from arrayof
6591PUBLIC insert_unique, append_unique
6592
6593PUBLIC sort, index, index_c, &
6594 count_distinct_sorted, pack_distinct_sorted, &
6595 count_distinct, pack_distinct, count_and_pack_distinct, &
6596 map_distinct, map_inv_distinct, &
6597 firsttrue, lasttrue, pack_distinct_c, map
6598
6599CONTAINS
6600
6601
6602!> Return the index ot the first true element of the input logical array \a v.
6603!! If no \c .TRUE. elements are found, it returns 0.
6604FUNCTION firsttrue(v) RESULT(i)
6605LOGICAL,INTENT(in) :: v(:) !< logical array to test
6606INTEGER :: i
6607
6608DO i = 1, SIZE(v)
6609 IF (v(i)) RETURN
6610ENDDO
6611i = 0
6612
6613END FUNCTION firsttrue
6614
6615
6616!> Return the index ot the last true element of the input logical array \a v.
6617!! If no \c .TRUE. elements are found, it returns 0.
6618FUNCTION lasttrue(v) RESULT(i)
6619LOGICAL,INTENT(in) :: v(:) !< logical array to test
6620INTEGER :: i
6621
6622DO i = SIZE(v), 1, -1
6623 IF (v(i)) RETURN
6624ENDDO
6625
6626END FUNCTION lasttrue
6627
6628
6629! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6630#undef VOL7D_POLY_TYPE_AUTO
6631#undef VOL7D_NO_PACK
6632
6633#undef VOL7D_POLY_TYPE
6634#undef VOL7D_POLY_TYPES
6635#define VOL7D_POLY_TYPE INTEGER
6636#define VOL7D_POLY_TYPES _i
6637#define ENABLE_SORT
6638#include "array_utilities_inc.F90"
6639#undef ENABLE_SORT
6640
6641#undef VOL7D_POLY_TYPE
6642#undef VOL7D_POLY_TYPES
6643#define VOL7D_POLY_TYPE REAL
6644#define VOL7D_POLY_TYPES _r
6645#define ENABLE_SORT
6646#include "array_utilities_inc.F90"
6647#undef ENABLE_SORT
6648
6649#undef VOL7D_POLY_TYPE
6650#undef VOL7D_POLY_TYPES
6651#define VOL7D_POLY_TYPE DOUBLEPRECISION
6652#define VOL7D_POLY_TYPES _d
6653#define ENABLE_SORT
6654#include "array_utilities_inc.F90"
6655#undef ENABLE_SORT
6656
6657#define VOL7D_NO_PACK
6658#undef VOL7D_POLY_TYPE
6659#undef VOL7D_POLY_TYPES
6660#define VOL7D_POLY_TYPE CHARACTER(len=*)
6661#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6662#define VOL7D_POLY_TYPES _c
6663#define ENABLE_SORT
6664#include "array_utilities_inc.F90"
6665#undef VOL7D_POLY_TYPE_AUTO
6666#undef ENABLE_SORT
6667
6668SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6669CHARACTER(len=*),INTENT(in) :: vect(:)
6670LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6671CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6672
6673INTEGER :: count_distinct
6674INTEGER :: i, j, dim
6675LOGICAL :: lback
6676
6677dim = SIZE(pack_distinct)
6678IF (PRESENT(back)) THEN
6679 lback = back
6680ELSE
6681 lback = .false.
6682ENDIF
6683count_distinct = 0
6684
6685IF (PRESENT (mask)) THEN
6686 IF (lback) THEN
6687 vectm1: DO i = 1, SIZE(vect)
6688 IF (.NOT.mask(i)) cycle vectm1
6689! DO j = i-1, 1, -1
6690! IF (vect(j) == vect(i)) CYCLE vectm1
6691 DO j = count_distinct, 1, -1
6692 IF (pack_distinct(j) == vect(i)) cycle vectm1
6693 ENDDO
6694 count_distinct = count_distinct + 1
6695 IF (count_distinct > dim) EXIT
6696 pack_distinct(count_distinct) = vect(i)
6697 ENDDO vectm1
6698 ELSE
6699 vectm2: DO i = 1, SIZE(vect)
6700 IF (.NOT.mask(i)) cycle vectm2
6701! DO j = 1, i-1
6702! IF (vect(j) == vect(i)) CYCLE vectm2
6703 DO j = 1, count_distinct
6704 IF (pack_distinct(j) == vect(i)) cycle vectm2
6705 ENDDO
6706 count_distinct = count_distinct + 1
6707 IF (count_distinct > dim) EXIT
6708 pack_distinct(count_distinct) = vect(i)
6709 ENDDO vectm2
6710 ENDIF
6711ELSE
6712 IF (lback) THEN
6713 vect1: DO i = 1, SIZE(vect)
6714! DO j = i-1, 1, -1
6715! IF (vect(j) == vect(i)) CYCLE vect1
6716 DO j = count_distinct, 1, -1
6717 IF (pack_distinct(j) == vect(i)) cycle vect1
6718 ENDDO
6719 count_distinct = count_distinct + 1
6720 IF (count_distinct > dim) EXIT
6721 pack_distinct(count_distinct) = vect(i)
6722 ENDDO vect1
6723 ELSE
6724 vect2: DO i = 1, SIZE(vect)
6725! DO j = 1, i-1
6726! IF (vect(j) == vect(i)) CYCLE vect2
6727 DO j = 1, count_distinct
6728 IF (pack_distinct(j) == vect(i)) cycle vect2
6729 ENDDO
6730 count_distinct = count_distinct + 1
6731 IF (count_distinct > dim) EXIT
6732 pack_distinct(count_distinct) = vect(i)
6733 ENDDO vect2
6734 ENDIF
6735ENDIF
6736
6737END SUBROUTINE pack_distinct_c
6738
6739!> Return the index of the array only where the mask is true
6740FUNCTION map(mask) RESULT(mapidx)
6741LOGICAL,INTENT(in) :: mask(:)
6742INTEGER :: mapidx(count(mask))
6743
6744INTEGER :: i,j
6745
6746j = 0
6747DO i=1, SIZE(mask)
6748 j = j + 1
6749 IF (mask(i)) mapidx(j)=i
6750ENDDO
6751
6752END FUNCTION map
6753
6754#define ARRAYOF_ORIGEQ 1
6755
6756#undef ARRAYOF_ORIGTYPE
6757#undef ARRAYOF_TYPE
6758#define ARRAYOF_ORIGTYPE INTEGER
6759#define ARRAYOF_TYPE arrayof_integer
6760#include "arrayof_post.F90"
6761
6762#undef ARRAYOF_ORIGTYPE
6763#undef ARRAYOF_TYPE
6764#define ARRAYOF_ORIGTYPE REAL
6765#define ARRAYOF_TYPE arrayof_real
6766#include "arrayof_post.F90"
6767
6768#undef ARRAYOF_ORIGTYPE
6769#undef ARRAYOF_TYPE
6770#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6771#define ARRAYOF_TYPE arrayof_doubleprecision
6772#include "arrayof_post.F90"
6773
6774#undef ARRAYOF_ORIGEQ
6775
6776#undef ARRAYOF_ORIGTYPE
6777#undef ARRAYOF_TYPE
6778#define ARRAYOF_ORIGTYPE LOGICAL
6779#define ARRAYOF_TYPE arrayof_logical
6780#include "arrayof_post.F90"
6781
6782END 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.