libsim Versione 7.1.11

◆ arrayof_integer_packarray()

subroutine arrayof_integer_packarray ( type(arrayof_integer 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 5747 del file array_utilities.F90.

5748! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5749! authors:
5750! Davide Cesari <dcesari@arpa.emr.it>
5751! Paolo Patruno <ppatruno@arpa.emr.it>
5752
5753! This program is free software; you can redistribute it and/or
5754! modify it under the terms of the GNU General Public License as
5755! published by the Free Software Foundation; either version 2 of
5756! the License, or (at your option) any later version.
5757
5758! This program is distributed in the hope that it will be useful,
5759! but WITHOUT ANY WARRANTY; without even the implied warranty of
5760! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5761! GNU General Public License for more details.
5762
5763! You should have received a copy of the GNU General Public License
5764! along with this program. If not, see <http://www.gnu.org/licenses/>.
5765
5766
5767
5770#include "config.h"
5771MODULE array_utilities
5772
5773IMPLICIT NONE
5774
5775! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5776!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5777
5778#undef VOL7D_POLY_TYPE_AUTO
5779
5780#undef VOL7D_POLY_TYPE
5781#undef VOL7D_POLY_TYPES
5782#define VOL7D_POLY_TYPE INTEGER
5783#define VOL7D_POLY_TYPES _i
5784#define ENABLE_SORT
5785#include "array_utilities_pre.F90"
5786#undef ENABLE_SORT
5787
5788#undef VOL7D_POLY_TYPE
5789#undef VOL7D_POLY_TYPES
5790#define VOL7D_POLY_TYPE REAL
5791#define VOL7D_POLY_TYPES _r
5792#define ENABLE_SORT
5793#include "array_utilities_pre.F90"
5794#undef ENABLE_SORT
5795
5796#undef VOL7D_POLY_TYPE
5797#undef VOL7D_POLY_TYPES
5798#define VOL7D_POLY_TYPE DOUBLEPRECISION
5799#define VOL7D_POLY_TYPES _d
5800#define ENABLE_SORT
5801#include "array_utilities_pre.F90"
5802#undef ENABLE_SORT
5803
5804#define VOL7D_NO_PACK
5805#undef VOL7D_POLY_TYPE
5806#undef VOL7D_POLY_TYPES
5807#define VOL7D_POLY_TYPE CHARACTER(len=*)
5808#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5809#define VOL7D_POLY_TYPES _c
5810#define ENABLE_SORT
5811#include "array_utilities_pre.F90"
5812#undef VOL7D_POLY_TYPE_AUTO
5813#undef ENABLE_SORT
5814
5815
5816#define ARRAYOF_ORIGEQ 1
5817
5818#define ARRAYOF_ORIGTYPE INTEGER
5819#define ARRAYOF_TYPE arrayof_integer
5820#include "arrayof_pre.F90"
5821
5822#undef ARRAYOF_ORIGTYPE
5823#undef ARRAYOF_TYPE
5824#define ARRAYOF_ORIGTYPE REAL
5825#define ARRAYOF_TYPE arrayof_real
5826#include "arrayof_pre.F90"
5827
5828#undef ARRAYOF_ORIGTYPE
5829#undef ARRAYOF_TYPE
5830#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5831#define ARRAYOF_TYPE arrayof_doubleprecision
5832#include "arrayof_pre.F90"
5833
5834#undef ARRAYOF_ORIGEQ
5835
5836#undef ARRAYOF_ORIGTYPE
5837#undef ARRAYOF_TYPE
5838#define ARRAYOF_ORIGTYPE LOGICAL
5839#define ARRAYOF_TYPE arrayof_logical
5840#include "arrayof_pre.F90"
5841
5842PRIVATE
5843! from arrayof
5845PUBLIC insert_unique, append_unique
5846
5847PUBLIC sort, index, index_c, &
5848 count_distinct_sorted, pack_distinct_sorted, &
5849 count_distinct, pack_distinct, count_and_pack_distinct, &
5850 map_distinct, map_inv_distinct, &
5851 firsttrue, lasttrue, pack_distinct_c, map
5852
5853CONTAINS
5854
5855
5858FUNCTION firsttrue(v) RESULT(i)
5859LOGICAL,INTENT(in) :: v(:)
5860INTEGER :: i
5861
5862DO i = 1, SIZE(v)
5863 IF (v(i)) RETURN
5864ENDDO
5865i = 0
5866
5867END FUNCTION firsttrue
5868
5869
5872FUNCTION lasttrue(v) RESULT(i)
5873LOGICAL,INTENT(in) :: v(:)
5874INTEGER :: i
5875
5876DO i = SIZE(v), 1, -1
5877 IF (v(i)) RETURN
5878ENDDO
5879
5880END FUNCTION lasttrue
5881
5882
5883! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5884#undef VOL7D_POLY_TYPE_AUTO
5885#undef VOL7D_NO_PACK
5886
5887#undef VOL7D_POLY_TYPE
5888#undef VOL7D_POLY_TYPES
5889#define VOL7D_POLY_TYPE INTEGER
5890#define VOL7D_POLY_TYPES _i
5891#define ENABLE_SORT
5892#include "array_utilities_inc.F90"
5893#undef ENABLE_SORT
5894
5895#undef VOL7D_POLY_TYPE
5896#undef VOL7D_POLY_TYPES
5897#define VOL7D_POLY_TYPE REAL
5898#define VOL7D_POLY_TYPES _r
5899#define ENABLE_SORT
5900#include "array_utilities_inc.F90"
5901#undef ENABLE_SORT
5902
5903#undef VOL7D_POLY_TYPE
5904#undef VOL7D_POLY_TYPES
5905#define VOL7D_POLY_TYPE DOUBLEPRECISION
5906#define VOL7D_POLY_TYPES _d
5907#define ENABLE_SORT
5908#include "array_utilities_inc.F90"
5909#undef ENABLE_SORT
5910
5911#define VOL7D_NO_PACK
5912#undef VOL7D_POLY_TYPE
5913#undef VOL7D_POLY_TYPES
5914#define VOL7D_POLY_TYPE CHARACTER(len=*)
5915#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5916#define VOL7D_POLY_TYPES _c
5917#define ENABLE_SORT
5918#include "array_utilities_inc.F90"
5919#undef VOL7D_POLY_TYPE_AUTO
5920#undef ENABLE_SORT
5921
5922SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5923CHARACTER(len=*),INTENT(in) :: vect(:)
5924LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5925CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5926
5927INTEGER :: count_distinct
5928INTEGER :: i, j, dim
5929LOGICAL :: lback
5930
5931dim = SIZE(pack_distinct)
5932IF (PRESENT(back)) THEN
5933 lback = back
5934ELSE
5935 lback = .false.
5936ENDIF
5937count_distinct = 0
5938
5939IF (PRESENT (mask)) THEN
5940 IF (lback) THEN
5941 vectm1: DO i = 1, SIZE(vect)
5942 IF (.NOT.mask(i)) cycle vectm1
5943! DO j = i-1, 1, -1
5944! IF (vect(j) == vect(i)) CYCLE vectm1
5945 DO j = count_distinct, 1, -1
5946 IF (pack_distinct(j) == vect(i)) cycle vectm1
5947 ENDDO
5948 count_distinct = count_distinct + 1
5949 IF (count_distinct > dim) EXIT
5950 pack_distinct(count_distinct) = vect(i)
5951 ENDDO vectm1
5952 ELSE
5953 vectm2: DO i = 1, SIZE(vect)
5954 IF (.NOT.mask(i)) cycle vectm2
5955! DO j = 1, i-1
5956! IF (vect(j) == vect(i)) CYCLE vectm2
5957 DO j = 1, count_distinct
5958 IF (pack_distinct(j) == vect(i)) cycle vectm2
5959 ENDDO
5960 count_distinct = count_distinct + 1
5961 IF (count_distinct > dim) EXIT
5962 pack_distinct(count_distinct) = vect(i)
5963 ENDDO vectm2
5964 ENDIF
5965ELSE
5966 IF (lback) THEN
5967 vect1: DO i = 1, SIZE(vect)
5968! DO j = i-1, 1, -1
5969! IF (vect(j) == vect(i)) CYCLE vect1
5970 DO j = count_distinct, 1, -1
5971 IF (pack_distinct(j) == vect(i)) cycle vect1
5972 ENDDO
5973 count_distinct = count_distinct + 1
5974 IF (count_distinct > dim) EXIT
5975 pack_distinct(count_distinct) = vect(i)
5976 ENDDO vect1
5977 ELSE
5978 vect2: DO i = 1, SIZE(vect)
5979! DO j = 1, i-1
5980! IF (vect(j) == vect(i)) CYCLE vect2
5981 DO j = 1, count_distinct
5982 IF (pack_distinct(j) == vect(i)) cycle vect2
5983 ENDDO
5984 count_distinct = count_distinct + 1
5985 IF (count_distinct > dim) EXIT
5986 pack_distinct(count_distinct) = vect(i)
5987 ENDDO vect2
5988 ENDIF
5989ENDIF
5990
5991END SUBROUTINE pack_distinct_c
5992
5994FUNCTION map(mask) RESULT(mapidx)
5995LOGICAL,INTENT(in) :: mask(:)
5996INTEGER :: mapidx(count(mask))
5997
5998INTEGER :: i,j
5999
6000j = 0
6001DO i=1, SIZE(mask)
6002 j = j + 1
6003 IF (mask(i)) mapidx(j)=i
6004ENDDO
6005
6006END FUNCTION map
6007
6008#define ARRAYOF_ORIGEQ 1
6009
6010#undef ARRAYOF_ORIGTYPE
6011#undef ARRAYOF_TYPE
6012#define ARRAYOF_ORIGTYPE INTEGER
6013#define ARRAYOF_TYPE arrayof_integer
6014#include "arrayof_post.F90"
6015
6016#undef ARRAYOF_ORIGTYPE
6017#undef ARRAYOF_TYPE
6018#define ARRAYOF_ORIGTYPE REAL
6019#define ARRAYOF_TYPE arrayof_real
6020#include "arrayof_post.F90"
6021
6022#undef ARRAYOF_ORIGTYPE
6023#undef ARRAYOF_TYPE
6024#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6025#define ARRAYOF_TYPE arrayof_doubleprecision
6026#include "arrayof_post.F90"
6027
6028#undef ARRAYOF_ORIGEQ
6029
6030#undef ARRAYOF_ORIGTYPE
6031#undef ARRAYOF_TYPE
6032#define ARRAYOF_ORIGTYPE LOGICAL
6033#define ARRAYOF_TYPE arrayof_logical
6034#include "arrayof_post.F90"
6035
6036END 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.