libsim Versione 7.1.11

◆ index_sorted_c()

recursive integer function index_sorted_c ( character(len=*), dimension(:), intent(in)  vect,
character(len=*), intent(in)  search 
)

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

Definizione alla linea 4841 del file array_utilities.F90.

4843! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4844! authors:
4845! Davide Cesari <dcesari@arpa.emr.it>
4846! Paolo Patruno <ppatruno@arpa.emr.it>
4847
4848! This program is free software; you can redistribute it and/or
4849! modify it under the terms of the GNU General Public License as
4850! published by the Free Software Foundation; either version 2 of
4851! the License, or (at your option) any later version.
4852
4853! This program is distributed in the hope that it will be useful,
4854! but WITHOUT ANY WARRANTY; without even the implied warranty of
4855! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4856! GNU General Public License for more details.
4857
4858! You should have received a copy of the GNU General Public License
4859! along with this program. If not, see <http://www.gnu.org/licenses/>.
4860
4861
4862
4865#include "config.h"
4866MODULE array_utilities
4867
4868IMPLICIT NONE
4869
4870! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4871!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4872
4873#undef VOL7D_POLY_TYPE_AUTO
4874
4875#undef VOL7D_POLY_TYPE
4876#undef VOL7D_POLY_TYPES
4877#define VOL7D_POLY_TYPE INTEGER
4878#define VOL7D_POLY_TYPES _i
4879#define ENABLE_SORT
4880#include "array_utilities_pre.F90"
4881#undef ENABLE_SORT
4882
4883#undef VOL7D_POLY_TYPE
4884#undef VOL7D_POLY_TYPES
4885#define VOL7D_POLY_TYPE REAL
4886#define VOL7D_POLY_TYPES _r
4887#define ENABLE_SORT
4888#include "array_utilities_pre.F90"
4889#undef ENABLE_SORT
4890
4891#undef VOL7D_POLY_TYPE
4892#undef VOL7D_POLY_TYPES
4893#define VOL7D_POLY_TYPE DOUBLEPRECISION
4894#define VOL7D_POLY_TYPES _d
4895#define ENABLE_SORT
4896#include "array_utilities_pre.F90"
4897#undef ENABLE_SORT
4898
4899#define VOL7D_NO_PACK
4900#undef VOL7D_POLY_TYPE
4901#undef VOL7D_POLY_TYPES
4902#define VOL7D_POLY_TYPE CHARACTER(len=*)
4903#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4904#define VOL7D_POLY_TYPES _c
4905#define ENABLE_SORT
4906#include "array_utilities_pre.F90"
4907#undef VOL7D_POLY_TYPE_AUTO
4908#undef ENABLE_SORT
4909
4910
4911#define ARRAYOF_ORIGEQ 1
4912
4913#define ARRAYOF_ORIGTYPE INTEGER
4914#define ARRAYOF_TYPE arrayof_integer
4915#include "arrayof_pre.F90"
4916
4917#undef ARRAYOF_ORIGTYPE
4918#undef ARRAYOF_TYPE
4919#define ARRAYOF_ORIGTYPE REAL
4920#define ARRAYOF_TYPE arrayof_real
4921#include "arrayof_pre.F90"
4922
4923#undef ARRAYOF_ORIGTYPE
4924#undef ARRAYOF_TYPE
4925#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4926#define ARRAYOF_TYPE arrayof_doubleprecision
4927#include "arrayof_pre.F90"
4928
4929#undef ARRAYOF_ORIGEQ
4930
4931#undef ARRAYOF_ORIGTYPE
4932#undef ARRAYOF_TYPE
4933#define ARRAYOF_ORIGTYPE LOGICAL
4934#define ARRAYOF_TYPE arrayof_logical
4935#include "arrayof_pre.F90"
4936
4937PRIVATE
4938! from arrayof
4940PUBLIC insert_unique, append_unique
4941
4942PUBLIC sort, index, index_c, &
4943 count_distinct_sorted, pack_distinct_sorted, &
4944 count_distinct, pack_distinct, count_and_pack_distinct, &
4945 map_distinct, map_inv_distinct, &
4946 firsttrue, lasttrue, pack_distinct_c, map
4947
4948CONTAINS
4949
4950
4953FUNCTION firsttrue(v) RESULT(i)
4954LOGICAL,INTENT(in) :: v(:)
4955INTEGER :: i
4956
4957DO i = 1, SIZE(v)
4958 IF (v(i)) RETURN
4959ENDDO
4960i = 0
4961
4962END FUNCTION firsttrue
4963
4964
4967FUNCTION lasttrue(v) RESULT(i)
4968LOGICAL,INTENT(in) :: v(:)
4969INTEGER :: i
4970
4971DO i = SIZE(v), 1, -1
4972 IF (v(i)) RETURN
4973ENDDO
4974
4975END FUNCTION lasttrue
4976
4977
4978! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4979#undef VOL7D_POLY_TYPE_AUTO
4980#undef VOL7D_NO_PACK
4981
4982#undef VOL7D_POLY_TYPE
4983#undef VOL7D_POLY_TYPES
4984#define VOL7D_POLY_TYPE INTEGER
4985#define VOL7D_POLY_TYPES _i
4986#define ENABLE_SORT
4987#include "array_utilities_inc.F90"
4988#undef ENABLE_SORT
4989
4990#undef VOL7D_POLY_TYPE
4991#undef VOL7D_POLY_TYPES
4992#define VOL7D_POLY_TYPE REAL
4993#define VOL7D_POLY_TYPES _r
4994#define ENABLE_SORT
4995#include "array_utilities_inc.F90"
4996#undef ENABLE_SORT
4997
4998#undef VOL7D_POLY_TYPE
4999#undef VOL7D_POLY_TYPES
5000#define VOL7D_POLY_TYPE DOUBLEPRECISION
5001#define VOL7D_POLY_TYPES _d
5002#define ENABLE_SORT
5003#include "array_utilities_inc.F90"
5004#undef ENABLE_SORT
5005
5006#define VOL7D_NO_PACK
5007#undef VOL7D_POLY_TYPE
5008#undef VOL7D_POLY_TYPES
5009#define VOL7D_POLY_TYPE CHARACTER(len=*)
5010#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5011#define VOL7D_POLY_TYPES _c
5012#define ENABLE_SORT
5013#include "array_utilities_inc.F90"
5014#undef VOL7D_POLY_TYPE_AUTO
5015#undef ENABLE_SORT
5016
5017SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5018CHARACTER(len=*),INTENT(in) :: vect(:)
5019LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5020CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5021
5022INTEGER :: count_distinct
5023INTEGER :: i, j, dim
5024LOGICAL :: lback
5025
5026dim = SIZE(pack_distinct)
5027IF (PRESENT(back)) THEN
5028 lback = back
5029ELSE
5030 lback = .false.
5031ENDIF
5032count_distinct = 0
5033
5034IF (PRESENT (mask)) THEN
5035 IF (lback) THEN
5036 vectm1: DO i = 1, SIZE(vect)
5037 IF (.NOT.mask(i)) cycle vectm1
5038! DO j = i-1, 1, -1
5039! IF (vect(j) == vect(i)) CYCLE vectm1
5040 DO j = count_distinct, 1, -1
5041 IF (pack_distinct(j) == vect(i)) cycle vectm1
5042 ENDDO
5043 count_distinct = count_distinct + 1
5044 IF (count_distinct > dim) EXIT
5045 pack_distinct(count_distinct) = vect(i)
5046 ENDDO vectm1
5047 ELSE
5048 vectm2: DO i = 1, SIZE(vect)
5049 IF (.NOT.mask(i)) cycle vectm2
5050! DO j = 1, i-1
5051! IF (vect(j) == vect(i)) CYCLE vectm2
5052 DO j = 1, count_distinct
5053 IF (pack_distinct(j) == vect(i)) cycle vectm2
5054 ENDDO
5055 count_distinct = count_distinct + 1
5056 IF (count_distinct > dim) EXIT
5057 pack_distinct(count_distinct) = vect(i)
5058 ENDDO vectm2
5059 ENDIF
5060ELSE
5061 IF (lback) THEN
5062 vect1: DO i = 1, SIZE(vect)
5063! DO j = i-1, 1, -1
5064! IF (vect(j) == vect(i)) CYCLE vect1
5065 DO j = count_distinct, 1, -1
5066 IF (pack_distinct(j) == vect(i)) cycle vect1
5067 ENDDO
5068 count_distinct = count_distinct + 1
5069 IF (count_distinct > dim) EXIT
5070 pack_distinct(count_distinct) = vect(i)
5071 ENDDO vect1
5072 ELSE
5073 vect2: DO i = 1, SIZE(vect)
5074! DO j = 1, i-1
5075! IF (vect(j) == vect(i)) CYCLE vect2
5076 DO j = 1, count_distinct
5077 IF (pack_distinct(j) == vect(i)) cycle vect2
5078 ENDDO
5079 count_distinct = count_distinct + 1
5080 IF (count_distinct > dim) EXIT
5081 pack_distinct(count_distinct) = vect(i)
5082 ENDDO vect2
5083 ENDIF
5084ENDIF
5085
5086END SUBROUTINE pack_distinct_c
5087
5089FUNCTION map(mask) RESULT(mapidx)
5090LOGICAL,INTENT(in) :: mask(:)
5091INTEGER :: mapidx(count(mask))
5092
5093INTEGER :: i,j
5094
5095j = 0
5096DO i=1, SIZE(mask)
5097 j = j + 1
5098 IF (mask(i)) mapidx(j)=i
5099ENDDO
5100
5101END FUNCTION map
5102
5103#define ARRAYOF_ORIGEQ 1
5104
5105#undef ARRAYOF_ORIGTYPE
5106#undef ARRAYOF_TYPE
5107#define ARRAYOF_ORIGTYPE INTEGER
5108#define ARRAYOF_TYPE arrayof_integer
5109#include "arrayof_post.F90"
5110
5111#undef ARRAYOF_ORIGTYPE
5112#undef ARRAYOF_TYPE
5113#define ARRAYOF_ORIGTYPE REAL
5114#define ARRAYOF_TYPE arrayof_real
5115#include "arrayof_post.F90"
5116
5117#undef ARRAYOF_ORIGTYPE
5118#undef ARRAYOF_TYPE
5119#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5120#define ARRAYOF_TYPE arrayof_doubleprecision
5121#include "arrayof_post.F90"
5122
5123#undef ARRAYOF_ORIGEQ
5124
5125#undef ARRAYOF_ORIGTYPE
5126#undef ARRAYOF_TYPE
5127#define ARRAYOF_ORIGTYPE LOGICAL
5128#define ARRAYOF_TYPE arrayof_logical
5129#include "arrayof_post.F90"
5130
5131END 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.