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