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