libsim Versione 7.2.6

◆ count_distinct_sorted_c()

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

conta gli elementi distinti in un sorted array

Definizione alla linea 4466 del file array_utilities.F90.

4467! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4468! authors:
4469! Davide Cesari <dcesari@arpa.emr.it>
4470! Paolo Patruno <ppatruno@arpa.emr.it>
4471
4472! This program is free software; you can redistribute it and/or
4473! modify it under the terms of the GNU General Public License as
4474! published by the Free Software Foundation; either version 2 of
4475! the License, or (at your option) any later version.
4476
4477! This program is distributed in the hope that it will be useful,
4478! but WITHOUT ANY WARRANTY; without even the implied warranty of
4479! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4480! GNU General Public License for more details.
4481
4482! You should have received a copy of the GNU General Public License
4483! along with this program. If not, see <http://www.gnu.org/licenses/>.
4484
4485
4486
4487!> This module defines usefull general purpose function and subroutine
4488!!\ingroup base
4489#include "config.h"
4490MODULE array_utilities
4491
4492IMPLICIT NONE
4493
4494! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4495!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4496
4497#undef VOL7D_POLY_TYPE_AUTO
4498
4499#undef VOL7D_POLY_TYPE
4500#undef VOL7D_POLY_TYPES
4501#define VOL7D_POLY_TYPE INTEGER
4502#define VOL7D_POLY_TYPES _i
4503#define ENABLE_SORT
4504#include "array_utilities_pre.F90"
4505#undef ENABLE_SORT
4506
4507#undef VOL7D_POLY_TYPE
4508#undef VOL7D_POLY_TYPES
4509#define VOL7D_POLY_TYPE REAL
4510#define VOL7D_POLY_TYPES _r
4511#define ENABLE_SORT
4512#include "array_utilities_pre.F90"
4513#undef ENABLE_SORT
4514
4515#undef VOL7D_POLY_TYPE
4516#undef VOL7D_POLY_TYPES
4517#define VOL7D_POLY_TYPE DOUBLEPRECISION
4518#define VOL7D_POLY_TYPES _d
4519#define ENABLE_SORT
4520#include "array_utilities_pre.F90"
4521#undef ENABLE_SORT
4522
4523#define VOL7D_NO_PACK
4524#undef VOL7D_POLY_TYPE
4525#undef VOL7D_POLY_TYPES
4526#define VOL7D_POLY_TYPE CHARACTER(len=*)
4527#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4528#define VOL7D_POLY_TYPES _c
4529#define ENABLE_SORT
4530#include "array_utilities_pre.F90"
4531#undef VOL7D_POLY_TYPE_AUTO
4532#undef ENABLE_SORT
4533
4534
4535#define ARRAYOF_ORIGEQ 1
4536
4537#define ARRAYOF_ORIGTYPE INTEGER
4538#define ARRAYOF_TYPE arrayof_integer
4539#include "arrayof_pre.F90"
4540
4541#undef ARRAYOF_ORIGTYPE
4542#undef ARRAYOF_TYPE
4543#define ARRAYOF_ORIGTYPE REAL
4544#define ARRAYOF_TYPE arrayof_real
4545#include "arrayof_pre.F90"
4546
4547#undef ARRAYOF_ORIGTYPE
4548#undef ARRAYOF_TYPE
4549#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4550#define ARRAYOF_TYPE arrayof_doubleprecision
4551#include "arrayof_pre.F90"
4552
4553#undef ARRAYOF_ORIGEQ
4554
4555#undef ARRAYOF_ORIGTYPE
4556#undef ARRAYOF_TYPE
4557#define ARRAYOF_ORIGTYPE LOGICAL
4558#define ARRAYOF_TYPE arrayof_logical
4559#include "arrayof_pre.F90"
4560
4561PRIVATE
4562! from arrayof
4564PUBLIC insert_unique, append_unique
4565
4566PUBLIC sort, index, index_c, &
4567 count_distinct_sorted, pack_distinct_sorted, &
4568 count_distinct, pack_distinct, count_and_pack_distinct, &
4569 map_distinct, map_inv_distinct, &
4570 firsttrue, lasttrue, pack_distinct_c, map
4571
4572CONTAINS
4573
4574
4575!> Return the index ot the first true element of the input logical array \a v.
4576!! If no \c .TRUE. elements are found, it returns 0.
4577FUNCTION firsttrue(v) RESULT(i)
4578LOGICAL,INTENT(in) :: v(:) !< logical array to test
4579INTEGER :: i
4580
4581DO i = 1, SIZE(v)
4582 IF (v(i)) RETURN
4583ENDDO
4584i = 0
4585
4586END FUNCTION firsttrue
4587
4588
4589!> Return the index ot the last true element of the input logical array \a v.
4590!! If no \c .TRUE. elements are found, it returns 0.
4591FUNCTION lasttrue(v) RESULT(i)
4592LOGICAL,INTENT(in) :: v(:) !< logical array to test
4593INTEGER :: i
4594
4595DO i = SIZE(v), 1, -1
4596 IF (v(i)) RETURN
4597ENDDO
4598
4599END FUNCTION lasttrue
4600
4601
4602! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4603#undef VOL7D_POLY_TYPE_AUTO
4604#undef VOL7D_NO_PACK
4605
4606#undef VOL7D_POLY_TYPE
4607#undef VOL7D_POLY_TYPES
4608#define VOL7D_POLY_TYPE INTEGER
4609#define VOL7D_POLY_TYPES _i
4610#define ENABLE_SORT
4611#include "array_utilities_inc.F90"
4612#undef ENABLE_SORT
4613
4614#undef VOL7D_POLY_TYPE
4615#undef VOL7D_POLY_TYPES
4616#define VOL7D_POLY_TYPE REAL
4617#define VOL7D_POLY_TYPES _r
4618#define ENABLE_SORT
4619#include "array_utilities_inc.F90"
4620#undef ENABLE_SORT
4621
4622#undef VOL7D_POLY_TYPE
4623#undef VOL7D_POLY_TYPES
4624#define VOL7D_POLY_TYPE DOUBLEPRECISION
4625#define VOL7D_POLY_TYPES _d
4626#define ENABLE_SORT
4627#include "array_utilities_inc.F90"
4628#undef ENABLE_SORT
4629
4630#define VOL7D_NO_PACK
4631#undef VOL7D_POLY_TYPE
4632#undef VOL7D_POLY_TYPES
4633#define VOL7D_POLY_TYPE CHARACTER(len=*)
4634#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4635#define VOL7D_POLY_TYPES _c
4636#define ENABLE_SORT
4637#include "array_utilities_inc.F90"
4638#undef VOL7D_POLY_TYPE_AUTO
4639#undef ENABLE_SORT
4640
4641SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
4642CHARACTER(len=*),INTENT(in) :: vect(:)
4643LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
4644CHARACTER(len=LEN(vect)) :: pack_distinct(:)
4645
4646INTEGER :: count_distinct
4647INTEGER :: i, j, dim
4648LOGICAL :: lback
4649
4650dim = SIZE(pack_distinct)
4651IF (PRESENT(back)) THEN
4652 lback = back
4653ELSE
4654 lback = .false.
4655ENDIF
4656count_distinct = 0
4657
4658IF (PRESENT (mask)) THEN
4659 IF (lback) THEN
4660 vectm1: DO i = 1, SIZE(vect)
4661 IF (.NOT.mask(i)) cycle vectm1
4662! DO j = i-1, 1, -1
4663! IF (vect(j) == vect(i)) CYCLE vectm1
4664 DO j = count_distinct, 1, -1
4665 IF (pack_distinct(j) == vect(i)) cycle vectm1
4666 ENDDO
4667 count_distinct = count_distinct + 1
4668 IF (count_distinct > dim) EXIT
4669 pack_distinct(count_distinct) = vect(i)
4670 ENDDO vectm1
4671 ELSE
4672 vectm2: DO i = 1, SIZE(vect)
4673 IF (.NOT.mask(i)) cycle vectm2
4674! DO j = 1, i-1
4675! IF (vect(j) == vect(i)) CYCLE vectm2
4676 DO j = 1, count_distinct
4677 IF (pack_distinct(j) == vect(i)) cycle vectm2
4678 ENDDO
4679 count_distinct = count_distinct + 1
4680 IF (count_distinct > dim) EXIT
4681 pack_distinct(count_distinct) = vect(i)
4682 ENDDO vectm2
4683 ENDIF
4684ELSE
4685 IF (lback) THEN
4686 vect1: DO i = 1, SIZE(vect)
4687! DO j = i-1, 1, -1
4688! IF (vect(j) == vect(i)) CYCLE vect1
4689 DO j = count_distinct, 1, -1
4690 IF (pack_distinct(j) == vect(i)) cycle vect1
4691 ENDDO
4692 count_distinct = count_distinct + 1
4693 IF (count_distinct > dim) EXIT
4694 pack_distinct(count_distinct) = vect(i)
4695 ENDDO vect1
4696 ELSE
4697 vect2: DO i = 1, SIZE(vect)
4698! DO j = 1, i-1
4699! IF (vect(j) == vect(i)) CYCLE vect2
4700 DO j = 1, count_distinct
4701 IF (pack_distinct(j) == vect(i)) cycle vect2
4702 ENDDO
4703 count_distinct = count_distinct + 1
4704 IF (count_distinct > dim) EXIT
4705 pack_distinct(count_distinct) = vect(i)
4706 ENDDO vect2
4707 ENDIF
4708ENDIF
4709
4710END SUBROUTINE pack_distinct_c
4711
4712!> Return the index of the array only where the mask is true
4713FUNCTION map(mask) RESULT(mapidx)
4714LOGICAL,INTENT(in) :: mask(:)
4715INTEGER :: mapidx(count(mask))
4716
4717INTEGER :: i,j
4718
4719j = 0
4720DO i=1, SIZE(mask)
4721 j = j + 1
4722 IF (mask(i)) mapidx(j)=i
4723ENDDO
4724
4725END FUNCTION map
4726
4727#define ARRAYOF_ORIGEQ 1
4728
4729#undef ARRAYOF_ORIGTYPE
4730#undef ARRAYOF_TYPE
4731#define ARRAYOF_ORIGTYPE INTEGER
4732#define ARRAYOF_TYPE arrayof_integer
4733#include "arrayof_post.F90"
4734
4735#undef ARRAYOF_ORIGTYPE
4736#undef ARRAYOF_TYPE
4737#define ARRAYOF_ORIGTYPE REAL
4738#define ARRAYOF_TYPE arrayof_real
4739#include "arrayof_post.F90"
4740
4741#undef ARRAYOF_ORIGTYPE
4742#undef ARRAYOF_TYPE
4743#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4744#define ARRAYOF_TYPE arrayof_doubleprecision
4745#include "arrayof_post.F90"
4746
4747#undef ARRAYOF_ORIGEQ
4748
4749#undef ARRAYOF_ORIGTYPE
4750#undef ARRAYOF_TYPE
4751#define ARRAYOF_ORIGTYPE LOGICAL
4752#define ARRAYOF_TYPE arrayof_logical
4753#include "arrayof_post.F90"
4754
4755END 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.