libsim Versione 7.2.1

◆ map_inv_distinct_d()

integer function, dimension(dim) map_inv_distinct_d ( doubleprecision, dimension(:), intent(in) vect,
integer, intent(in) dim,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back )
private

map inv distinct

Definizione alla linea 3695 del file array_utilities.F90.

3697! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3698! authors:
3699! Davide Cesari <dcesari@arpa.emr.it>
3700! Paolo Patruno <ppatruno@arpa.emr.it>
3701
3702! This program is free software; you can redistribute it and/or
3703! modify it under the terms of the GNU General Public License as
3704! published by the Free Software Foundation; either version 2 of
3705! the License, or (at your option) any later version.
3706
3707! This program is distributed in the hope that it will be useful,
3708! but WITHOUT ANY WARRANTY; without even the implied warranty of
3709! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3710! GNU General Public License for more details.
3711
3712! You should have received a copy of the GNU General Public License
3713! along with this program. If not, see <http://www.gnu.org/licenses/>.
3714
3715
3716
3719#include "config.h"
3720MODULE array_utilities
3721
3722IMPLICIT NONE
3723
3724! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
3725!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
3726
3727#undef VOL7D_POLY_TYPE_AUTO
3728
3729#undef VOL7D_POLY_TYPE
3730#undef VOL7D_POLY_TYPES
3731#define VOL7D_POLY_TYPE INTEGER
3732#define VOL7D_POLY_TYPES _i
3733#define ENABLE_SORT
3734#include "array_utilities_pre.F90"
3735#undef ENABLE_SORT
3736
3737#undef VOL7D_POLY_TYPE
3738#undef VOL7D_POLY_TYPES
3739#define VOL7D_POLY_TYPE REAL
3740#define VOL7D_POLY_TYPES _r
3741#define ENABLE_SORT
3742#include "array_utilities_pre.F90"
3743#undef ENABLE_SORT
3744
3745#undef VOL7D_POLY_TYPE
3746#undef VOL7D_POLY_TYPES
3747#define VOL7D_POLY_TYPE DOUBLEPRECISION
3748#define VOL7D_POLY_TYPES _d
3749#define ENABLE_SORT
3750#include "array_utilities_pre.F90"
3751#undef ENABLE_SORT
3752
3753#define VOL7D_NO_PACK
3754#undef VOL7D_POLY_TYPE
3755#undef VOL7D_POLY_TYPES
3756#define VOL7D_POLY_TYPE CHARACTER(len=*)
3757#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3758#define VOL7D_POLY_TYPES _c
3759#define ENABLE_SORT
3760#include "array_utilities_pre.F90"
3761#undef VOL7D_POLY_TYPE_AUTO
3762#undef ENABLE_SORT
3763
3764
3765#define ARRAYOF_ORIGEQ 1
3766
3767#define ARRAYOF_ORIGTYPE INTEGER
3768#define ARRAYOF_TYPE arrayof_integer
3769#include "arrayof_pre.F90"
3770
3771#undef ARRAYOF_ORIGTYPE
3772#undef ARRAYOF_TYPE
3773#define ARRAYOF_ORIGTYPE REAL
3774#define ARRAYOF_TYPE arrayof_real
3775#include "arrayof_pre.F90"
3776
3777#undef ARRAYOF_ORIGTYPE
3778#undef ARRAYOF_TYPE
3779#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3780#define ARRAYOF_TYPE arrayof_doubleprecision
3781#include "arrayof_pre.F90"
3782
3783#undef ARRAYOF_ORIGEQ
3784
3785#undef ARRAYOF_ORIGTYPE
3786#undef ARRAYOF_TYPE
3787#define ARRAYOF_ORIGTYPE LOGICAL
3788#define ARRAYOF_TYPE arrayof_logical
3789#include "arrayof_pre.F90"
3790
3791PRIVATE
3792! from arrayof
3794PUBLIC insert_unique, append_unique
3795
3796PUBLIC sort, index, index_c, &
3797 count_distinct_sorted, pack_distinct_sorted, &
3798 count_distinct, pack_distinct, count_and_pack_distinct, &
3799 map_distinct, map_inv_distinct, &
3800 firsttrue, lasttrue, pack_distinct_c, map
3801
3802CONTAINS
3803
3804
3807FUNCTION firsttrue(v) RESULT(i)
3808LOGICAL,INTENT(in) :: v(:)
3809INTEGER :: i
3810
3811DO i = 1, SIZE(v)
3812 IF (v(i)) RETURN
3813ENDDO
3814i = 0
3815
3816END FUNCTION firsttrue
3817
3818
3821FUNCTION lasttrue(v) RESULT(i)
3822LOGICAL,INTENT(in) :: v(:)
3823INTEGER :: i
3824
3825DO i = SIZE(v), 1, -1
3826 IF (v(i)) RETURN
3827ENDDO
3828
3829END FUNCTION lasttrue
3830
3831
3832! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
3833#undef VOL7D_POLY_TYPE_AUTO
3834#undef VOL7D_NO_PACK
3835
3836#undef VOL7D_POLY_TYPE
3837#undef VOL7D_POLY_TYPES
3838#define VOL7D_POLY_TYPE INTEGER
3839#define VOL7D_POLY_TYPES _i
3840#define ENABLE_SORT
3841#include "array_utilities_inc.F90"
3842#undef ENABLE_SORT
3843
3844#undef VOL7D_POLY_TYPE
3845#undef VOL7D_POLY_TYPES
3846#define VOL7D_POLY_TYPE REAL
3847#define VOL7D_POLY_TYPES _r
3848#define ENABLE_SORT
3849#include "array_utilities_inc.F90"
3850#undef ENABLE_SORT
3851
3852#undef VOL7D_POLY_TYPE
3853#undef VOL7D_POLY_TYPES
3854#define VOL7D_POLY_TYPE DOUBLEPRECISION
3855#define VOL7D_POLY_TYPES _d
3856#define ENABLE_SORT
3857#include "array_utilities_inc.F90"
3858#undef ENABLE_SORT
3859
3860#define VOL7D_NO_PACK
3861#undef VOL7D_POLY_TYPE
3862#undef VOL7D_POLY_TYPES
3863#define VOL7D_POLY_TYPE CHARACTER(len=*)
3864#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3865#define VOL7D_POLY_TYPES _c
3866#define ENABLE_SORT
3867#include "array_utilities_inc.F90"
3868#undef VOL7D_POLY_TYPE_AUTO
3869#undef ENABLE_SORT
3870
3871SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
3872CHARACTER(len=*),INTENT(in) :: vect(:)
3873LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
3874CHARACTER(len=LEN(vect)) :: pack_distinct(:)
3875
3876INTEGER :: count_distinct
3877INTEGER :: i, j, dim
3878LOGICAL :: lback
3879
3880dim = SIZE(pack_distinct)
3881IF (PRESENT(back)) THEN
3882 lback = back
3883ELSE
3884 lback = .false.
3885ENDIF
3886count_distinct = 0
3887
3888IF (PRESENT (mask)) THEN
3889 IF (lback) THEN
3890 vectm1: DO i = 1, SIZE(vect)
3891 IF (.NOT.mask(i)) cycle vectm1
3892! DO j = i-1, 1, -1
3893! IF (vect(j) == vect(i)) CYCLE vectm1
3894 DO j = count_distinct, 1, -1
3895 IF (pack_distinct(j) == vect(i)) cycle vectm1
3896 ENDDO
3897 count_distinct = count_distinct + 1
3898 IF (count_distinct > dim) EXIT
3899 pack_distinct(count_distinct) = vect(i)
3900 ENDDO vectm1
3901 ELSE
3902 vectm2: DO i = 1, SIZE(vect)
3903 IF (.NOT.mask(i)) cycle vectm2
3904! DO j = 1, i-1
3905! IF (vect(j) == vect(i)) CYCLE vectm2
3906 DO j = 1, count_distinct
3907 IF (pack_distinct(j) == vect(i)) cycle vectm2
3908 ENDDO
3909 count_distinct = count_distinct + 1
3910 IF (count_distinct > dim) EXIT
3911 pack_distinct(count_distinct) = vect(i)
3912 ENDDO vectm2
3913 ENDIF
3914ELSE
3915 IF (lback) THEN
3916 vect1: DO i = 1, SIZE(vect)
3917! DO j = i-1, 1, -1
3918! IF (vect(j) == vect(i)) CYCLE vect1
3919 DO j = count_distinct, 1, -1
3920 IF (pack_distinct(j) == vect(i)) cycle vect1
3921 ENDDO
3922 count_distinct = count_distinct + 1
3923 IF (count_distinct > dim) EXIT
3924 pack_distinct(count_distinct) = vect(i)
3925 ENDDO vect1
3926 ELSE
3927 vect2: DO i = 1, SIZE(vect)
3928! DO j = 1, i-1
3929! IF (vect(j) == vect(i)) CYCLE vect2
3930 DO j = 1, count_distinct
3931 IF (pack_distinct(j) == vect(i)) cycle vect2
3932 ENDDO
3933 count_distinct = count_distinct + 1
3934 IF (count_distinct > dim) EXIT
3935 pack_distinct(count_distinct) = vect(i)
3936 ENDDO vect2
3937 ENDIF
3938ENDIF
3939
3940END SUBROUTINE pack_distinct_c
3941
3943FUNCTION map(mask) RESULT(mapidx)
3944LOGICAL,INTENT(in) :: mask(:)
3945INTEGER :: mapidx(count(mask))
3946
3947INTEGER :: i,j
3948
3949j = 0
3950DO i=1, SIZE(mask)
3951 j = j + 1
3952 IF (mask(i)) mapidx(j)=i
3953ENDDO
3954
3955END FUNCTION map
3956
3957#define ARRAYOF_ORIGEQ 1
3958
3959#undef ARRAYOF_ORIGTYPE
3960#undef ARRAYOF_TYPE
3961#define ARRAYOF_ORIGTYPE INTEGER
3962#define ARRAYOF_TYPE arrayof_integer
3963#include "arrayof_post.F90"
3964
3965#undef ARRAYOF_ORIGTYPE
3966#undef ARRAYOF_TYPE
3967#define ARRAYOF_ORIGTYPE REAL
3968#define ARRAYOF_TYPE arrayof_real
3969#include "arrayof_post.F90"
3970
3971#undef ARRAYOF_ORIGTYPE
3972#undef ARRAYOF_TYPE
3973#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3974#define ARRAYOF_TYPE arrayof_doubleprecision
3975#include "arrayof_post.F90"
3976
3977#undef ARRAYOF_ORIGEQ
3978
3979#undef ARRAYOF_ORIGTYPE
3980#undef ARRAYOF_TYPE
3981#define ARRAYOF_ORIGTYPE LOGICAL
3982#define ARRAYOF_TYPE arrayof_logical
3983#include "arrayof_post.F90"
3984
3985END 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.