libsim Versione 7.2.1

◆ arrayof_logical_remove()

subroutine, private arrayof_logical_remove ( type(arrayof_logical) this,
integer, intent(in), optional nelem,
integer, intent(in), optional pos )
private

Method for removing elements of the array at a desired position.

If necessary, the array is reallocated to reduce space.

Parametri
thisarray object in which an element has to be removed
[in]nelemnumber of elements to remove, if not provided, a single element is removed
[in]posposition of the element to be removed, if it is out of range, it is clipped, if it is not provided, objects are removed at the end

Definizione alla linea 6436 del file array_utilities.F90.

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