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