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