libsim Versione 7.1.11

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

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