libsim Versione 7.1.11

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

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