libsim Versione 7.1.11

◆ index_d()

integer function index_d ( doubleprecision, dimension(:), intent(in)  vect,
doubleprecision, intent(in)  search,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back,
integer, intent(in), optional  cache 
)

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

Definizione alla linea 3787 del file array_utilities.F90.

3789! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3790! authors:
3791! Davide Cesari <dcesari@arpa.emr.it>
3792! Paolo Patruno <ppatruno@arpa.emr.it>
3793
3794! This program is free software; you can redistribute it and/or
3795! modify it under the terms of the GNU General Public License as
3796! published by the Free Software Foundation; either version 2 of
3797! the License, or (at your option) any later version.
3798
3799! This program is distributed in the hope that it will be useful,
3800! but WITHOUT ANY WARRANTY; without even the implied warranty of
3801! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3802! GNU General Public License for more details.
3803
3804! You should have received a copy of the GNU General Public License
3805! along with this program. If not, see <http://www.gnu.org/licenses/>.
3806
3807
3808
3811#include "config.h"
3812MODULE array_utilities
3813
3814IMPLICIT NONE
3815
3816! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
3817!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
3818
3819#undef VOL7D_POLY_TYPE_AUTO
3820
3821#undef VOL7D_POLY_TYPE
3822#undef VOL7D_POLY_TYPES
3823#define VOL7D_POLY_TYPE INTEGER
3824#define VOL7D_POLY_TYPES _i
3825#define ENABLE_SORT
3826#include "array_utilities_pre.F90"
3827#undef ENABLE_SORT
3828
3829#undef VOL7D_POLY_TYPE
3830#undef VOL7D_POLY_TYPES
3831#define VOL7D_POLY_TYPE REAL
3832#define VOL7D_POLY_TYPES _r
3833#define ENABLE_SORT
3834#include "array_utilities_pre.F90"
3835#undef ENABLE_SORT
3836
3837#undef VOL7D_POLY_TYPE
3838#undef VOL7D_POLY_TYPES
3839#define VOL7D_POLY_TYPE DOUBLEPRECISION
3840#define VOL7D_POLY_TYPES _d
3841#define ENABLE_SORT
3842#include "array_utilities_pre.F90"
3843#undef ENABLE_SORT
3844
3845#define VOL7D_NO_PACK
3846#undef VOL7D_POLY_TYPE
3847#undef VOL7D_POLY_TYPES
3848#define VOL7D_POLY_TYPE CHARACTER(len=*)
3849#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3850#define VOL7D_POLY_TYPES _c
3851#define ENABLE_SORT
3852#include "array_utilities_pre.F90"
3853#undef VOL7D_POLY_TYPE_AUTO
3854#undef ENABLE_SORT
3855
3856
3857#define ARRAYOF_ORIGEQ 1
3858
3859#define ARRAYOF_ORIGTYPE INTEGER
3860#define ARRAYOF_TYPE arrayof_integer
3861#include "arrayof_pre.F90"
3862
3863#undef ARRAYOF_ORIGTYPE
3864#undef ARRAYOF_TYPE
3865#define ARRAYOF_ORIGTYPE REAL
3866#define ARRAYOF_TYPE arrayof_real
3867#include "arrayof_pre.F90"
3868
3869#undef ARRAYOF_ORIGTYPE
3870#undef ARRAYOF_TYPE
3871#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3872#define ARRAYOF_TYPE arrayof_doubleprecision
3873#include "arrayof_pre.F90"
3874
3875#undef ARRAYOF_ORIGEQ
3876
3877#undef ARRAYOF_ORIGTYPE
3878#undef ARRAYOF_TYPE
3879#define ARRAYOF_ORIGTYPE LOGICAL
3880#define ARRAYOF_TYPE arrayof_logical
3881#include "arrayof_pre.F90"
3882
3883PRIVATE
3884! from arrayof
3886PUBLIC insert_unique, append_unique
3887
3888PUBLIC sort, index, index_c, &
3889 count_distinct_sorted, pack_distinct_sorted, &
3890 count_distinct, pack_distinct, count_and_pack_distinct, &
3891 map_distinct, map_inv_distinct, &
3892 firsttrue, lasttrue, pack_distinct_c, map
3893
3894CONTAINS
3895
3896
3899FUNCTION firsttrue(v) RESULT(i)
3900LOGICAL,INTENT(in) :: v(:)
3901INTEGER :: i
3902
3903DO i = 1, SIZE(v)
3904 IF (v(i)) RETURN
3905ENDDO
3906i = 0
3907
3908END FUNCTION firsttrue
3909
3910
3913FUNCTION lasttrue(v) RESULT(i)
3914LOGICAL,INTENT(in) :: v(:)
3915INTEGER :: i
3916
3917DO i = SIZE(v), 1, -1
3918 IF (v(i)) RETURN
3919ENDDO
3920
3921END FUNCTION lasttrue
3922
3923
3924! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
3925#undef VOL7D_POLY_TYPE_AUTO
3926#undef VOL7D_NO_PACK
3927
3928#undef VOL7D_POLY_TYPE
3929#undef VOL7D_POLY_TYPES
3930#define VOL7D_POLY_TYPE INTEGER
3931#define VOL7D_POLY_TYPES _i
3932#define ENABLE_SORT
3933#include "array_utilities_inc.F90"
3934#undef ENABLE_SORT
3935
3936#undef VOL7D_POLY_TYPE
3937#undef VOL7D_POLY_TYPES
3938#define VOL7D_POLY_TYPE REAL
3939#define VOL7D_POLY_TYPES _r
3940#define ENABLE_SORT
3941#include "array_utilities_inc.F90"
3942#undef ENABLE_SORT
3943
3944#undef VOL7D_POLY_TYPE
3945#undef VOL7D_POLY_TYPES
3946#define VOL7D_POLY_TYPE DOUBLEPRECISION
3947#define VOL7D_POLY_TYPES _d
3948#define ENABLE_SORT
3949#include "array_utilities_inc.F90"
3950#undef ENABLE_SORT
3951
3952#define VOL7D_NO_PACK
3953#undef VOL7D_POLY_TYPE
3954#undef VOL7D_POLY_TYPES
3955#define VOL7D_POLY_TYPE CHARACTER(len=*)
3956#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3957#define VOL7D_POLY_TYPES _c
3958#define ENABLE_SORT
3959#include "array_utilities_inc.F90"
3960#undef VOL7D_POLY_TYPE_AUTO
3961#undef ENABLE_SORT
3962
3963SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
3964CHARACTER(len=*),INTENT(in) :: vect(:)
3965LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
3966CHARACTER(len=LEN(vect)) :: pack_distinct(:)
3967
3968INTEGER :: count_distinct
3969INTEGER :: i, j, dim
3970LOGICAL :: lback
3971
3972dim = SIZE(pack_distinct)
3973IF (PRESENT(back)) THEN
3974 lback = back
3975ELSE
3976 lback = .false.
3977ENDIF
3978count_distinct = 0
3979
3980IF (PRESENT (mask)) THEN
3981 IF (lback) THEN
3982 vectm1: DO i = 1, SIZE(vect)
3983 IF (.NOT.mask(i)) cycle vectm1
3984! DO j = i-1, 1, -1
3985! IF (vect(j) == vect(i)) CYCLE vectm1
3986 DO j = count_distinct, 1, -1
3987 IF (pack_distinct(j) == vect(i)) cycle vectm1
3988 ENDDO
3989 count_distinct = count_distinct + 1
3990 IF (count_distinct > dim) EXIT
3991 pack_distinct(count_distinct) = vect(i)
3992 ENDDO vectm1
3993 ELSE
3994 vectm2: DO i = 1, SIZE(vect)
3995 IF (.NOT.mask(i)) cycle vectm2
3996! DO j = 1, i-1
3997! IF (vect(j) == vect(i)) CYCLE vectm2
3998 DO j = 1, count_distinct
3999 IF (pack_distinct(j) == vect(i)) cycle vectm2
4000 ENDDO
4001 count_distinct = count_distinct + 1
4002 IF (count_distinct > dim) EXIT
4003 pack_distinct(count_distinct) = vect(i)
4004 ENDDO vectm2
4005 ENDIF
4006ELSE
4007 IF (lback) THEN
4008 vect1: DO i = 1, SIZE(vect)
4009! DO j = i-1, 1, -1
4010! IF (vect(j) == vect(i)) CYCLE vect1
4011 DO j = count_distinct, 1, -1
4012 IF (pack_distinct(j) == vect(i)) cycle vect1
4013 ENDDO
4014 count_distinct = count_distinct + 1
4015 IF (count_distinct > dim) EXIT
4016 pack_distinct(count_distinct) = vect(i)
4017 ENDDO vect1
4018 ELSE
4019 vect2: DO i = 1, SIZE(vect)
4020! DO j = 1, i-1
4021! IF (vect(j) == vect(i)) CYCLE vect2
4022 DO j = 1, count_distinct
4023 IF (pack_distinct(j) == vect(i)) cycle vect2
4024 ENDDO
4025 count_distinct = count_distinct + 1
4026 IF (count_distinct > dim) EXIT
4027 pack_distinct(count_distinct) = vect(i)
4028 ENDDO vect2
4029 ENDIF
4030ENDIF
4031
4032END SUBROUTINE pack_distinct_c
4033
4035FUNCTION map(mask) RESULT(mapidx)
4036LOGICAL,INTENT(in) :: mask(:)
4037INTEGER :: mapidx(count(mask))
4038
4039INTEGER :: i,j
4040
4041j = 0
4042DO i=1, SIZE(mask)
4043 j = j + 1
4044 IF (mask(i)) mapidx(j)=i
4045ENDDO
4046
4047END FUNCTION map
4048
4049#define ARRAYOF_ORIGEQ 1
4050
4051#undef ARRAYOF_ORIGTYPE
4052#undef ARRAYOF_TYPE
4053#define ARRAYOF_ORIGTYPE INTEGER
4054#define ARRAYOF_TYPE arrayof_integer
4055#include "arrayof_post.F90"
4056
4057#undef ARRAYOF_ORIGTYPE
4058#undef ARRAYOF_TYPE
4059#define ARRAYOF_ORIGTYPE REAL
4060#define ARRAYOF_TYPE arrayof_real
4061#include "arrayof_post.F90"
4062
4063#undef ARRAYOF_ORIGTYPE
4064#undef ARRAYOF_TYPE
4065#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
4066#define ARRAYOF_TYPE arrayof_doubleprecision
4067#include "arrayof_post.F90"
4068
4069#undef ARRAYOF_ORIGEQ
4070
4071#undef ARRAYOF_ORIGTYPE
4072#undef ARRAYOF_TYPE
4073#define ARRAYOF_ORIGTYPE LOGICAL
4074#define ARRAYOF_TYPE arrayof_logical
4075#include "arrayof_post.F90"
4076
4077END 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.