libsim Versione 7.1.11

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

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