libsim Versione 7.2.1

◆ index_sorted_d()

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

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

Definizione alla linea 3858 del file array_utilities.F90.

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