libsim Versione 7.2.6
|
◆ arrayof_integer_insert_unique()
Method for inserting an element of the array at a desired position only if it is not present in the array yet. If necessary, the array is reallocated to accomodate the new element.
Definizione alla linea 5590 del file array_utilities.F90. 5591! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5592! authors:
5593! Davide Cesari <dcesari@arpa.emr.it>
5594! Paolo Patruno <ppatruno@arpa.emr.it>
5595
5596! This program is free software; you can redistribute it and/or
5597! modify it under the terms of the GNU General Public License as
5598! published by the Free Software Foundation; either version 2 of
5599! the License, or (at your option) any later version.
5600
5601! This program is distributed in the hope that it will be useful,
5602! but WITHOUT ANY WARRANTY; without even the implied warranty of
5603! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5604! GNU General Public License for more details.
5605
5606! You should have received a copy of the GNU General Public License
5607! along with this program. If not, see <http://www.gnu.org/licenses/>.
5608
5609
5610
5611!> This module defines usefull general purpose function and subroutine
5612!!\ingroup base
5613#include "config.h"
5615
5616IMPLICIT NONE
5617
5618! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5619!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5620
5621#undef VOL7D_POLY_TYPE_AUTO
5622
5623#undef VOL7D_POLY_TYPE
5624#undef VOL7D_POLY_TYPES
5625#define VOL7D_POLY_TYPE INTEGER
5626#define VOL7D_POLY_TYPES _i
5627#define ENABLE_SORT
5628#include "array_utilities_pre.F90"
5629#undef ENABLE_SORT
5630
5631#undef VOL7D_POLY_TYPE
5632#undef VOL7D_POLY_TYPES
5633#define VOL7D_POLY_TYPE REAL
5634#define VOL7D_POLY_TYPES _r
5635#define ENABLE_SORT
5636#include "array_utilities_pre.F90"
5637#undef ENABLE_SORT
5638
5639#undef VOL7D_POLY_TYPE
5640#undef VOL7D_POLY_TYPES
5641#define VOL7D_POLY_TYPE DOUBLEPRECISION
5642#define VOL7D_POLY_TYPES _d
5643#define ENABLE_SORT
5644#include "array_utilities_pre.F90"
5645#undef ENABLE_SORT
5646
5647#define VOL7D_NO_PACK
5648#undef VOL7D_POLY_TYPE
5649#undef VOL7D_POLY_TYPES
5650#define VOL7D_POLY_TYPE CHARACTER(len=*)
5651#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5652#define VOL7D_POLY_TYPES _c
5653#define ENABLE_SORT
5654#include "array_utilities_pre.F90"
5655#undef VOL7D_POLY_TYPE_AUTO
5656#undef ENABLE_SORT
5657
5658
5659#define ARRAYOF_ORIGEQ 1
5660
5661#define ARRAYOF_ORIGTYPE INTEGER
5662#define ARRAYOF_TYPE arrayof_integer
5663#include "arrayof_pre.F90"
5664
5665#undef ARRAYOF_ORIGTYPE
5666#undef ARRAYOF_TYPE
5667#define ARRAYOF_ORIGTYPE REAL
5668#define ARRAYOF_TYPE arrayof_real
5669#include "arrayof_pre.F90"
5670
5671#undef ARRAYOF_ORIGTYPE
5672#undef ARRAYOF_TYPE
5673#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5674#define ARRAYOF_TYPE arrayof_doubleprecision
5675#include "arrayof_pre.F90"
5676
5677#undef ARRAYOF_ORIGEQ
5678
5679#undef ARRAYOF_ORIGTYPE
5680#undef ARRAYOF_TYPE
5681#define ARRAYOF_ORIGTYPE LOGICAL
5682#define ARRAYOF_TYPE arrayof_logical
5683#include "arrayof_pre.F90"
5684
5685PRIVATE
5686! from arrayof
5688PUBLIC insert_unique, append_unique
5689
5691 count_distinct_sorted, pack_distinct_sorted, &
5692 count_distinct, pack_distinct, count_and_pack_distinct, &
5693 map_distinct, map_inv_distinct, &
5694 firsttrue, lasttrue, pack_distinct_c, map
5695
5696CONTAINS
5697
5698
5699!> Return the index ot the first true element of the input logical array \a v.
5700!! If no \c .TRUE. elements are found, it returns 0.
5701FUNCTION firsttrue(v) RESULT(i)
5702LOGICAL,INTENT(in) :: v(:) !< logical array to test
5703INTEGER :: i
5704
5705DO i = 1, SIZE(v)
5706 IF (v(i)) RETURN
5707ENDDO
5708i = 0
5709
5710END FUNCTION firsttrue
5711
5712
5713!> Return the index ot the last true element of the input logical array \a v.
5714!! If no \c .TRUE. elements are found, it returns 0.
5715FUNCTION lasttrue(v) RESULT(i)
5716LOGICAL,INTENT(in) :: v(:) !< logical array to test
5717INTEGER :: i
5718
5719DO i = SIZE(v), 1, -1
5720 IF (v(i)) RETURN
5721ENDDO
5722
5723END FUNCTION lasttrue
5724
5725
5726! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5727#undef VOL7D_POLY_TYPE_AUTO
5728#undef VOL7D_NO_PACK
5729
5730#undef VOL7D_POLY_TYPE
5731#undef VOL7D_POLY_TYPES
5732#define VOL7D_POLY_TYPE INTEGER
5733#define VOL7D_POLY_TYPES _i
5734#define ENABLE_SORT
5735#include "array_utilities_inc.F90"
5736#undef ENABLE_SORT
5737
5738#undef VOL7D_POLY_TYPE
5739#undef VOL7D_POLY_TYPES
5740#define VOL7D_POLY_TYPE REAL
5741#define VOL7D_POLY_TYPES _r
5742#define ENABLE_SORT
5743#include "array_utilities_inc.F90"
5744#undef ENABLE_SORT
5745
5746#undef VOL7D_POLY_TYPE
5747#undef VOL7D_POLY_TYPES
5748#define VOL7D_POLY_TYPE DOUBLEPRECISION
5749#define VOL7D_POLY_TYPES _d
5750#define ENABLE_SORT
5751#include "array_utilities_inc.F90"
5752#undef ENABLE_SORT
5753
5754#define VOL7D_NO_PACK
5755#undef VOL7D_POLY_TYPE
5756#undef VOL7D_POLY_TYPES
5757#define VOL7D_POLY_TYPE CHARACTER(len=*)
5758#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5759#define VOL7D_POLY_TYPES _c
5760#define ENABLE_SORT
5761#include "array_utilities_inc.F90"
5762#undef VOL7D_POLY_TYPE_AUTO
5763#undef ENABLE_SORT
5764
5765SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5766CHARACTER(len=*),INTENT(in) :: vect(:)
5767LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5768CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5769
5770INTEGER :: count_distinct
5771INTEGER :: i, j, dim
5772LOGICAL :: lback
5773
5774dim = SIZE(pack_distinct)
5775IF (PRESENT(back)) THEN
5776 lback = back
5777ELSE
5778 lback = .false.
5779ENDIF
5780count_distinct = 0
5781
5782IF (PRESENT (mask)) THEN
5783 IF (lback) THEN
5784 vectm1: DO i = 1, SIZE(vect)
5785 IF (.NOT.mask(i)) cycle vectm1
5786! DO j = i-1, 1, -1
5787! IF (vect(j) == vect(i)) CYCLE vectm1
5788 DO j = count_distinct, 1, -1
5789 IF (pack_distinct(j) == vect(i)) cycle vectm1
5790 ENDDO
5791 count_distinct = count_distinct + 1
5792 IF (count_distinct > dim) EXIT
5793 pack_distinct(count_distinct) = vect(i)
5794 ENDDO vectm1
5795 ELSE
5796 vectm2: DO i = 1, SIZE(vect)
5797 IF (.NOT.mask(i)) cycle vectm2
5798! DO j = 1, i-1
5799! IF (vect(j) == vect(i)) CYCLE vectm2
5800 DO j = 1, count_distinct
5801 IF (pack_distinct(j) == vect(i)) cycle vectm2
5802 ENDDO
5803 count_distinct = count_distinct + 1
5804 IF (count_distinct > dim) EXIT
5805 pack_distinct(count_distinct) = vect(i)
5806 ENDDO vectm2
5807 ENDIF
5808ELSE
5809 IF (lback) THEN
5810 vect1: DO i = 1, SIZE(vect)
5811! DO j = i-1, 1, -1
5812! IF (vect(j) == vect(i)) CYCLE vect1
5813 DO j = count_distinct, 1, -1
5814 IF (pack_distinct(j) == vect(i)) cycle vect1
5815 ENDDO
5816 count_distinct = count_distinct + 1
5817 IF (count_distinct > dim) EXIT
5818 pack_distinct(count_distinct) = vect(i)
5819 ENDDO vect1
5820 ELSE
5821 vect2: DO i = 1, SIZE(vect)
5822! DO j = 1, i-1
5823! IF (vect(j) == vect(i)) CYCLE vect2
5824 DO j = 1, count_distinct
5825 IF (pack_distinct(j) == vect(i)) cycle vect2
5826 ENDDO
5827 count_distinct = count_distinct + 1
5828 IF (count_distinct > dim) EXIT
5829 pack_distinct(count_distinct) = vect(i)
5830 ENDDO vect2
5831 ENDIF
5832ENDIF
5833
5834END SUBROUTINE pack_distinct_c
5835
5836!> Return the index of the array only where the mask is true
5837FUNCTION map(mask) RESULT(mapidx)
5838LOGICAL,INTENT(in) :: mask(:)
5839INTEGER :: mapidx(count(mask))
5840
5841INTEGER :: i,j
5842
5843j = 0
5844DO i=1, SIZE(mask)
5845 j = j + 1
5846 IF (mask(i)) mapidx(j)=i
5847ENDDO
5848
5849END FUNCTION map
5850
5851#define ARRAYOF_ORIGEQ 1
5852
5853#undef ARRAYOF_ORIGTYPE
5854#undef ARRAYOF_TYPE
5855#define ARRAYOF_ORIGTYPE INTEGER
5856#define ARRAYOF_TYPE arrayof_integer
5857#include "arrayof_post.F90"
5858
5859#undef ARRAYOF_ORIGTYPE
5860#undef ARRAYOF_TYPE
5861#define ARRAYOF_ORIGTYPE REAL
5862#define ARRAYOF_TYPE arrayof_real
5863#include "arrayof_post.F90"
5864
5865#undef ARRAYOF_ORIGTYPE
5866#undef ARRAYOF_TYPE
5867#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5868#define ARRAYOF_TYPE arrayof_doubleprecision
5869#include "arrayof_post.F90"
5870
5871#undef ARRAYOF_ORIGEQ
5872
5873#undef ARRAYOF_ORIGTYPE
5874#undef ARRAYOF_TYPE
5875#define ARRAYOF_ORIGTYPE LOGICAL
5876#define ARRAYOF_TYPE arrayof_logical
5877#include "arrayof_post.F90"
5878
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 |