libsim Versione 7.1.11

◆ arrayof_integer_append_unique()

integer function, private arrayof_integer_append_unique ( type(arrayof_integer this,
integer, intent(in)  content 
)
private

Quick function to append an element to the array only if it is not present in the array yet.

The return value is the position at which the element has been appended or at which it has been found.

Parametri
thisarray object to extend
[in]contentobject of TYPE INTEGER to append

Definizione alla linea 5616 del file array_utilities.F90.

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

Generated with Doxygen.