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