libsim Versione 7.2.1
|
◆ 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 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"
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
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
Quick method to append an element to the array. Definition array_utilities.F90:508 Method for inserting elements of the array at a desired position. Definition array_utilities.F90:499 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition array_utilities.F90:531 Method for removing elements of the array at a desired position. Definition array_utilities.F90:514 This module defines usefull general purpose function and subroutine. Definition array_utilities.F90:212 |