libsim Versione 7.1.11

◆ index_sorted_d()

recursive integer function index_sorted_d ( doubleprecision, dimension(:), intent(in)  vect,
doubleprecision, intent(in)  search 
)

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

Definizione alla linea 3864 del file array_utilities.F90.

3866! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3867! authors:
3868! Davide Cesari <dcesari@arpa.emr.it>
3869! Paolo Patruno <ppatruno@arpa.emr.it>
3870
3871! This program is free software; you can redistribute it and/or
3872! modify it under the terms of the GNU General Public License as
3873! published by the Free Software Foundation; either version 2 of
3874! the License, or (at your option) any later version.
3875
3876! This program is distributed in the hope that it will be useful,
3877! but WITHOUT ANY WARRANTY; without even the implied warranty of
3878! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3879! GNU General Public License for more details.
3880
3881! You should have received a copy of the GNU General Public License
3882! along with this program. If not, see <http://www.gnu.org/licenses/>.
3883
3884
3885
3888#include "config.h"
3889MODULE array_utilities
3890
3891IMPLICIT NONE
3892
3893! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
3894!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
3895
3896#undef VOL7D_POLY_TYPE_AUTO
3897
3898#undef VOL7D_POLY_TYPE
3899#undef VOL7D_POLY_TYPES
3900#define VOL7D_POLY_TYPE INTEGER
3901#define VOL7D_POLY_TYPES _i
3902#define ENABLE_SORT
3903#include "array_utilities_pre.F90"
3904#undef ENABLE_SORT
3905
3906#undef VOL7D_POLY_TYPE
3907#undef VOL7D_POLY_TYPES
3908#define VOL7D_POLY_TYPE REAL
3909#define VOL7D_POLY_TYPES _r
3910#define ENABLE_SORT
3911#include "array_utilities_pre.F90"
3912#undef ENABLE_SORT
3913
3914#undef VOL7D_POLY_TYPE
3915#undef VOL7D_POLY_TYPES
3916#define VOL7D_POLY_TYPE DOUBLEPRECISION
3917#define VOL7D_POLY_TYPES _d
3918#define ENABLE_SORT
3919#include "array_utilities_pre.F90"
3920#undef ENABLE_SORT
3921
3922#define VOL7D_NO_PACK
3923#undef VOL7D_POLY_TYPE
3924#undef VOL7D_POLY_TYPES
3925#define VOL7D_POLY_TYPE CHARACTER(len=*)
3926#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3927#define VOL7D_POLY_TYPES _c
3928#define ENABLE_SORT
3929#include "array_utilities_pre.F90"
3930#undef VOL7D_POLY_TYPE_AUTO
3931#undef ENABLE_SORT
3932
3933
3934#define ARRAYOF_ORIGEQ 1
3935
3936#define ARRAYOF_ORIGTYPE INTEGER
3937#define ARRAYOF_TYPE arrayof_integer
3938#include "arrayof_pre.F90"
3939
3940#undef ARRAYOF_ORIGTYPE
3941#undef ARRAYOF_TYPE
3942#define ARRAYOF_ORIGTYPE REAL
3943#define ARRAYOF_TYPE arrayof_real
3944#include "arrayof_pre.F90"
3945
3946#undef ARRAYOF_ORIGTYPE
3947#undef ARRAYOF_TYPE
3948#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3949#define ARRAYOF_TYPE arrayof_doubleprecision
3950#include "arrayof_pre.F90"
3951
3952#undef ARRAYOF_ORIGEQ
3953
3954#undef ARRAYOF_ORIGTYPE
3955#undef ARRAYOF_TYPE
3956#define ARRAYOF_ORIGTYPE LOGICAL
3957#define ARRAYOF_TYPE arrayof_logical
3958#include "arrayof_pre.F90"
3959
3960PRIVATE
3961! from arrayof
3963PUBLIC insert_unique, append_unique
3964
3965PUBLIC sort, index, index_c, &
3966 count_distinct_sorted, pack_distinct_sorted, &
3967 count_distinct, pack_distinct, count_and_pack_distinct, &
3968 map_distinct, map_inv_distinct, &
3969 firsttrue, lasttrue, pack_distinct_c, map
3970
3971CONTAINS
3972
3973
3976FUNCTION firsttrue(v) RESULT(i)
3977LOGICAL,INTENT(in) :: v(:)
3978INTEGER :: i
3979
3980DO i = 1, SIZE(v)
3981 IF (v(i)) RETURN
3982ENDDO
3983i = 0
3984
3985END FUNCTION firsttrue
3986
3987
3990FUNCTION lasttrue(v) RESULT(i)
3991LOGICAL,INTENT(in) :: v(:)
3992INTEGER :: i
3993
3994DO i = SIZE(v), 1, -1
3995 IF (v(i)) RETURN
3996ENDDO
3997
3998END FUNCTION lasttrue
3999
4000
4001! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
4002#undef VOL7D_POLY_TYPE_AUTO
4003#undef VOL7D_NO_PACK
4004
4005#undef VOL7D_POLY_TYPE
4006#undef VOL7D_POLY_TYPES
4007#define VOL7D_POLY_TYPE INTEGER
4008#define VOL7D_POLY_TYPES _i
4009#define ENABLE_SORT
4010#include "array_utilities_inc.F90"
4011#undef ENABLE_SORT
4012
4013#undef VOL7D_POLY_TYPE
4014#undef VOL7D_POLY_TYPES
4015#define VOL7D_POLY_TYPE REAL
4016#define VOL7D_POLY_TYPES _r
4017#define ENABLE_SORT
4018#include "array_utilities_inc.F90"
4019#undef ENABLE_SORT
4020
4021#undef VOL7D_POLY_TYPE
4022#undef VOL7D_POLY_TYPES
4023#define VOL7D_POLY_TYPE DOUBLEPRECISION
4024#define VOL7D_POLY_TYPES _d
4025#define ENABLE_SORT
4026#include "array_utilities_inc.F90"
4027#undef ENABLE_SORT
4028
4029#define VOL7D_NO_PACK
4030#undef VOL7D_POLY_TYPE
4031#undef VOL7D_POLY_TYPES
4032#define VOL7D_POLY_TYPE CHARACTER(len=*)
4033#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
4034#define VOL7D_POLY_TYPES _c
4035#define ENABLE_SORT
4036#include "array_utilities_inc.F90"
4037#undef VOL7D_POLY_TYPE_AUTO
4038#undef ENABLE_SORT
4039
4040SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
4041CHARACTER(len=*),INTENT(in) :: vect(:)
4042LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
4043CHARACTER(len=LEN(vect)) :: pack_distinct(:)
4044
4045INTEGER :: count_distinct
4046INTEGER :: i, j, dim
4047LOGICAL :: lback
4048
4049dim = SIZE(pack_distinct)
4050IF (PRESENT(back)) THEN
4051 lback = back
4052ELSE
4053 lback = .false.
4054ENDIF
4055count_distinct = 0
4056
4057IF (PRESENT (mask)) THEN
4058 IF (lback) THEN
4059 vectm1: DO i = 1, SIZE(vect)
4060 IF (.NOT.mask(i)) cycle vectm1
4061! DO j = i-1, 1, -1
4062! IF (vect(j) == vect(i)) CYCLE vectm1
4063 DO j = count_distinct, 1, -1
4064 IF (pack_distinct(j) == vect(i)) cycle vectm1
4065 ENDDO
4066 count_distinct = count_distinct + 1
4067 IF (count_distinct > dim) EXIT
4068 pack_distinct(count_distinct) = vect(i)
4069 ENDDO vectm1
4070 ELSE
4071 vectm2: DO i = 1, SIZE(vect)
4072 IF (.NOT.mask(i)) cycle vectm2
4073! DO j = 1, i-1
4074! IF (vect(j) == vect(i)) CYCLE vectm2
4075 DO j = 1, count_distinct
4076 IF (pack_distinct(j) == vect(i)) cycle vectm2
4077 ENDDO
4078 count_distinct = count_distinct + 1
4079 IF (count_distinct > dim) EXIT
4080 pack_distinct(count_distinct) = vect(i)
4081 ENDDO vectm2
4082 ENDIF
4083ELSE
4084 IF (lback) THEN
4085 vect1: DO i = 1, SIZE(vect)
4086! DO j = i-1, 1, -1
4087! IF (vect(j) == vect(i)) CYCLE vect1
4088 DO j = count_distinct, 1, -1
4089 IF (pack_distinct(j) == vect(i)) cycle vect1
4090 ENDDO
4091 count_distinct = count_distinct + 1
4092 IF (count_distinct > dim) EXIT
4093 pack_distinct(count_distinct) = vect(i)
4094 ENDDO vect1
4095 ELSE
4096 vect2: DO i = 1, SIZE(vect)
4097! DO j = 1, i-1
4098! IF (vect(j) == vect(i)) CYCLE vect2
4099 DO j = 1, count_distinct
4100 IF (pack_distinct(j) == vect(i)) cycle vect2
4101 ENDDO
4102 count_distinct = count_distinct + 1
4103 IF (count_distinct > dim) EXIT
4104 pack_distinct(count_distinct) = vect(i)
4105 ENDDO vect2
4106 ENDIF
4107ENDIF
4108
4109END SUBROUTINE pack_distinct_c
4110
4112FUNCTION map(mask) RESULT(mapidx)
4113LOGICAL,INTENT(in) :: mask(:)
4114INTEGER :: mapidx(count(mask))
4115
4116INTEGER :: i,j
4117
4118j = 0
4119DO i=1, SIZE(mask)
4120 j = j + 1
4121 IF (mask(i)) mapidx(j)=i
4122ENDDO
4123
4124END FUNCTION map
4125
4126#define ARRAYOF_ORIGEQ 1
4127
4128#undef ARRAYOF_ORIGTYPE
4129#undef ARRAYOF_TYPE
4130#define ARRAYOF_ORIGTYPE INTEGER
4131#define ARRAYOF_TYPE arrayof_integer
4132#include "arrayof_post.F90"
4133
4134#undef ARRAYOF_ORIGTYPE
4135#undef ARRAYOF_TYPE
4136#define ARRAYOF_ORIGTYPE REAL
4137#define ARRAYOF_TYPE arrayof_real
4138#include "arrayof_post.F90"
4139
4140#undef ARRAYOF_ORIGTYPE
4141#undef ARRAYOF_TYPE
4142#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4143#define ARRAYOF_TYPE arrayof_doubleprecision
4144#include "arrayof_post.F90"
4145
4146#undef ARRAYOF_ORIGEQ
4147
4148#undef ARRAYOF_ORIGTYPE
4149#undef ARRAYOF_TYPE
4150#define ARRAYOF_ORIGTYPE LOGICAL
4151#define ARRAYOF_TYPE arrayof_logical
4152#include "arrayof_post.F90"
4153
4154END 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.