libsim Versione 7.2.1

◆ arrayof_logical_insert()

subroutine, private arrayof_logical_insert ( type(arrayof_logical) this,
logical, intent(in) content,
integer, intent(in), optional pos )
private

Method for inserting an element of the array at a desired position.

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

Parametri
thisarray object to extend
[in]contentobject of TYPE LOGICAL to insert
[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 6405 del file array_utilities.F90.

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