libsim Versione 7.2.1

◆ map_inv_distinct_c()

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

map inv distinct

Definizione alla linea 4672 del file array_utilities.F90.

4674! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4675! authors:
4676! Davide Cesari <dcesari@arpa.emr.it>
4677! Paolo Patruno <ppatruno@arpa.emr.it>
4678
4679! This program is free software; you can redistribute it and/or
4680! modify it under the terms of the GNU General Public License as
4681! published by the Free Software Foundation; either version 2 of
4682! the License, or (at your option) any later version.
4683
4684! This program is distributed in the hope that it will be useful,
4685! but WITHOUT ANY WARRANTY; without even the implied warranty of
4686! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4687! GNU General Public License for more details.
4688
4689! You should have received a copy of the GNU General Public License
4690! along with this program. If not, see <http://www.gnu.org/licenses/>.
4691
4692
4693
4696#include "config.h"
4697MODULE array_utilities
4698
4699IMPLICIT NONE
4700
4701! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4702!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4703
4704#undef VOL7D_POLY_TYPE_AUTO
4705
4706#undef VOL7D_POLY_TYPE
4707#undef VOL7D_POLY_TYPES
4708#define VOL7D_POLY_TYPE INTEGER
4709#define VOL7D_POLY_TYPES _i
4710#define ENABLE_SORT
4711#include "array_utilities_pre.F90"
4712#undef ENABLE_SORT
4713
4714#undef VOL7D_POLY_TYPE
4715#undef VOL7D_POLY_TYPES
4716#define VOL7D_POLY_TYPE REAL
4717#define VOL7D_POLY_TYPES _r
4718#define ENABLE_SORT
4719#include "array_utilities_pre.F90"
4720#undef ENABLE_SORT
4721
4722#undef VOL7D_POLY_TYPE
4723#undef VOL7D_POLY_TYPES
4724#define VOL7D_POLY_TYPE DOUBLEPRECISION
4725#define VOL7D_POLY_TYPES _d
4726#define ENABLE_SORT
4727#include "array_utilities_pre.F90"
4728#undef ENABLE_SORT
4729
4730#define VOL7D_NO_PACK
4731#undef VOL7D_POLY_TYPE
4732#undef VOL7D_POLY_TYPES
4733#define VOL7D_POLY_TYPE CHARACTER(len=*)
4734#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4735#define VOL7D_POLY_TYPES _c
4736#define ENABLE_SORT
4737#include "array_utilities_pre.F90"
4738#undef VOL7D_POLY_TYPE_AUTO
4739#undef ENABLE_SORT
4740
4741
4742#define ARRAYOF_ORIGEQ 1
4743
4744#define ARRAYOF_ORIGTYPE INTEGER
4745#define ARRAYOF_TYPE arrayof_integer
4746#include "arrayof_pre.F90"
4747
4748#undef ARRAYOF_ORIGTYPE
4749#undef ARRAYOF_TYPE
4750#define ARRAYOF_ORIGTYPE REAL
4751#define ARRAYOF_TYPE arrayof_real
4752#include "arrayof_pre.F90"
4753
4754#undef ARRAYOF_ORIGTYPE
4755#undef ARRAYOF_TYPE
4756#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4757#define ARRAYOF_TYPE arrayof_doubleprecision
4758#include "arrayof_pre.F90"
4759
4760#undef ARRAYOF_ORIGEQ
4761
4762#undef ARRAYOF_ORIGTYPE
4763#undef ARRAYOF_TYPE
4764#define ARRAYOF_ORIGTYPE LOGICAL
4765#define ARRAYOF_TYPE arrayof_logical
4766#include "arrayof_pre.F90"
4767
4768PRIVATE
4769! from arrayof
4771PUBLIC insert_unique, append_unique
4772
4773PUBLIC sort, index, index_c, &
4774 count_distinct_sorted, pack_distinct_sorted, &
4775 count_distinct, pack_distinct, count_and_pack_distinct, &
4776 map_distinct, map_inv_distinct, &
4777 firsttrue, lasttrue, pack_distinct_c, map
4778
4779CONTAINS
4780
4781
4784FUNCTION firsttrue(v) RESULT(i)
4785LOGICAL,INTENT(in) :: v(:)
4786INTEGER :: i
4787
4788DO i = 1, SIZE(v)
4789 IF (v(i)) RETURN
4790ENDDO
4791i = 0
4792
4793END FUNCTION firsttrue
4794
4795
4798FUNCTION lasttrue(v) RESULT(i)
4799LOGICAL,INTENT(in) :: v(:)
4800INTEGER :: i
4801
4802DO i = SIZE(v), 1, -1
4803 IF (v(i)) RETURN
4804ENDDO
4805
4806END FUNCTION lasttrue
4807
4808
4809! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4810#undef VOL7D_POLY_TYPE_AUTO
4811#undef VOL7D_NO_PACK
4812
4813#undef VOL7D_POLY_TYPE
4814#undef VOL7D_POLY_TYPES
4815#define VOL7D_POLY_TYPE INTEGER
4816#define VOL7D_POLY_TYPES _i
4817#define ENABLE_SORT
4818#include "array_utilities_inc.F90"
4819#undef ENABLE_SORT
4820
4821#undef VOL7D_POLY_TYPE
4822#undef VOL7D_POLY_TYPES
4823#define VOL7D_POLY_TYPE REAL
4824#define VOL7D_POLY_TYPES _r
4825#define ENABLE_SORT
4826#include "array_utilities_inc.F90"
4827#undef ENABLE_SORT
4828
4829#undef VOL7D_POLY_TYPE
4830#undef VOL7D_POLY_TYPES
4831#define VOL7D_POLY_TYPE DOUBLEPRECISION
4832#define VOL7D_POLY_TYPES _d
4833#define ENABLE_SORT
4834#include "array_utilities_inc.F90"
4835#undef ENABLE_SORT
4836
4837#define VOL7D_NO_PACK
4838#undef VOL7D_POLY_TYPE
4839#undef VOL7D_POLY_TYPES
4840#define VOL7D_POLY_TYPE CHARACTER(len=*)
4841#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4842#define VOL7D_POLY_TYPES _c
4843#define ENABLE_SORT
4844#include "array_utilities_inc.F90"
4845#undef VOL7D_POLY_TYPE_AUTO
4846#undef ENABLE_SORT
4847
4848SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
4849CHARACTER(len=*),INTENT(in) :: vect(:)
4850LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
4851CHARACTER(len=LEN(vect)) :: pack_distinct(:)
4852
4853INTEGER :: count_distinct
4854INTEGER :: i, j, dim
4855LOGICAL :: lback
4856
4857dim = SIZE(pack_distinct)
4858IF (PRESENT(back)) THEN
4859 lback = back
4860ELSE
4861 lback = .false.
4862ENDIF
4863count_distinct = 0
4864
4865IF (PRESENT (mask)) THEN
4866 IF (lback) THEN
4867 vectm1: DO i = 1, SIZE(vect)
4868 IF (.NOT.mask(i)) cycle vectm1
4869! DO j = i-1, 1, -1
4870! IF (vect(j) == vect(i)) CYCLE vectm1
4871 DO j = count_distinct, 1, -1
4872 IF (pack_distinct(j) == vect(i)) cycle vectm1
4873 ENDDO
4874 count_distinct = count_distinct + 1
4875 IF (count_distinct > dim) EXIT
4876 pack_distinct(count_distinct) = vect(i)
4877 ENDDO vectm1
4878 ELSE
4879 vectm2: DO i = 1, SIZE(vect)
4880 IF (.NOT.mask(i)) cycle vectm2
4881! DO j = 1, i-1
4882! IF (vect(j) == vect(i)) CYCLE vectm2
4883 DO j = 1, count_distinct
4884 IF (pack_distinct(j) == vect(i)) cycle vectm2
4885 ENDDO
4886 count_distinct = count_distinct + 1
4887 IF (count_distinct > dim) EXIT
4888 pack_distinct(count_distinct) = vect(i)
4889 ENDDO vectm2
4890 ENDIF
4891ELSE
4892 IF (lback) THEN
4893 vect1: DO i = 1, SIZE(vect)
4894! DO j = i-1, 1, -1
4895! IF (vect(j) == vect(i)) CYCLE vect1
4896 DO j = count_distinct, 1, -1
4897 IF (pack_distinct(j) == vect(i)) cycle vect1
4898 ENDDO
4899 count_distinct = count_distinct + 1
4900 IF (count_distinct > dim) EXIT
4901 pack_distinct(count_distinct) = vect(i)
4902 ENDDO vect1
4903 ELSE
4904 vect2: DO i = 1, SIZE(vect)
4905! DO j = 1, i-1
4906! IF (vect(j) == vect(i)) CYCLE vect2
4907 DO j = 1, count_distinct
4908 IF (pack_distinct(j) == vect(i)) cycle vect2
4909 ENDDO
4910 count_distinct = count_distinct + 1
4911 IF (count_distinct > dim) EXIT
4912 pack_distinct(count_distinct) = vect(i)
4913 ENDDO vect2
4914 ENDIF
4915ENDIF
4916
4917END SUBROUTINE pack_distinct_c
4918
4920FUNCTION map(mask) RESULT(mapidx)
4921LOGICAL,INTENT(in) :: mask(:)
4922INTEGER :: mapidx(count(mask))
4923
4924INTEGER :: i,j
4925
4926j = 0
4927DO i=1, SIZE(mask)
4928 j = j + 1
4929 IF (mask(i)) mapidx(j)=i
4930ENDDO
4931
4932END FUNCTION map
4933
4934#define ARRAYOF_ORIGEQ 1
4935
4936#undef ARRAYOF_ORIGTYPE
4937#undef ARRAYOF_TYPE
4938#define ARRAYOF_ORIGTYPE INTEGER
4939#define ARRAYOF_TYPE arrayof_integer
4940#include "arrayof_post.F90"
4941
4942#undef ARRAYOF_ORIGTYPE
4943#undef ARRAYOF_TYPE
4944#define ARRAYOF_ORIGTYPE REAL
4945#define ARRAYOF_TYPE arrayof_real
4946#include "arrayof_post.F90"
4947
4948#undef ARRAYOF_ORIGTYPE
4949#undef ARRAYOF_TYPE
4950#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4951#define ARRAYOF_TYPE arrayof_doubleprecision
4952#include "arrayof_post.F90"
4953
4954#undef ARRAYOF_ORIGEQ
4955
4956#undef ARRAYOF_ORIGTYPE
4957#undef ARRAYOF_TYPE
4958#define ARRAYOF_ORIGTYPE LOGICAL
4959#define ARRAYOF_TYPE arrayof_logical
4960#include "arrayof_post.F90"
4961
4962END 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.