libsim Versione 7.1.11

◆ arrayof_doubleprecision_packarray()

subroutine arrayof_doubleprecision_packarray ( type(arrayof_doubleprecision 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 6309 del file array_utilities.F90.

6310! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6311! authors:
6312! Davide Cesari <dcesari@arpa.emr.it>
6313! Paolo Patruno <ppatruno@arpa.emr.it>
6314
6315! This program is free software; you can redistribute it and/or
6316! modify it under the terms of the GNU General Public License as
6317! published by the Free Software Foundation; either version 2 of
6318! the License, or (at your option) any later version.
6319
6320! This program is distributed in the hope that it will be useful,
6321! but WITHOUT ANY WARRANTY; without even the implied warranty of
6322! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6323! GNU General Public License for more details.
6324
6325! You should have received a copy of the GNU General Public License
6326! along with this program. If not, see <http://www.gnu.org/licenses/>.
6327
6328
6329
6332#include "config.h"
6333MODULE array_utilities
6334
6335IMPLICIT NONE
6336
6337! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6338!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6339
6340#undef VOL7D_POLY_TYPE_AUTO
6341
6342#undef VOL7D_POLY_TYPE
6343#undef VOL7D_POLY_TYPES
6344#define VOL7D_POLY_TYPE INTEGER
6345#define VOL7D_POLY_TYPES _i
6346#define ENABLE_SORT
6347#include "array_utilities_pre.F90"
6348#undef ENABLE_SORT
6349
6350#undef VOL7D_POLY_TYPE
6351#undef VOL7D_POLY_TYPES
6352#define VOL7D_POLY_TYPE REAL
6353#define VOL7D_POLY_TYPES _r
6354#define ENABLE_SORT
6355#include "array_utilities_pre.F90"
6356#undef ENABLE_SORT
6357
6358#undef VOL7D_POLY_TYPE
6359#undef VOL7D_POLY_TYPES
6360#define VOL7D_POLY_TYPE DOUBLEPRECISION
6361#define VOL7D_POLY_TYPES _d
6362#define ENABLE_SORT
6363#include "array_utilities_pre.F90"
6364#undef ENABLE_SORT
6365
6366#define VOL7D_NO_PACK
6367#undef VOL7D_POLY_TYPE
6368#undef VOL7D_POLY_TYPES
6369#define VOL7D_POLY_TYPE CHARACTER(len=*)
6370#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6371#define VOL7D_POLY_TYPES _c
6372#define ENABLE_SORT
6373#include "array_utilities_pre.F90"
6374#undef VOL7D_POLY_TYPE_AUTO
6375#undef ENABLE_SORT
6376
6377
6378#define ARRAYOF_ORIGEQ 1
6379
6380#define ARRAYOF_ORIGTYPE INTEGER
6381#define ARRAYOF_TYPE arrayof_integer
6382#include "arrayof_pre.F90"
6383
6384#undef ARRAYOF_ORIGTYPE
6385#undef ARRAYOF_TYPE
6386#define ARRAYOF_ORIGTYPE REAL
6387#define ARRAYOF_TYPE arrayof_real
6388#include "arrayof_pre.F90"
6389
6390#undef ARRAYOF_ORIGTYPE
6391#undef ARRAYOF_TYPE
6392#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6393#define ARRAYOF_TYPE arrayof_doubleprecision
6394#include "arrayof_pre.F90"
6395
6396#undef ARRAYOF_ORIGEQ
6397
6398#undef ARRAYOF_ORIGTYPE
6399#undef ARRAYOF_TYPE
6400#define ARRAYOF_ORIGTYPE LOGICAL
6401#define ARRAYOF_TYPE arrayof_logical
6402#include "arrayof_pre.F90"
6403
6404PRIVATE
6405! from arrayof
6407PUBLIC insert_unique, append_unique
6408
6409PUBLIC sort, index, index_c, &
6410 count_distinct_sorted, pack_distinct_sorted, &
6411 count_distinct, pack_distinct, count_and_pack_distinct, &
6412 map_distinct, map_inv_distinct, &
6413 firsttrue, lasttrue, pack_distinct_c, map
6414
6415CONTAINS
6416
6417
6420FUNCTION firsttrue(v) RESULT(i)
6421LOGICAL,INTENT(in) :: v(:)
6422INTEGER :: i
6423
6424DO i = 1, SIZE(v)
6425 IF (v(i)) RETURN
6426ENDDO
6427i = 0
6428
6429END FUNCTION firsttrue
6430
6431
6434FUNCTION lasttrue(v) RESULT(i)
6435LOGICAL,INTENT(in) :: v(:)
6436INTEGER :: i
6437
6438DO i = SIZE(v), 1, -1
6439 IF (v(i)) RETURN
6440ENDDO
6441
6442END FUNCTION lasttrue
6443
6444
6445! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6446#undef VOL7D_POLY_TYPE_AUTO
6447#undef VOL7D_NO_PACK
6448
6449#undef VOL7D_POLY_TYPE
6450#undef VOL7D_POLY_TYPES
6451#define VOL7D_POLY_TYPE INTEGER
6452#define VOL7D_POLY_TYPES _i
6453#define ENABLE_SORT
6454#include "array_utilities_inc.F90"
6455#undef ENABLE_SORT
6456
6457#undef VOL7D_POLY_TYPE
6458#undef VOL7D_POLY_TYPES
6459#define VOL7D_POLY_TYPE REAL
6460#define VOL7D_POLY_TYPES _r
6461#define ENABLE_SORT
6462#include "array_utilities_inc.F90"
6463#undef ENABLE_SORT
6464
6465#undef VOL7D_POLY_TYPE
6466#undef VOL7D_POLY_TYPES
6467#define VOL7D_POLY_TYPE DOUBLEPRECISION
6468#define VOL7D_POLY_TYPES _d
6469#define ENABLE_SORT
6470#include "array_utilities_inc.F90"
6471#undef ENABLE_SORT
6472
6473#define VOL7D_NO_PACK
6474#undef VOL7D_POLY_TYPE
6475#undef VOL7D_POLY_TYPES
6476#define VOL7D_POLY_TYPE CHARACTER(len=*)
6477#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6478#define VOL7D_POLY_TYPES _c
6479#define ENABLE_SORT
6480#include "array_utilities_inc.F90"
6481#undef VOL7D_POLY_TYPE_AUTO
6482#undef ENABLE_SORT
6483
6484SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6485CHARACTER(len=*),INTENT(in) :: vect(:)
6486LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6487CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6488
6489INTEGER :: count_distinct
6490INTEGER :: i, j, dim
6491LOGICAL :: lback
6492
6493dim = SIZE(pack_distinct)
6494IF (PRESENT(back)) THEN
6495 lback = back
6496ELSE
6497 lback = .false.
6498ENDIF
6499count_distinct = 0
6500
6501IF (PRESENT (mask)) THEN
6502 IF (lback) THEN
6503 vectm1: DO i = 1, SIZE(vect)
6504 IF (.NOT.mask(i)) cycle vectm1
6505! DO j = i-1, 1, -1
6506! IF (vect(j) == vect(i)) CYCLE vectm1
6507 DO j = count_distinct, 1, -1
6508 IF (pack_distinct(j) == vect(i)) cycle vectm1
6509 ENDDO
6510 count_distinct = count_distinct + 1
6511 IF (count_distinct > dim) EXIT
6512 pack_distinct(count_distinct) = vect(i)
6513 ENDDO vectm1
6514 ELSE
6515 vectm2: DO i = 1, SIZE(vect)
6516 IF (.NOT.mask(i)) cycle vectm2
6517! DO j = 1, i-1
6518! IF (vect(j) == vect(i)) CYCLE vectm2
6519 DO j = 1, count_distinct
6520 IF (pack_distinct(j) == vect(i)) cycle vectm2
6521 ENDDO
6522 count_distinct = count_distinct + 1
6523 IF (count_distinct > dim) EXIT
6524 pack_distinct(count_distinct) = vect(i)
6525 ENDDO vectm2
6526 ENDIF
6527ELSE
6528 IF (lback) THEN
6529 vect1: DO i = 1, SIZE(vect)
6530! DO j = i-1, 1, -1
6531! IF (vect(j) == vect(i)) CYCLE vect1
6532 DO j = count_distinct, 1, -1
6533 IF (pack_distinct(j) == vect(i)) cycle vect1
6534 ENDDO
6535 count_distinct = count_distinct + 1
6536 IF (count_distinct > dim) EXIT
6537 pack_distinct(count_distinct) = vect(i)
6538 ENDDO vect1
6539 ELSE
6540 vect2: DO i = 1, SIZE(vect)
6541! DO j = 1, i-1
6542! IF (vect(j) == vect(i)) CYCLE vect2
6543 DO j = 1, count_distinct
6544 IF (pack_distinct(j) == vect(i)) cycle vect2
6545 ENDDO
6546 count_distinct = count_distinct + 1
6547 IF (count_distinct > dim) EXIT
6548 pack_distinct(count_distinct) = vect(i)
6549 ENDDO vect2
6550 ENDIF
6551ENDIF
6552
6553END SUBROUTINE pack_distinct_c
6554
6556FUNCTION map(mask) RESULT(mapidx)
6557LOGICAL,INTENT(in) :: mask(:)
6558INTEGER :: mapidx(count(mask))
6559
6560INTEGER :: i,j
6561
6562j = 0
6563DO i=1, SIZE(mask)
6564 j = j + 1
6565 IF (mask(i)) mapidx(j)=i
6566ENDDO
6567
6568END FUNCTION map
6569
6570#define ARRAYOF_ORIGEQ 1
6571
6572#undef ARRAYOF_ORIGTYPE
6573#undef ARRAYOF_TYPE
6574#define ARRAYOF_ORIGTYPE INTEGER
6575#define ARRAYOF_TYPE arrayof_integer
6576#include "arrayof_post.F90"
6577
6578#undef ARRAYOF_ORIGTYPE
6579#undef ARRAYOF_TYPE
6580#define ARRAYOF_ORIGTYPE REAL
6581#define ARRAYOF_TYPE arrayof_real
6582#include "arrayof_post.F90"
6583
6584#undef ARRAYOF_ORIGTYPE
6585#undef ARRAYOF_TYPE
6586#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6587#define ARRAYOF_TYPE arrayof_doubleprecision
6588#include "arrayof_post.F90"
6589
6590#undef ARRAYOF_ORIGEQ
6591
6592#undef ARRAYOF_ORIGTYPE
6593#undef ARRAYOF_TYPE
6594#define ARRAYOF_ORIGTYPE LOGICAL
6595#define ARRAYOF_TYPE arrayof_logical
6596#include "arrayof_post.F90"
6597
6598END 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.