libsim Versione 7.1.11

◆ count_distinct_c()

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

conta gli elementi distinti in vect

Definizione alla linea 4506 del file array_utilities.F90.

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