libsim Versione 7.2.4
|
◆ arrayof_logical_delete()
Destructor for finalizing an array object. If defined, calls the destructor for every element of the array object; finally it deallocates all the space occupied.
Definizione alla linea 6489 del file array_utilities.F90. 6494! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6495! authors:
6496! Davide Cesari <dcesari@arpa.emr.it>
6497! Paolo Patruno <ppatruno@arpa.emr.it>
6498
6499! This program is free software; you can redistribute it and/or
6500! modify it under the terms of the GNU General Public License as
6501! published by the Free Software Foundation; either version 2 of
6502! the License, or (at your option) any later version.
6503
6504! This program is distributed in the hope that it will be useful,
6505! but WITHOUT ANY WARRANTY; without even the implied warranty of
6506! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6507! GNU General Public License for more details.
6508
6509! You should have received a copy of the GNU General Public License
6510! along with this program. If not, see <http://www.gnu.org/licenses/>.
6511
6512
6513
6516#include "config.h"
6518
6519IMPLICIT NONE
6520
6521! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6522!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6523
6524#undef VOL7D_POLY_TYPE_AUTO
6525
6526#undef VOL7D_POLY_TYPE
6527#undef VOL7D_POLY_TYPES
6528#define VOL7D_POLY_TYPE INTEGER
6529#define VOL7D_POLY_TYPES _i
6530#define ENABLE_SORT
6531#include "array_utilities_pre.F90"
6532#undef ENABLE_SORT
6533
6534#undef VOL7D_POLY_TYPE
6535#undef VOL7D_POLY_TYPES
6536#define VOL7D_POLY_TYPE REAL
6537#define VOL7D_POLY_TYPES _r
6538#define ENABLE_SORT
6539#include "array_utilities_pre.F90"
6540#undef ENABLE_SORT
6541
6542#undef VOL7D_POLY_TYPE
6543#undef VOL7D_POLY_TYPES
6544#define VOL7D_POLY_TYPE DOUBLEPRECISION
6545#define VOL7D_POLY_TYPES _d
6546#define ENABLE_SORT
6547#include "array_utilities_pre.F90"
6548#undef ENABLE_SORT
6549
6550#define VOL7D_NO_PACK
6551#undef VOL7D_POLY_TYPE
6552#undef VOL7D_POLY_TYPES
6553#define VOL7D_POLY_TYPE CHARACTER(len=*)
6554#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6555#define VOL7D_POLY_TYPES _c
6556#define ENABLE_SORT
6557#include "array_utilities_pre.F90"
6558#undef VOL7D_POLY_TYPE_AUTO
6559#undef ENABLE_SORT
6560
6561
6562#define ARRAYOF_ORIGEQ 1
6563
6564#define ARRAYOF_ORIGTYPE INTEGER
6565#define ARRAYOF_TYPE arrayof_integer
6566#include "arrayof_pre.F90"
6567
6568#undef ARRAYOF_ORIGTYPE
6569#undef ARRAYOF_TYPE
6570#define ARRAYOF_ORIGTYPE REAL
6571#define ARRAYOF_TYPE arrayof_real
6572#include "arrayof_pre.F90"
6573
6574#undef ARRAYOF_ORIGTYPE
6575#undef ARRAYOF_TYPE
6576#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6577#define ARRAYOF_TYPE arrayof_doubleprecision
6578#include "arrayof_pre.F90"
6579
6580#undef ARRAYOF_ORIGEQ
6581
6582#undef ARRAYOF_ORIGTYPE
6583#undef ARRAYOF_TYPE
6584#define ARRAYOF_ORIGTYPE LOGICAL
6585#define ARRAYOF_TYPE arrayof_logical
6586#include "arrayof_pre.F90"
6587
6588PRIVATE
6589! from arrayof
6591PUBLIC insert_unique, append_unique
6592
6594 count_distinct_sorted, pack_distinct_sorted, &
6595 count_distinct, pack_distinct, count_and_pack_distinct, &
6596 map_distinct, map_inv_distinct, &
6597 firsttrue, lasttrue, pack_distinct_c, map
6598
6599CONTAINS
6600
6601
6604FUNCTION firsttrue(v) RESULT(i)
6605LOGICAL,INTENT(in) :: v(:)
6606INTEGER :: i
6607
6608DO i = 1, SIZE(v)
6609 IF (v(i)) RETURN
6610ENDDO
6611i = 0
6612
6613END FUNCTION firsttrue
6614
6615
6618FUNCTION lasttrue(v) RESULT(i)
6619LOGICAL,INTENT(in) :: v(:)
6620INTEGER :: i
6621
6622DO i = SIZE(v), 1, -1
6623 IF (v(i)) RETURN
6624ENDDO
6625
6626END FUNCTION lasttrue
6627
6628
6629! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6630#undef VOL7D_POLY_TYPE_AUTO
6631#undef VOL7D_NO_PACK
6632
6633#undef VOL7D_POLY_TYPE
6634#undef VOL7D_POLY_TYPES
6635#define VOL7D_POLY_TYPE INTEGER
6636#define VOL7D_POLY_TYPES _i
6637#define ENABLE_SORT
6638#include "array_utilities_inc.F90"
6639#undef ENABLE_SORT
6640
6641#undef VOL7D_POLY_TYPE
6642#undef VOL7D_POLY_TYPES
6643#define VOL7D_POLY_TYPE REAL
6644#define VOL7D_POLY_TYPES _r
6645#define ENABLE_SORT
6646#include "array_utilities_inc.F90"
6647#undef ENABLE_SORT
6648
6649#undef VOL7D_POLY_TYPE
6650#undef VOL7D_POLY_TYPES
6651#define VOL7D_POLY_TYPE DOUBLEPRECISION
6652#define VOL7D_POLY_TYPES _d
6653#define ENABLE_SORT
6654#include "array_utilities_inc.F90"
6655#undef ENABLE_SORT
6656
6657#define VOL7D_NO_PACK
6658#undef VOL7D_POLY_TYPE
6659#undef VOL7D_POLY_TYPES
6660#define VOL7D_POLY_TYPE CHARACTER(len=*)
6661#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6662#define VOL7D_POLY_TYPES _c
6663#define ENABLE_SORT
6664#include "array_utilities_inc.F90"
6665#undef VOL7D_POLY_TYPE_AUTO
6666#undef ENABLE_SORT
6667
6668SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6669CHARACTER(len=*),INTENT(in) :: vect(:)
6670LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6671CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6672
6673INTEGER :: count_distinct
6674INTEGER :: i, j, dim
6675LOGICAL :: lback
6676
6677dim = SIZE(pack_distinct)
6678IF (PRESENT(back)) THEN
6679 lback = back
6680ELSE
6681 lback = .false.
6682ENDIF
6683count_distinct = 0
6684
6685IF (PRESENT (mask)) THEN
6686 IF (lback) THEN
6687 vectm1: DO i = 1, SIZE(vect)
6688 IF (.NOT.mask(i)) cycle vectm1
6689! DO j = i-1, 1, -1
6690! IF (vect(j) == vect(i)) CYCLE vectm1
6691 DO j = count_distinct, 1, -1
6692 IF (pack_distinct(j) == vect(i)) cycle vectm1
6693 ENDDO
6694 count_distinct = count_distinct + 1
6695 IF (count_distinct > dim) EXIT
6696 pack_distinct(count_distinct) = vect(i)
6697 ENDDO vectm1
6698 ELSE
6699 vectm2: DO i = 1, SIZE(vect)
6700 IF (.NOT.mask(i)) cycle vectm2
6701! DO j = 1, i-1
6702! IF (vect(j) == vect(i)) CYCLE vectm2
6703 DO j = 1, count_distinct
6704 IF (pack_distinct(j) == vect(i)) cycle vectm2
6705 ENDDO
6706 count_distinct = count_distinct + 1
6707 IF (count_distinct > dim) EXIT
6708 pack_distinct(count_distinct) = vect(i)
6709 ENDDO vectm2
6710 ENDIF
6711ELSE
6712 IF (lback) THEN
6713 vect1: DO i = 1, SIZE(vect)
6714! DO j = i-1, 1, -1
6715! IF (vect(j) == vect(i)) CYCLE vect1
6716 DO j = count_distinct, 1, -1
6717 IF (pack_distinct(j) == vect(i)) cycle vect1
6718 ENDDO
6719 count_distinct = count_distinct + 1
6720 IF (count_distinct > dim) EXIT
6721 pack_distinct(count_distinct) = vect(i)
6722 ENDDO vect1
6723 ELSE
6724 vect2: DO i = 1, SIZE(vect)
6725! DO j = 1, i-1
6726! IF (vect(j) == vect(i)) CYCLE vect2
6727 DO j = 1, count_distinct
6728 IF (pack_distinct(j) == vect(i)) cycle vect2
6729 ENDDO
6730 count_distinct = count_distinct + 1
6731 IF (count_distinct > dim) EXIT
6732 pack_distinct(count_distinct) = vect(i)
6733 ENDDO vect2
6734 ENDIF
6735ENDIF
6736
6737END SUBROUTINE pack_distinct_c
6738
6740FUNCTION map(mask) RESULT(mapidx)
6741LOGICAL,INTENT(in) :: mask(:)
6742INTEGER :: mapidx(count(mask))
6743
6744INTEGER :: i,j
6745
6746j = 0
6747DO i=1, SIZE(mask)
6748 j = j + 1
6749 IF (mask(i)) mapidx(j)=i
6750ENDDO
6751
6752END FUNCTION map
6753
6754#define ARRAYOF_ORIGEQ 1
6755
6756#undef ARRAYOF_ORIGTYPE
6757#undef ARRAYOF_TYPE
6758#define ARRAYOF_ORIGTYPE INTEGER
6759#define ARRAYOF_TYPE arrayof_integer
6760#include "arrayof_post.F90"
6761
6762#undef ARRAYOF_ORIGTYPE
6763#undef ARRAYOF_TYPE
6764#define ARRAYOF_ORIGTYPE REAL
6765#define ARRAYOF_TYPE arrayof_real
6766#include "arrayof_post.F90"
6767
6768#undef ARRAYOF_ORIGTYPE
6769#undef ARRAYOF_TYPE
6770#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6771#define ARRAYOF_TYPE arrayof_doubleprecision
6772#include "arrayof_post.F90"
6773
6774#undef ARRAYOF_ORIGEQ
6775
6776#undef ARRAYOF_ORIGTYPE
6777#undef ARRAYOF_TYPE
6778#define ARRAYOF_ORIGTYPE LOGICAL
6779#define ARRAYOF_TYPE arrayof_logical
6780#include "arrayof_post.F90"
6781
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 |