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