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