libsim Versione 7.1.11

◆ 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 4472 del file array_utilities.F90.

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