libsim Versione 7.2.6

◆ arrayof_logical_insert_array()

subroutine, private arrayof_logical_insert_array ( type(arrayof_logical) this,
logical, dimension(:), intent(in), optional content,
integer, intent(in), optional nelem,
integer, intent(in), optional pos )
private

Method for inserting a number of elements of the array at a desired position.

If necessary, the array is reallocated to accomodate the new elements.

Parametri
thisarray object to extend
[in]contentobject of TYPE LOGICAL to insert, if not provided, space is reserved but not initialized
[in]nelemnumber of elements to add, mutually exclusive with the previous parameter, if both are not provided, a single element is added without initialization
[in]posposition where to insert, if it is out of range, it is clipped, if it is not provided, the object is appended

Definizione alla linea 6365 del file array_utilities.F90.

6366! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6367! authors:
6368! Davide Cesari <dcesari@arpa.emr.it>
6369! Paolo Patruno <ppatruno@arpa.emr.it>
6370
6371! This program is free software; you can redistribute it and/or
6372! modify it under the terms of the GNU General Public License as
6373! published by the Free Software Foundation; either version 2 of
6374! the License, or (at your option) any later version.
6375
6376! This program is distributed in the hope that it will be useful,
6377! but WITHOUT ANY WARRANTY; without even the implied warranty of
6378! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6379! GNU General Public License for more details.
6380
6381! You should have received a copy of the GNU General Public License
6382! along with this program. If not, see <http://www.gnu.org/licenses/>.
6383
6384
6385
6386!> This module defines usefull general purpose function and subroutine
6387!!\ingroup base
6388#include "config.h"
6389MODULE array_utilities
6390
6391IMPLICIT NONE
6392
6393! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6394!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6395
6396#undef VOL7D_POLY_TYPE_AUTO
6397
6398#undef VOL7D_POLY_TYPE
6399#undef VOL7D_POLY_TYPES
6400#define VOL7D_POLY_TYPE INTEGER
6401#define VOL7D_POLY_TYPES _i
6402#define ENABLE_SORT
6403#include "array_utilities_pre.F90"
6404#undef ENABLE_SORT
6405
6406#undef VOL7D_POLY_TYPE
6407#undef VOL7D_POLY_TYPES
6408#define VOL7D_POLY_TYPE REAL
6409#define VOL7D_POLY_TYPES _r
6410#define ENABLE_SORT
6411#include "array_utilities_pre.F90"
6412#undef ENABLE_SORT
6413
6414#undef VOL7D_POLY_TYPE
6415#undef VOL7D_POLY_TYPES
6416#define VOL7D_POLY_TYPE DOUBLEPRECISION
6417#define VOL7D_POLY_TYPES _d
6418#define ENABLE_SORT
6419#include "array_utilities_pre.F90"
6420#undef ENABLE_SORT
6421
6422#define VOL7D_NO_PACK
6423#undef VOL7D_POLY_TYPE
6424#undef VOL7D_POLY_TYPES
6425#define VOL7D_POLY_TYPE CHARACTER(len=*)
6426#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6427#define VOL7D_POLY_TYPES _c
6428#define ENABLE_SORT
6429#include "array_utilities_pre.F90"
6430#undef VOL7D_POLY_TYPE_AUTO
6431#undef ENABLE_SORT
6432
6433
6434#define ARRAYOF_ORIGEQ 1
6435
6436#define ARRAYOF_ORIGTYPE INTEGER
6437#define ARRAYOF_TYPE arrayof_integer
6438#include "arrayof_pre.F90"
6439
6440#undef ARRAYOF_ORIGTYPE
6441#undef ARRAYOF_TYPE
6442#define ARRAYOF_ORIGTYPE REAL
6443#define ARRAYOF_TYPE arrayof_real
6444#include "arrayof_pre.F90"
6445
6446#undef ARRAYOF_ORIGTYPE
6447#undef ARRAYOF_TYPE
6448#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6449#define ARRAYOF_TYPE arrayof_doubleprecision
6450#include "arrayof_pre.F90"
6451
6452#undef ARRAYOF_ORIGEQ
6453
6454#undef ARRAYOF_ORIGTYPE
6455#undef ARRAYOF_TYPE
6456#define ARRAYOF_ORIGTYPE LOGICAL
6457#define ARRAYOF_TYPE arrayof_logical
6458#include "arrayof_pre.F90"
6459
6460PRIVATE
6461! from arrayof
6463PUBLIC insert_unique, append_unique
6464
6465PUBLIC sort, index, index_c, &
6466 count_distinct_sorted, pack_distinct_sorted, &
6467 count_distinct, pack_distinct, count_and_pack_distinct, &
6468 map_distinct, map_inv_distinct, &
6469 firsttrue, lasttrue, pack_distinct_c, map
6470
6471CONTAINS
6472
6473
6474!> Return the index ot the first true element of the input logical array \a v.
6475!! If no \c .TRUE. elements are found, it returns 0.
6476FUNCTION firsttrue(v) RESULT(i)
6477LOGICAL,INTENT(in) :: v(:) !< logical array to test
6478INTEGER :: i
6479
6480DO i = 1, SIZE(v)
6481 IF (v(i)) RETURN
6482ENDDO
6483i = 0
6484
6485END FUNCTION firsttrue
6486
6487
6488!> Return the index ot the last true element of the input logical array \a v.
6489!! If no \c .TRUE. elements are found, it returns 0.
6490FUNCTION lasttrue(v) RESULT(i)
6491LOGICAL,INTENT(in) :: v(:) !< logical array to test
6492INTEGER :: i
6493
6494DO i = SIZE(v), 1, -1
6495 IF (v(i)) RETURN
6496ENDDO
6497
6498END FUNCTION lasttrue
6499
6500
6501! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6502#undef VOL7D_POLY_TYPE_AUTO
6503#undef VOL7D_NO_PACK
6504
6505#undef VOL7D_POLY_TYPE
6506#undef VOL7D_POLY_TYPES
6507#define VOL7D_POLY_TYPE INTEGER
6508#define VOL7D_POLY_TYPES _i
6509#define ENABLE_SORT
6510#include "array_utilities_inc.F90"
6511#undef ENABLE_SORT
6512
6513#undef VOL7D_POLY_TYPE
6514#undef VOL7D_POLY_TYPES
6515#define VOL7D_POLY_TYPE REAL
6516#define VOL7D_POLY_TYPES _r
6517#define ENABLE_SORT
6518#include "array_utilities_inc.F90"
6519#undef ENABLE_SORT
6520
6521#undef VOL7D_POLY_TYPE
6522#undef VOL7D_POLY_TYPES
6523#define VOL7D_POLY_TYPE DOUBLEPRECISION
6524#define VOL7D_POLY_TYPES _d
6525#define ENABLE_SORT
6526#include "array_utilities_inc.F90"
6527#undef ENABLE_SORT
6528
6529#define VOL7D_NO_PACK
6530#undef VOL7D_POLY_TYPE
6531#undef VOL7D_POLY_TYPES
6532#define VOL7D_POLY_TYPE CHARACTER(len=*)
6533#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6534#define VOL7D_POLY_TYPES _c
6535#define ENABLE_SORT
6536#include "array_utilities_inc.F90"
6537#undef VOL7D_POLY_TYPE_AUTO
6538#undef ENABLE_SORT
6539
6540SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6541CHARACTER(len=*),INTENT(in) :: vect(:)
6542LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6543CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6544
6545INTEGER :: count_distinct
6546INTEGER :: i, j, dim
6547LOGICAL :: lback
6548
6549dim = SIZE(pack_distinct)
6550IF (PRESENT(back)) THEN
6551 lback = back
6552ELSE
6553 lback = .false.
6554ENDIF
6555count_distinct = 0
6556
6557IF (PRESENT (mask)) THEN
6558 IF (lback) THEN
6559 vectm1: DO i = 1, SIZE(vect)
6560 IF (.NOT.mask(i)) cycle vectm1
6561! DO j = i-1, 1, -1
6562! IF (vect(j) == vect(i)) CYCLE vectm1
6563 DO j = count_distinct, 1, -1
6564 IF (pack_distinct(j) == vect(i)) cycle vectm1
6565 ENDDO
6566 count_distinct = count_distinct + 1
6567 IF (count_distinct > dim) EXIT
6568 pack_distinct(count_distinct) = vect(i)
6569 ENDDO vectm1
6570 ELSE
6571 vectm2: DO i = 1, SIZE(vect)
6572 IF (.NOT.mask(i)) cycle vectm2
6573! DO j = 1, i-1
6574! IF (vect(j) == vect(i)) CYCLE vectm2
6575 DO j = 1, count_distinct
6576 IF (pack_distinct(j) == vect(i)) cycle vectm2
6577 ENDDO
6578 count_distinct = count_distinct + 1
6579 IF (count_distinct > dim) EXIT
6580 pack_distinct(count_distinct) = vect(i)
6581 ENDDO vectm2
6582 ENDIF
6583ELSE
6584 IF (lback) THEN
6585 vect1: DO i = 1, SIZE(vect)
6586! DO j = i-1, 1, -1
6587! IF (vect(j) == vect(i)) CYCLE vect1
6588 DO j = count_distinct, 1, -1
6589 IF (pack_distinct(j) == vect(i)) cycle vect1
6590 ENDDO
6591 count_distinct = count_distinct + 1
6592 IF (count_distinct > dim) EXIT
6593 pack_distinct(count_distinct) = vect(i)
6594 ENDDO vect1
6595 ELSE
6596 vect2: DO i = 1, SIZE(vect)
6597! DO j = 1, i-1
6598! IF (vect(j) == vect(i)) CYCLE vect2
6599 DO j = 1, count_distinct
6600 IF (pack_distinct(j) == vect(i)) cycle vect2
6601 ENDDO
6602 count_distinct = count_distinct + 1
6603 IF (count_distinct > dim) EXIT
6604 pack_distinct(count_distinct) = vect(i)
6605 ENDDO vect2
6606 ENDIF
6607ENDIF
6608
6609END SUBROUTINE pack_distinct_c
6610
6611!> Return the index of the array only where the mask is true
6612FUNCTION map(mask) RESULT(mapidx)
6613LOGICAL,INTENT(in) :: mask(:)
6614INTEGER :: mapidx(count(mask))
6615
6616INTEGER :: i,j
6617
6618j = 0
6619DO i=1, SIZE(mask)
6620 j = j + 1
6621 IF (mask(i)) mapidx(j)=i
6622ENDDO
6623
6624END FUNCTION map
6625
6626#define ARRAYOF_ORIGEQ 1
6627
6628#undef ARRAYOF_ORIGTYPE
6629#undef ARRAYOF_TYPE
6630#define ARRAYOF_ORIGTYPE INTEGER
6631#define ARRAYOF_TYPE arrayof_integer
6632#include "arrayof_post.F90"
6633
6634#undef ARRAYOF_ORIGTYPE
6635#undef ARRAYOF_TYPE
6636#define ARRAYOF_ORIGTYPE REAL
6637#define ARRAYOF_TYPE arrayof_real
6638#include "arrayof_post.F90"
6639
6640#undef ARRAYOF_ORIGTYPE
6641#undef ARRAYOF_TYPE
6642#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6643#define ARRAYOF_TYPE arrayof_doubleprecision
6644#include "arrayof_post.F90"
6645
6646#undef ARRAYOF_ORIGEQ
6647
6648#undef ARRAYOF_ORIGTYPE
6649#undef ARRAYOF_TYPE
6650#define ARRAYOF_ORIGTYPE LOGICAL
6651#define ARRAYOF_TYPE arrayof_logical
6652#include "arrayof_post.F90"
6653
6654END 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.