libsim Versione 7.1.11

◆ index_c()

integer function, public index_c ( character(len=*), dimension(:), intent(in)  vect,
character(len=*), intent(in)  search,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back,
integer, intent(in), optional  cache 
)

Cerca l'indice del primo o ultimo elemento di vect uguale a search.

Definizione alla linea 4764 del file array_utilities.F90.

4766! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4767! authors:
4768! Davide Cesari <dcesari@arpa.emr.it>
4769! Paolo Patruno <ppatruno@arpa.emr.it>
4770
4771! This program is free software; you can redistribute it and/or
4772! modify it under the terms of the GNU General Public License as
4773! published by the Free Software Foundation; either version 2 of
4774! the License, or (at your option) any later version.
4775
4776! This program is distributed in the hope that it will be useful,
4777! but WITHOUT ANY WARRANTY; without even the implied warranty of
4778! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4779! GNU General Public License for more details.
4780
4781! You should have received a copy of the GNU General Public License
4782! along with this program. If not, see <http://www.gnu.org/licenses/>.
4783
4784
4785
4788#include "config.h"
4789MODULE array_utilities
4790
4791IMPLICIT NONE
4792
4793! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4794!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4795
4796#undef VOL7D_POLY_TYPE_AUTO
4797
4798#undef VOL7D_POLY_TYPE
4799#undef VOL7D_POLY_TYPES
4800#define VOL7D_POLY_TYPE INTEGER
4801#define VOL7D_POLY_TYPES _i
4802#define ENABLE_SORT
4803#include "array_utilities_pre.F90"
4804#undef ENABLE_SORT
4805
4806#undef VOL7D_POLY_TYPE
4807#undef VOL7D_POLY_TYPES
4808#define VOL7D_POLY_TYPE REAL
4809#define VOL7D_POLY_TYPES _r
4810#define ENABLE_SORT
4811#include "array_utilities_pre.F90"
4812#undef ENABLE_SORT
4813
4814#undef VOL7D_POLY_TYPE
4815#undef VOL7D_POLY_TYPES
4816#define VOL7D_POLY_TYPE DOUBLEPRECISION
4817#define VOL7D_POLY_TYPES _d
4818#define ENABLE_SORT
4819#include "array_utilities_pre.F90"
4820#undef ENABLE_SORT
4821
4822#define VOL7D_NO_PACK
4823#undef VOL7D_POLY_TYPE
4824#undef VOL7D_POLY_TYPES
4825#define VOL7D_POLY_TYPE CHARACTER(len=*)
4826#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4827#define VOL7D_POLY_TYPES _c
4828#define ENABLE_SORT
4829#include "array_utilities_pre.F90"
4830#undef VOL7D_POLY_TYPE_AUTO
4831#undef ENABLE_SORT
4832
4833
4834#define ARRAYOF_ORIGEQ 1
4835
4836#define ARRAYOF_ORIGTYPE INTEGER
4837#define ARRAYOF_TYPE arrayof_integer
4838#include "arrayof_pre.F90"
4839
4840#undef ARRAYOF_ORIGTYPE
4841#undef ARRAYOF_TYPE
4842#define ARRAYOF_ORIGTYPE REAL
4843#define ARRAYOF_TYPE arrayof_real
4844#include "arrayof_pre.F90"
4845
4846#undef ARRAYOF_ORIGTYPE
4847#undef ARRAYOF_TYPE
4848#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4849#define ARRAYOF_TYPE arrayof_doubleprecision
4850#include "arrayof_pre.F90"
4851
4852#undef ARRAYOF_ORIGEQ
4853
4854#undef ARRAYOF_ORIGTYPE
4855#undef ARRAYOF_TYPE
4856#define ARRAYOF_ORIGTYPE LOGICAL
4857#define ARRAYOF_TYPE arrayof_logical
4858#include "arrayof_pre.F90"
4859
4860PRIVATE
4861! from arrayof
4863PUBLIC insert_unique, append_unique
4864
4865PUBLIC sort, index, index_c, &
4866 count_distinct_sorted, pack_distinct_sorted, &
4867 count_distinct, pack_distinct, count_and_pack_distinct, &
4868 map_distinct, map_inv_distinct, &
4869 firsttrue, lasttrue, pack_distinct_c, map
4870
4871CONTAINS
4872
4873
4876FUNCTION firsttrue(v) RESULT(i)
4877LOGICAL,INTENT(in) :: v(:)
4878INTEGER :: i
4879
4880DO i = 1, SIZE(v)
4881 IF (v(i)) RETURN
4882ENDDO
4883i = 0
4884
4885END FUNCTION firsttrue
4886
4887
4890FUNCTION lasttrue(v) RESULT(i)
4891LOGICAL,INTENT(in) :: v(:)
4892INTEGER :: i
4893
4894DO i = SIZE(v), 1, -1
4895 IF (v(i)) RETURN
4896ENDDO
4897
4898END FUNCTION lasttrue
4899
4900
4901! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4902#undef VOL7D_POLY_TYPE_AUTO
4903#undef VOL7D_NO_PACK
4904
4905#undef VOL7D_POLY_TYPE
4906#undef VOL7D_POLY_TYPES
4907#define VOL7D_POLY_TYPE INTEGER
4908#define VOL7D_POLY_TYPES _i
4909#define ENABLE_SORT
4910#include "array_utilities_inc.F90"
4911#undef ENABLE_SORT
4912
4913#undef VOL7D_POLY_TYPE
4914#undef VOL7D_POLY_TYPES
4915#define VOL7D_POLY_TYPE REAL
4916#define VOL7D_POLY_TYPES _r
4917#define ENABLE_SORT
4918#include "array_utilities_inc.F90"
4919#undef ENABLE_SORT
4920
4921#undef VOL7D_POLY_TYPE
4922#undef VOL7D_POLY_TYPES
4923#define VOL7D_POLY_TYPE DOUBLEPRECISION
4924#define VOL7D_POLY_TYPES _d
4925#define ENABLE_SORT
4926#include "array_utilities_inc.F90"
4927#undef ENABLE_SORT
4928
4929#define VOL7D_NO_PACK
4930#undef VOL7D_POLY_TYPE
4931#undef VOL7D_POLY_TYPES
4932#define VOL7D_POLY_TYPE CHARACTER(len=*)
4933#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4934#define VOL7D_POLY_TYPES _c
4935#define ENABLE_SORT
4936#include "array_utilities_inc.F90"
4937#undef VOL7D_POLY_TYPE_AUTO
4938#undef ENABLE_SORT
4939
4940SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
4941CHARACTER(len=*),INTENT(in) :: vect(:)
4942LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
4943CHARACTER(len=LEN(vect)) :: pack_distinct(:)
4944
4945INTEGER :: count_distinct
4946INTEGER :: i, j, dim
4947LOGICAL :: lback
4948
4949dim = SIZE(pack_distinct)
4950IF (PRESENT(back)) THEN
4951 lback = back
4952ELSE
4953 lback = .false.
4954ENDIF
4955count_distinct = 0
4956
4957IF (PRESENT (mask)) THEN
4958 IF (lback) THEN
4959 vectm1: DO i = 1, SIZE(vect)
4960 IF (.NOT.mask(i)) cycle vectm1
4961! DO j = i-1, 1, -1
4962! IF (vect(j) == vect(i)) CYCLE vectm1
4963 DO j = count_distinct, 1, -1
4964 IF (pack_distinct(j) == vect(i)) cycle vectm1
4965 ENDDO
4966 count_distinct = count_distinct + 1
4967 IF (count_distinct > dim) EXIT
4968 pack_distinct(count_distinct) = vect(i)
4969 ENDDO vectm1
4970 ELSE
4971 vectm2: DO i = 1, SIZE(vect)
4972 IF (.NOT.mask(i)) cycle vectm2
4973! DO j = 1, i-1
4974! IF (vect(j) == vect(i)) CYCLE vectm2
4975 DO j = 1, count_distinct
4976 IF (pack_distinct(j) == vect(i)) cycle vectm2
4977 ENDDO
4978 count_distinct = count_distinct + 1
4979 IF (count_distinct > dim) EXIT
4980 pack_distinct(count_distinct) = vect(i)
4981 ENDDO vectm2
4982 ENDIF
4983ELSE
4984 IF (lback) THEN
4985 vect1: DO i = 1, SIZE(vect)
4986! DO j = i-1, 1, -1
4987! IF (vect(j) == vect(i)) CYCLE vect1
4988 DO j = count_distinct, 1, -1
4989 IF (pack_distinct(j) == vect(i)) cycle vect1
4990 ENDDO
4991 count_distinct = count_distinct + 1
4992 IF (count_distinct > dim) EXIT
4993 pack_distinct(count_distinct) = vect(i)
4994 ENDDO vect1
4995 ELSE
4996 vect2: DO i = 1, SIZE(vect)
4997! DO j = 1, i-1
4998! IF (vect(j) == vect(i)) CYCLE vect2
4999 DO j = 1, count_distinct
5000 IF (pack_distinct(j) == vect(i)) cycle vect2
5001 ENDDO
5002 count_distinct = count_distinct + 1
5003 IF (count_distinct > dim) EXIT
5004 pack_distinct(count_distinct) = vect(i)
5005 ENDDO vect2
5006 ENDIF
5007ENDIF
5008
5009END SUBROUTINE pack_distinct_c
5010
5012FUNCTION map(mask) RESULT(mapidx)
5013LOGICAL,INTENT(in) :: mask(:)
5014INTEGER :: mapidx(count(mask))
5015
5016INTEGER :: i,j
5017
5018j = 0
5019DO i=1, SIZE(mask)
5020 j = j + 1
5021 IF (mask(i)) mapidx(j)=i
5022ENDDO
5023
5024END FUNCTION map
5025
5026#define ARRAYOF_ORIGEQ 1
5027
5028#undef ARRAYOF_ORIGTYPE
5029#undef ARRAYOF_TYPE
5030#define ARRAYOF_ORIGTYPE INTEGER
5031#define ARRAYOF_TYPE arrayof_integer
5032#include "arrayof_post.F90"
5033
5034#undef ARRAYOF_ORIGTYPE
5035#undef ARRAYOF_TYPE
5036#define ARRAYOF_ORIGTYPE REAL
5037#define ARRAYOF_TYPE arrayof_real
5038#include "arrayof_post.F90"
5039
5040#undef ARRAYOF_ORIGTYPE
5041#undef ARRAYOF_TYPE
5042#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5043#define ARRAYOF_TYPE arrayof_doubleprecision
5044#include "arrayof_post.F90"
5045
5046#undef ARRAYOF_ORIGEQ
5047
5048#undef ARRAYOF_ORIGTYPE
5049#undef ARRAYOF_TYPE
5050#define ARRAYOF_ORIGTYPE LOGICAL
5051#define ARRAYOF_TYPE arrayof_logical
5052#include "arrayof_post.F90"
5053
5054END 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.