libsim Versione 7.2.6

◆ arrayof_real_packarray()

subroutine, private arrayof_real_packarray ( type(arrayof_real) 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 6022 del file array_utilities.F90.

6023! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6024! authors:
6025! Davide Cesari <dcesari@arpa.emr.it>
6026! Paolo Patruno <ppatruno@arpa.emr.it>
6027
6028! This program is free software; you can redistribute it and/or
6029! modify it under the terms of the GNU General Public License as
6030! published by the Free Software Foundation; either version 2 of
6031! the License, or (at your option) any later version.
6032
6033! This program is distributed in the hope that it will be useful,
6034! but WITHOUT ANY WARRANTY; without even the implied warranty of
6035! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6036! GNU General Public License for more details.
6037
6038! You should have received a copy of the GNU General Public License
6039! along with this program. If not, see <http://www.gnu.org/licenses/>.
6040
6041
6042
6043!> This module defines usefull general purpose function and subroutine
6044!!\ingroup base
6045#include "config.h"
6046MODULE array_utilities
6047
6048IMPLICIT NONE
6049
6050! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6051!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6052
6053#undef VOL7D_POLY_TYPE_AUTO
6054
6055#undef VOL7D_POLY_TYPE
6056#undef VOL7D_POLY_TYPES
6057#define VOL7D_POLY_TYPE INTEGER
6058#define VOL7D_POLY_TYPES _i
6059#define ENABLE_SORT
6060#include "array_utilities_pre.F90"
6061#undef ENABLE_SORT
6062
6063#undef VOL7D_POLY_TYPE
6064#undef VOL7D_POLY_TYPES
6065#define VOL7D_POLY_TYPE REAL
6066#define VOL7D_POLY_TYPES _r
6067#define ENABLE_SORT
6068#include "array_utilities_pre.F90"
6069#undef ENABLE_SORT
6070
6071#undef VOL7D_POLY_TYPE
6072#undef VOL7D_POLY_TYPES
6073#define VOL7D_POLY_TYPE DOUBLEPRECISION
6074#define VOL7D_POLY_TYPES _d
6075#define ENABLE_SORT
6076#include "array_utilities_pre.F90"
6077#undef ENABLE_SORT
6078
6079#define VOL7D_NO_PACK
6080#undef VOL7D_POLY_TYPE
6081#undef VOL7D_POLY_TYPES
6082#define VOL7D_POLY_TYPE CHARACTER(len=*)
6083#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6084#define VOL7D_POLY_TYPES _c
6085#define ENABLE_SORT
6086#include "array_utilities_pre.F90"
6087#undef VOL7D_POLY_TYPE_AUTO
6088#undef ENABLE_SORT
6089
6090
6091#define ARRAYOF_ORIGEQ 1
6092
6093#define ARRAYOF_ORIGTYPE INTEGER
6094#define ARRAYOF_TYPE arrayof_integer
6095#include "arrayof_pre.F90"
6096
6097#undef ARRAYOF_ORIGTYPE
6098#undef ARRAYOF_TYPE
6099#define ARRAYOF_ORIGTYPE REAL
6100#define ARRAYOF_TYPE arrayof_real
6101#include "arrayof_pre.F90"
6102
6103#undef ARRAYOF_ORIGTYPE
6104#undef ARRAYOF_TYPE
6105#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6106#define ARRAYOF_TYPE arrayof_doubleprecision
6107#include "arrayof_pre.F90"
6108
6109#undef ARRAYOF_ORIGEQ
6110
6111#undef ARRAYOF_ORIGTYPE
6112#undef ARRAYOF_TYPE
6113#define ARRAYOF_ORIGTYPE LOGICAL
6114#define ARRAYOF_TYPE arrayof_logical
6115#include "arrayof_pre.F90"
6116
6117PRIVATE
6118! from arrayof
6120PUBLIC insert_unique, append_unique
6121
6122PUBLIC sort, index, index_c, &
6123 count_distinct_sorted, pack_distinct_sorted, &
6124 count_distinct, pack_distinct, count_and_pack_distinct, &
6125 map_distinct, map_inv_distinct, &
6126 firsttrue, lasttrue, pack_distinct_c, map
6127
6128CONTAINS
6129
6130
6131!> Return the index ot the first true element of the input logical array \a v.
6132!! If no \c .TRUE. elements are found, it returns 0.
6133FUNCTION firsttrue(v) RESULT(i)
6134LOGICAL,INTENT(in) :: v(:) !< logical array to test
6135INTEGER :: i
6136
6137DO i = 1, SIZE(v)
6138 IF (v(i)) RETURN
6139ENDDO
6140i = 0
6141
6142END FUNCTION firsttrue
6143
6144
6145!> Return the index ot the last true element of the input logical array \a v.
6146!! If no \c .TRUE. elements are found, it returns 0.
6147FUNCTION lasttrue(v) RESULT(i)
6148LOGICAL,INTENT(in) :: v(:) !< logical array to test
6149INTEGER :: i
6150
6151DO i = SIZE(v), 1, -1
6152 IF (v(i)) RETURN
6153ENDDO
6154
6155END FUNCTION lasttrue
6156
6157
6158! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6159#undef VOL7D_POLY_TYPE_AUTO
6160#undef VOL7D_NO_PACK
6161
6162#undef VOL7D_POLY_TYPE
6163#undef VOL7D_POLY_TYPES
6164#define VOL7D_POLY_TYPE INTEGER
6165#define VOL7D_POLY_TYPES _i
6166#define ENABLE_SORT
6167#include "array_utilities_inc.F90"
6168#undef ENABLE_SORT
6169
6170#undef VOL7D_POLY_TYPE
6171#undef VOL7D_POLY_TYPES
6172#define VOL7D_POLY_TYPE REAL
6173#define VOL7D_POLY_TYPES _r
6174#define ENABLE_SORT
6175#include "array_utilities_inc.F90"
6176#undef ENABLE_SORT
6177
6178#undef VOL7D_POLY_TYPE
6179#undef VOL7D_POLY_TYPES
6180#define VOL7D_POLY_TYPE DOUBLEPRECISION
6181#define VOL7D_POLY_TYPES _d
6182#define ENABLE_SORT
6183#include "array_utilities_inc.F90"
6184#undef ENABLE_SORT
6185
6186#define VOL7D_NO_PACK
6187#undef VOL7D_POLY_TYPE
6188#undef VOL7D_POLY_TYPES
6189#define VOL7D_POLY_TYPE CHARACTER(len=*)
6190#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6191#define VOL7D_POLY_TYPES _c
6192#define ENABLE_SORT
6193#include "array_utilities_inc.F90"
6194#undef VOL7D_POLY_TYPE_AUTO
6195#undef ENABLE_SORT
6196
6197SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6198CHARACTER(len=*),INTENT(in) :: vect(:)
6199LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6200CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6201
6202INTEGER :: count_distinct
6203INTEGER :: i, j, dim
6204LOGICAL :: lback
6205
6206dim = SIZE(pack_distinct)
6207IF (PRESENT(back)) THEN
6208 lback = back
6209ELSE
6210 lback = .false.
6211ENDIF
6212count_distinct = 0
6213
6214IF (PRESENT (mask)) THEN
6215 IF (lback) THEN
6216 vectm1: DO i = 1, SIZE(vect)
6217 IF (.NOT.mask(i)) cycle vectm1
6218! DO j = i-1, 1, -1
6219! IF (vect(j) == vect(i)) CYCLE vectm1
6220 DO j = count_distinct, 1, -1
6221 IF (pack_distinct(j) == vect(i)) cycle vectm1
6222 ENDDO
6223 count_distinct = count_distinct + 1
6224 IF (count_distinct > dim) EXIT
6225 pack_distinct(count_distinct) = vect(i)
6226 ENDDO vectm1
6227 ELSE
6228 vectm2: DO i = 1, SIZE(vect)
6229 IF (.NOT.mask(i)) cycle vectm2
6230! DO j = 1, i-1
6231! IF (vect(j) == vect(i)) CYCLE vectm2
6232 DO j = 1, count_distinct
6233 IF (pack_distinct(j) == vect(i)) cycle vectm2
6234 ENDDO
6235 count_distinct = count_distinct + 1
6236 IF (count_distinct > dim) EXIT
6237 pack_distinct(count_distinct) = vect(i)
6238 ENDDO vectm2
6239 ENDIF
6240ELSE
6241 IF (lback) THEN
6242 vect1: DO i = 1, SIZE(vect)
6243! DO j = i-1, 1, -1
6244! IF (vect(j) == vect(i)) CYCLE vect1
6245 DO j = count_distinct, 1, -1
6246 IF (pack_distinct(j) == vect(i)) cycle vect1
6247 ENDDO
6248 count_distinct = count_distinct + 1
6249 IF (count_distinct > dim) EXIT
6250 pack_distinct(count_distinct) = vect(i)
6251 ENDDO vect1
6252 ELSE
6253 vect2: DO i = 1, SIZE(vect)
6254! DO j = 1, i-1
6255! IF (vect(j) == vect(i)) CYCLE vect2
6256 DO j = 1, count_distinct
6257 IF (pack_distinct(j) == vect(i)) cycle vect2
6258 ENDDO
6259 count_distinct = count_distinct + 1
6260 IF (count_distinct > dim) EXIT
6261 pack_distinct(count_distinct) = vect(i)
6262 ENDDO vect2
6263 ENDIF
6264ENDIF
6265
6266END SUBROUTINE pack_distinct_c
6267
6268!> Return the index of the array only where the mask is true
6269FUNCTION map(mask) RESULT(mapidx)
6270LOGICAL,INTENT(in) :: mask(:)
6271INTEGER :: mapidx(count(mask))
6272
6273INTEGER :: i,j
6274
6275j = 0
6276DO i=1, SIZE(mask)
6277 j = j + 1
6278 IF (mask(i)) mapidx(j)=i
6279ENDDO
6280
6281END FUNCTION map
6282
6283#define ARRAYOF_ORIGEQ 1
6284
6285#undef ARRAYOF_ORIGTYPE
6286#undef ARRAYOF_TYPE
6287#define ARRAYOF_ORIGTYPE INTEGER
6288#define ARRAYOF_TYPE arrayof_integer
6289#include "arrayof_post.F90"
6290
6291#undef ARRAYOF_ORIGTYPE
6292#undef ARRAYOF_TYPE
6293#define ARRAYOF_ORIGTYPE REAL
6294#define ARRAYOF_TYPE arrayof_real
6295#include "arrayof_post.F90"
6296
6297#undef ARRAYOF_ORIGTYPE
6298#undef ARRAYOF_TYPE
6299#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6300#define ARRAYOF_TYPE arrayof_doubleprecision
6301#include "arrayof_post.F90"
6302
6303#undef ARRAYOF_ORIGEQ
6304
6305#undef ARRAYOF_ORIGTYPE
6306#undef ARRAYOF_TYPE
6307#define ARRAYOF_ORIGTYPE LOGICAL
6308#define ARRAYOF_TYPE arrayof_logical
6309#include "arrayof_post.F90"
6310
6311END 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.