libsim Versione 7.2.6

◆ 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 6303 del file array_utilities.F90.

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