libsim Versione 7.1.11

◆ arrayof_logical_packarray()

subroutine arrayof_logical_packarray ( type(arrayof_logical this)

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

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