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