libsim Versione 7.2.4

◆ 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 )
private

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

Definizione alla linea 3781 del file array_utilities.F90.

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