libsim Versione 7.2.4

◆ arrayof_logical_packarray()

subroutine, private arrayof_logical_packarray ( type(arrayof_logical) this)
private

Method for packing the array object reducing at a minimum the memory occupation, without destroying its contents.

The value of this::overalloc remains unchanged. After the call to the method, the object can continue to be used, extended and shortened as before. If the object is empty the array is allocated to zero length.

Parametri
thisobject to be packed

Definizione alla linea 6545 del file array_utilities.F90.

6546! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6547! authors:
6548! Davide Cesari <dcesari@arpa.emr.it>
6549! Paolo Patruno <ppatruno@arpa.emr.it>
6550
6551! This program is free software; you can redistribute it and/or
6552! modify it under the terms of the GNU General Public License as
6553! published by the Free Software Foundation; either version 2 of
6554! the License, or (at your option) any later version.
6555
6556! This program is distributed in the hope that it will be useful,
6557! but WITHOUT ANY WARRANTY; without even the implied warranty of
6558! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6559! GNU General Public License for more details.
6560
6561! You should have received a copy of the GNU General Public License
6562! along with this program. If not, see <http://www.gnu.org/licenses/>.
6563
6564
6565
6568#include "config.h"
6569MODULE array_utilities
6570
6571IMPLICIT NONE
6572
6573! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6574!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6575
6576#undef VOL7D_POLY_TYPE_AUTO
6577
6578#undef VOL7D_POLY_TYPE
6579#undef VOL7D_POLY_TYPES
6580#define VOL7D_POLY_TYPE INTEGER
6581#define VOL7D_POLY_TYPES _i
6582#define ENABLE_SORT
6583#include "array_utilities_pre.F90"
6584#undef ENABLE_SORT
6585
6586#undef VOL7D_POLY_TYPE
6587#undef VOL7D_POLY_TYPES
6588#define VOL7D_POLY_TYPE REAL
6589#define VOL7D_POLY_TYPES _r
6590#define ENABLE_SORT
6591#include "array_utilities_pre.F90"
6592#undef ENABLE_SORT
6593
6594#undef VOL7D_POLY_TYPE
6595#undef VOL7D_POLY_TYPES
6596#define VOL7D_POLY_TYPE DOUBLEPRECISION
6597#define VOL7D_POLY_TYPES _d
6598#define ENABLE_SORT
6599#include "array_utilities_pre.F90"
6600#undef ENABLE_SORT
6601
6602#define VOL7D_NO_PACK
6603#undef VOL7D_POLY_TYPE
6604#undef VOL7D_POLY_TYPES
6605#define VOL7D_POLY_TYPE CHARACTER(len=*)
6606#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6607#define VOL7D_POLY_TYPES _c
6608#define ENABLE_SORT
6609#include "array_utilities_pre.F90"
6610#undef VOL7D_POLY_TYPE_AUTO
6611#undef ENABLE_SORT
6612
6613
6614#define ARRAYOF_ORIGEQ 1
6615
6616#define ARRAYOF_ORIGTYPE INTEGER
6617#define ARRAYOF_TYPE arrayof_integer
6618#include "arrayof_pre.F90"
6619
6620#undef ARRAYOF_ORIGTYPE
6621#undef ARRAYOF_TYPE
6622#define ARRAYOF_ORIGTYPE REAL
6623#define ARRAYOF_TYPE arrayof_real
6624#include "arrayof_pre.F90"
6625
6626#undef ARRAYOF_ORIGTYPE
6627#undef ARRAYOF_TYPE
6628#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6629#define ARRAYOF_TYPE arrayof_doubleprecision
6630#include "arrayof_pre.F90"
6631
6632#undef ARRAYOF_ORIGEQ
6633
6634#undef ARRAYOF_ORIGTYPE
6635#undef ARRAYOF_TYPE
6636#define ARRAYOF_ORIGTYPE LOGICAL
6637#define ARRAYOF_TYPE arrayof_logical
6638#include "arrayof_pre.F90"
6639
6640PRIVATE
6641! from arrayof
6643PUBLIC insert_unique, append_unique
6644
6645PUBLIC sort, index, index_c, &
6646 count_distinct_sorted, pack_distinct_sorted, &
6647 count_distinct, pack_distinct, count_and_pack_distinct, &
6648 map_distinct, map_inv_distinct, &
6649 firsttrue, lasttrue, pack_distinct_c, map
6650
6651CONTAINS
6652
6653
6656FUNCTION firsttrue(v) RESULT(i)
6657LOGICAL,INTENT(in) :: v(:)
6658INTEGER :: i
6659
6660DO i = 1, SIZE(v)
6661 IF (v(i)) RETURN
6662ENDDO
6663i = 0
6664
6665END FUNCTION firsttrue
6666
6667
6670FUNCTION lasttrue(v) RESULT(i)
6671LOGICAL,INTENT(in) :: v(:)
6672INTEGER :: i
6673
6674DO i = SIZE(v), 1, -1
6675 IF (v(i)) RETURN
6676ENDDO
6677
6678END FUNCTION lasttrue
6679
6680
6681! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6682#undef VOL7D_POLY_TYPE_AUTO
6683#undef VOL7D_NO_PACK
6684
6685#undef VOL7D_POLY_TYPE
6686#undef VOL7D_POLY_TYPES
6687#define VOL7D_POLY_TYPE INTEGER
6688#define VOL7D_POLY_TYPES _i
6689#define ENABLE_SORT
6690#include "array_utilities_inc.F90"
6691#undef ENABLE_SORT
6692
6693#undef VOL7D_POLY_TYPE
6694#undef VOL7D_POLY_TYPES
6695#define VOL7D_POLY_TYPE REAL
6696#define VOL7D_POLY_TYPES _r
6697#define ENABLE_SORT
6698#include "array_utilities_inc.F90"
6699#undef ENABLE_SORT
6700
6701#undef VOL7D_POLY_TYPE
6702#undef VOL7D_POLY_TYPES
6703#define VOL7D_POLY_TYPE DOUBLEPRECISION
6704#define VOL7D_POLY_TYPES _d
6705#define ENABLE_SORT
6706#include "array_utilities_inc.F90"
6707#undef ENABLE_SORT
6708
6709#define VOL7D_NO_PACK
6710#undef VOL7D_POLY_TYPE
6711#undef VOL7D_POLY_TYPES
6712#define VOL7D_POLY_TYPE CHARACTER(len=*)
6713#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6714#define VOL7D_POLY_TYPES _c
6715#define ENABLE_SORT
6716#include "array_utilities_inc.F90"
6717#undef VOL7D_POLY_TYPE_AUTO
6718#undef ENABLE_SORT
6719
6720SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6721CHARACTER(len=*),INTENT(in) :: vect(:)
6722LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6723CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6724
6725INTEGER :: count_distinct
6726INTEGER :: i, j, dim
6727LOGICAL :: lback
6728
6729dim = SIZE(pack_distinct)
6730IF (PRESENT(back)) THEN
6731 lback = back
6732ELSE
6733 lback = .false.
6734ENDIF
6735count_distinct = 0
6736
6737IF (PRESENT (mask)) THEN
6738 IF (lback) THEN
6739 vectm1: DO i = 1, SIZE(vect)
6740 IF (.NOT.mask(i)) cycle vectm1
6741! DO j = i-1, 1, -1
6742! IF (vect(j) == vect(i)) CYCLE vectm1
6743 DO j = count_distinct, 1, -1
6744 IF (pack_distinct(j) == vect(i)) cycle vectm1
6745 ENDDO
6746 count_distinct = count_distinct + 1
6747 IF (count_distinct > dim) EXIT
6748 pack_distinct(count_distinct) = vect(i)
6749 ENDDO vectm1
6750 ELSE
6751 vectm2: DO i = 1, SIZE(vect)
6752 IF (.NOT.mask(i)) cycle vectm2
6753! DO j = 1, i-1
6754! IF (vect(j) == vect(i)) CYCLE vectm2
6755 DO j = 1, count_distinct
6756 IF (pack_distinct(j) == vect(i)) cycle vectm2
6757 ENDDO
6758 count_distinct = count_distinct + 1
6759 IF (count_distinct > dim) EXIT
6760 pack_distinct(count_distinct) = vect(i)
6761 ENDDO vectm2
6762 ENDIF
6763ELSE
6764 IF (lback) THEN
6765 vect1: DO i = 1, SIZE(vect)
6766! DO j = i-1, 1, -1
6767! IF (vect(j) == vect(i)) CYCLE vect1
6768 DO j = count_distinct, 1, -1
6769 IF (pack_distinct(j) == vect(i)) cycle vect1
6770 ENDDO
6771 count_distinct = count_distinct + 1
6772 IF (count_distinct > dim) EXIT
6773 pack_distinct(count_distinct) = vect(i)
6774 ENDDO vect1
6775 ELSE
6776 vect2: DO i = 1, SIZE(vect)
6777! DO j = 1, i-1
6778! IF (vect(j) == vect(i)) CYCLE vect2
6779 DO j = 1, count_distinct
6780 IF (pack_distinct(j) == vect(i)) cycle vect2
6781 ENDDO
6782 count_distinct = count_distinct + 1
6783 IF (count_distinct > dim) EXIT
6784 pack_distinct(count_distinct) = vect(i)
6785 ENDDO vect2
6786 ENDIF
6787ENDIF
6788
6789END SUBROUTINE pack_distinct_c
6790
6792FUNCTION map(mask) RESULT(mapidx)
6793LOGICAL,INTENT(in) :: mask(:)
6794INTEGER :: mapidx(count(mask))
6795
6796INTEGER :: i,j
6797
6798j = 0
6799DO i=1, SIZE(mask)
6800 j = j + 1
6801 IF (mask(i)) mapidx(j)=i
6802ENDDO
6803
6804END FUNCTION map
6805
6806#define ARRAYOF_ORIGEQ 1
6807
6808#undef ARRAYOF_ORIGTYPE
6809#undef ARRAYOF_TYPE
6810#define ARRAYOF_ORIGTYPE INTEGER
6811#define ARRAYOF_TYPE arrayof_integer
6812#include "arrayof_post.F90"
6813
6814#undef ARRAYOF_ORIGTYPE
6815#undef ARRAYOF_TYPE
6816#define ARRAYOF_ORIGTYPE REAL
6817#define ARRAYOF_TYPE arrayof_real
6818#include "arrayof_post.F90"
6819
6820#undef ARRAYOF_ORIGTYPE
6821#undef ARRAYOF_TYPE
6822#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6823#define ARRAYOF_TYPE arrayof_doubleprecision
6824#include "arrayof_post.F90"
6825
6826#undef ARRAYOF_ORIGEQ
6827
6828#undef ARRAYOF_ORIGTYPE
6829#undef ARRAYOF_TYPE
6830#define ARRAYOF_ORIGTYPE LOGICAL
6831#define ARRAYOF_TYPE arrayof_logical
6832#include "arrayof_post.F90"
6833
6834END 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.