libsim Versione 7.1.11
|
◆ arrayof_logical_remove()
Method for removing elements of the array at a desired position. If necessary, the array is reallocated to reduce space.
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"
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
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
Quick method to append an element to the array. Definition: array_utilities.F90:514 Destructor for finalizing an array object. Definition: array_utilities.F90:527 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:505 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:537 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:520 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:218 |