libsim Versione 7.1.11

◆ map_distinct_c()

integer function, dimension(size(vect)) map_distinct_c ( character(len=*), dimension(:), intent(in)  vect,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back 
)
private

map distinct

Definizione alla linea 4582 del file array_utilities.F90.

4583! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4584! authors:
4585! Davide Cesari <dcesari@arpa.emr.it>
4586! Paolo Patruno <ppatruno@arpa.emr.it>
4587
4588! This program is free software; you can redistribute it and/or
4589! modify it under the terms of the GNU General Public License as
4590! published by the Free Software Foundation; either version 2 of
4591! the License, or (at your option) any later version.
4592
4593! This program is distributed in the hope that it will be useful,
4594! but WITHOUT ANY WARRANTY; without even the implied warranty of
4595! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4596! GNU General Public License for more details.
4597
4598! You should have received a copy of the GNU General Public License
4599! along with this program. If not, see <http://www.gnu.org/licenses/>.
4600
4601
4602
4605#include "config.h"
4606MODULE array_utilities
4607
4608IMPLICIT NONE
4609
4610! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4611!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4612
4613#undef VOL7D_POLY_TYPE_AUTO
4614
4615#undef VOL7D_POLY_TYPE
4616#undef VOL7D_POLY_TYPES
4617#define VOL7D_POLY_TYPE INTEGER
4618#define VOL7D_POLY_TYPES _i
4619#define ENABLE_SORT
4620#include "array_utilities_pre.F90"
4621#undef ENABLE_SORT
4622
4623#undef VOL7D_POLY_TYPE
4624#undef VOL7D_POLY_TYPES
4625#define VOL7D_POLY_TYPE REAL
4626#define VOL7D_POLY_TYPES _r
4627#define ENABLE_SORT
4628#include "array_utilities_pre.F90"
4629#undef ENABLE_SORT
4630
4631#undef VOL7D_POLY_TYPE
4632#undef VOL7D_POLY_TYPES
4633#define VOL7D_POLY_TYPE DOUBLEPRECISION
4634#define VOL7D_POLY_TYPES _d
4635#define ENABLE_SORT
4636#include "array_utilities_pre.F90"
4637#undef ENABLE_SORT
4638
4639#define VOL7D_NO_PACK
4640#undef VOL7D_POLY_TYPE
4641#undef VOL7D_POLY_TYPES
4642#define VOL7D_POLY_TYPE CHARACTER(len=*)
4643#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4644#define VOL7D_POLY_TYPES _c
4645#define ENABLE_SORT
4646#include "array_utilities_pre.F90"
4647#undef VOL7D_POLY_TYPE_AUTO
4648#undef ENABLE_SORT
4649
4650
4651#define ARRAYOF_ORIGEQ 1
4652
4653#define ARRAYOF_ORIGTYPE INTEGER
4654#define ARRAYOF_TYPE arrayof_integer
4655#include "arrayof_pre.F90"
4656
4657#undef ARRAYOF_ORIGTYPE
4658#undef ARRAYOF_TYPE
4659#define ARRAYOF_ORIGTYPE REAL
4660#define ARRAYOF_TYPE arrayof_real
4661#include "arrayof_pre.F90"
4662
4663#undef ARRAYOF_ORIGTYPE
4664#undef ARRAYOF_TYPE
4665#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4666#define ARRAYOF_TYPE arrayof_doubleprecision
4667#include "arrayof_pre.F90"
4668
4669#undef ARRAYOF_ORIGEQ
4670
4671#undef ARRAYOF_ORIGTYPE
4672#undef ARRAYOF_TYPE
4673#define ARRAYOF_ORIGTYPE LOGICAL
4674#define ARRAYOF_TYPE arrayof_logical
4675#include "arrayof_pre.F90"
4676
4677PRIVATE
4678! from arrayof
4680PUBLIC insert_unique, append_unique
4681
4682PUBLIC sort, index, index_c, &
4683 count_distinct_sorted, pack_distinct_sorted, &
4684 count_distinct, pack_distinct, count_and_pack_distinct, &
4685 map_distinct, map_inv_distinct, &
4686 firsttrue, lasttrue, pack_distinct_c, map
4687
4688CONTAINS
4689
4690
4693FUNCTION firsttrue(v) RESULT(i)
4694LOGICAL,INTENT(in) :: v(:)
4695INTEGER :: i
4696
4697DO i = 1, SIZE(v)
4698 IF (v(i)) RETURN
4699ENDDO
4700i = 0
4701
4702END FUNCTION firsttrue
4703
4704
4707FUNCTION lasttrue(v) RESULT(i)
4708LOGICAL,INTENT(in) :: v(:)
4709INTEGER :: i
4710
4711DO i = SIZE(v), 1, -1
4712 IF (v(i)) RETURN
4713ENDDO
4714
4715END FUNCTION lasttrue
4716
4717
4718! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4719#undef VOL7D_POLY_TYPE_AUTO
4720#undef VOL7D_NO_PACK
4721
4722#undef VOL7D_POLY_TYPE
4723#undef VOL7D_POLY_TYPES
4724#define VOL7D_POLY_TYPE INTEGER
4725#define VOL7D_POLY_TYPES _i
4726#define ENABLE_SORT
4727#include "array_utilities_inc.F90"
4728#undef ENABLE_SORT
4729
4730#undef VOL7D_POLY_TYPE
4731#undef VOL7D_POLY_TYPES
4732#define VOL7D_POLY_TYPE REAL
4733#define VOL7D_POLY_TYPES _r
4734#define ENABLE_SORT
4735#include "array_utilities_inc.F90"
4736#undef ENABLE_SORT
4737
4738#undef VOL7D_POLY_TYPE
4739#undef VOL7D_POLY_TYPES
4740#define VOL7D_POLY_TYPE DOUBLEPRECISION
4741#define VOL7D_POLY_TYPES _d
4742#define ENABLE_SORT
4743#include "array_utilities_inc.F90"
4744#undef ENABLE_SORT
4745
4746#define VOL7D_NO_PACK
4747#undef VOL7D_POLY_TYPE
4748#undef VOL7D_POLY_TYPES
4749#define VOL7D_POLY_TYPE CHARACTER(len=*)
4750#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4751#define VOL7D_POLY_TYPES _c
4752#define ENABLE_SORT
4753#include "array_utilities_inc.F90"
4754#undef VOL7D_POLY_TYPE_AUTO
4755#undef ENABLE_SORT
4756
4757SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
4758CHARACTER(len=*),INTENT(in) :: vect(:)
4759LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
4760CHARACTER(len=LEN(vect)) :: pack_distinct(:)
4761
4762INTEGER :: count_distinct
4763INTEGER :: i, j, dim
4764LOGICAL :: lback
4765
4766dim = SIZE(pack_distinct)
4767IF (PRESENT(back)) THEN
4768 lback = back
4769ELSE
4770 lback = .false.
4771ENDIF
4772count_distinct = 0
4773
4774IF (PRESENT (mask)) THEN
4775 IF (lback) THEN
4776 vectm1: DO i = 1, SIZE(vect)
4777 IF (.NOT.mask(i)) cycle vectm1
4778! DO j = i-1, 1, -1
4779! IF (vect(j) == vect(i)) CYCLE vectm1
4780 DO j = count_distinct, 1, -1
4781 IF (pack_distinct(j) == vect(i)) cycle vectm1
4782 ENDDO
4783 count_distinct = count_distinct + 1
4784 IF (count_distinct > dim) EXIT
4785 pack_distinct(count_distinct) = vect(i)
4786 ENDDO vectm1
4787 ELSE
4788 vectm2: DO i = 1, SIZE(vect)
4789 IF (.NOT.mask(i)) cycle vectm2
4790! DO j = 1, i-1
4791! IF (vect(j) == vect(i)) CYCLE vectm2
4792 DO j = 1, count_distinct
4793 IF (pack_distinct(j) == vect(i)) cycle vectm2
4794 ENDDO
4795 count_distinct = count_distinct + 1
4796 IF (count_distinct > dim) EXIT
4797 pack_distinct(count_distinct) = vect(i)
4798 ENDDO vectm2
4799 ENDIF
4800ELSE
4801 IF (lback) THEN
4802 vect1: DO i = 1, SIZE(vect)
4803! DO j = i-1, 1, -1
4804! IF (vect(j) == vect(i)) CYCLE vect1
4805 DO j = count_distinct, 1, -1
4806 IF (pack_distinct(j) == vect(i)) cycle vect1
4807 ENDDO
4808 count_distinct = count_distinct + 1
4809 IF (count_distinct > dim) EXIT
4810 pack_distinct(count_distinct) = vect(i)
4811 ENDDO vect1
4812 ELSE
4813 vect2: DO i = 1, SIZE(vect)
4814! DO j = 1, i-1
4815! IF (vect(j) == vect(i)) CYCLE vect2
4816 DO j = 1, count_distinct
4817 IF (pack_distinct(j) == vect(i)) cycle vect2
4818 ENDDO
4819 count_distinct = count_distinct + 1
4820 IF (count_distinct > dim) EXIT
4821 pack_distinct(count_distinct) = vect(i)
4822 ENDDO vect2
4823 ENDIF
4824ENDIF
4825
4826END SUBROUTINE pack_distinct_c
4827
4829FUNCTION map(mask) RESULT(mapidx)
4830LOGICAL,INTENT(in) :: mask(:)
4831INTEGER :: mapidx(count(mask))
4832
4833INTEGER :: i,j
4834
4835j = 0
4836DO i=1, SIZE(mask)
4837 j = j + 1
4838 IF (mask(i)) mapidx(j)=i
4839ENDDO
4840
4841END FUNCTION map
4842
4843#define ARRAYOF_ORIGEQ 1
4844
4845#undef ARRAYOF_ORIGTYPE
4846#undef ARRAYOF_TYPE
4847#define ARRAYOF_ORIGTYPE INTEGER
4848#define ARRAYOF_TYPE arrayof_integer
4849#include "arrayof_post.F90"
4850
4851#undef ARRAYOF_ORIGTYPE
4852#undef ARRAYOF_TYPE
4853#define ARRAYOF_ORIGTYPE REAL
4854#define ARRAYOF_TYPE arrayof_real
4855#include "arrayof_post.F90"
4856
4857#undef ARRAYOF_ORIGTYPE
4858#undef ARRAYOF_TYPE
4859#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4860#define ARRAYOF_TYPE arrayof_doubleprecision
4861#include "arrayof_post.F90"
4862
4863#undef ARRAYOF_ORIGEQ
4864
4865#undef ARRAYOF_ORIGTYPE
4866#undef ARRAYOF_TYPE
4867#define ARRAYOF_ORIGTYPE LOGICAL
4868#define ARRAYOF_TYPE arrayof_logical
4869#include "arrayof_post.F90"
4870
4871END 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.