libsim Versione 7.1.11
|
◆ map_distinct_d()
map distinct Definizione alla linea 3605 del file array_utilities.F90. 3606! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3607! authors:
3608! Davide Cesari <dcesari@arpa.emr.it>
3609! Paolo Patruno <ppatruno@arpa.emr.it>
3610
3611! This program is free software; you can redistribute it and/or
3612! modify it under the terms of the GNU General Public License as
3613! published by the Free Software Foundation; either version 2 of
3614! the License, or (at your option) any later version.
3615
3616! This program is distributed in the hope that it will be useful,
3617! but WITHOUT ANY WARRANTY; without even the implied warranty of
3618! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3619! GNU General Public License for more details.
3620
3621! You should have received a copy of the GNU General Public License
3622! along with this program. If not, see <http://www.gnu.org/licenses/>.
3623
3624
3625
3628#include "config.h"
3630
3631IMPLICIT NONE
3632
3633! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
3634!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
3635
3636#undef VOL7D_POLY_TYPE_AUTO
3637
3638#undef VOL7D_POLY_TYPE
3639#undef VOL7D_POLY_TYPES
3640#define VOL7D_POLY_TYPE INTEGER
3641#define VOL7D_POLY_TYPES _i
3642#define ENABLE_SORT
3643#include "array_utilities_pre.F90"
3644#undef ENABLE_SORT
3645
3646#undef VOL7D_POLY_TYPE
3647#undef VOL7D_POLY_TYPES
3648#define VOL7D_POLY_TYPE REAL
3649#define VOL7D_POLY_TYPES _r
3650#define ENABLE_SORT
3651#include "array_utilities_pre.F90"
3652#undef ENABLE_SORT
3653
3654#undef VOL7D_POLY_TYPE
3655#undef VOL7D_POLY_TYPES
3656#define VOL7D_POLY_TYPE DOUBLEPRECISION
3657#define VOL7D_POLY_TYPES _d
3658#define ENABLE_SORT
3659#include "array_utilities_pre.F90"
3660#undef ENABLE_SORT
3661
3662#define VOL7D_NO_PACK
3663#undef VOL7D_POLY_TYPE
3664#undef VOL7D_POLY_TYPES
3665#define VOL7D_POLY_TYPE CHARACTER(len=*)
3666#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3667#define VOL7D_POLY_TYPES _c
3668#define ENABLE_SORT
3669#include "array_utilities_pre.F90"
3670#undef VOL7D_POLY_TYPE_AUTO
3671#undef ENABLE_SORT
3672
3673
3674#define ARRAYOF_ORIGEQ 1
3675
3676#define ARRAYOF_ORIGTYPE INTEGER
3677#define ARRAYOF_TYPE arrayof_integer
3678#include "arrayof_pre.F90"
3679
3680#undef ARRAYOF_ORIGTYPE
3681#undef ARRAYOF_TYPE
3682#define ARRAYOF_ORIGTYPE REAL
3683#define ARRAYOF_TYPE arrayof_real
3684#include "arrayof_pre.F90"
3685
3686#undef ARRAYOF_ORIGTYPE
3687#undef ARRAYOF_TYPE
3688#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3689#define ARRAYOF_TYPE arrayof_doubleprecision
3690#include "arrayof_pre.F90"
3691
3692#undef ARRAYOF_ORIGEQ
3693
3694#undef ARRAYOF_ORIGTYPE
3695#undef ARRAYOF_TYPE
3696#define ARRAYOF_ORIGTYPE LOGICAL
3697#define ARRAYOF_TYPE arrayof_logical
3698#include "arrayof_pre.F90"
3699
3700PRIVATE
3701! from arrayof
3703PUBLIC insert_unique, append_unique
3704
3706 count_distinct_sorted, pack_distinct_sorted, &
3707 count_distinct, pack_distinct, count_and_pack_distinct, &
3708 map_distinct, map_inv_distinct, &
3709 firsttrue, lasttrue, pack_distinct_c, map
3710
3711CONTAINS
3712
3713
3716FUNCTION firsttrue(v) RESULT(i)
3717LOGICAL,INTENT(in) :: v(:)
3718INTEGER :: i
3719
3720DO i = 1, SIZE(v)
3721 IF (v(i)) RETURN
3722ENDDO
3723i = 0
3724
3725END FUNCTION firsttrue
3726
3727
3730FUNCTION lasttrue(v) RESULT(i)
3731LOGICAL,INTENT(in) :: v(:)
3732INTEGER :: i
3733
3734DO i = SIZE(v), 1, -1
3735 IF (v(i)) RETURN
3736ENDDO
3737
3738END FUNCTION lasttrue
3739
3740
3741! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
3742#undef VOL7D_POLY_TYPE_AUTO
3743#undef VOL7D_NO_PACK
3744
3745#undef VOL7D_POLY_TYPE
3746#undef VOL7D_POLY_TYPES
3747#define VOL7D_POLY_TYPE INTEGER
3748#define VOL7D_POLY_TYPES _i
3749#define ENABLE_SORT
3750#include "array_utilities_inc.F90"
3751#undef ENABLE_SORT
3752
3753#undef VOL7D_POLY_TYPE
3754#undef VOL7D_POLY_TYPES
3755#define VOL7D_POLY_TYPE REAL
3756#define VOL7D_POLY_TYPES _r
3757#define ENABLE_SORT
3758#include "array_utilities_inc.F90"
3759#undef ENABLE_SORT
3760
3761#undef VOL7D_POLY_TYPE
3762#undef VOL7D_POLY_TYPES
3763#define VOL7D_POLY_TYPE DOUBLEPRECISION
3764#define VOL7D_POLY_TYPES _d
3765#define ENABLE_SORT
3766#include "array_utilities_inc.F90"
3767#undef ENABLE_SORT
3768
3769#define VOL7D_NO_PACK
3770#undef VOL7D_POLY_TYPE
3771#undef VOL7D_POLY_TYPES
3772#define VOL7D_POLY_TYPE CHARACTER(len=*)
3773#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3774#define VOL7D_POLY_TYPES _c
3775#define ENABLE_SORT
3776#include "array_utilities_inc.F90"
3777#undef VOL7D_POLY_TYPE_AUTO
3778#undef ENABLE_SORT
3779
3780SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
3781CHARACTER(len=*),INTENT(in) :: vect(:)
3782LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
3783CHARACTER(len=LEN(vect)) :: pack_distinct(:)
3784
3785INTEGER :: count_distinct
3786INTEGER :: i, j, dim
3787LOGICAL :: lback
3788
3789dim = SIZE(pack_distinct)
3790IF (PRESENT(back)) THEN
3791 lback = back
3792ELSE
3793 lback = .false.
3794ENDIF
3795count_distinct = 0
3796
3797IF (PRESENT (mask)) THEN
3798 IF (lback) THEN
3799 vectm1: DO i = 1, SIZE(vect)
3800 IF (.NOT.mask(i)) cycle vectm1
3801! DO j = i-1, 1, -1
3802! IF (vect(j) == vect(i)) CYCLE vectm1
3803 DO j = count_distinct, 1, -1
3804 IF (pack_distinct(j) == vect(i)) cycle vectm1
3805 ENDDO
3806 count_distinct = count_distinct + 1
3807 IF (count_distinct > dim) EXIT
3808 pack_distinct(count_distinct) = vect(i)
3809 ENDDO vectm1
3810 ELSE
3811 vectm2: DO i = 1, SIZE(vect)
3812 IF (.NOT.mask(i)) cycle vectm2
3813! DO j = 1, i-1
3814! IF (vect(j) == vect(i)) CYCLE vectm2
3815 DO j = 1, count_distinct
3816 IF (pack_distinct(j) == vect(i)) cycle vectm2
3817 ENDDO
3818 count_distinct = count_distinct + 1
3819 IF (count_distinct > dim) EXIT
3820 pack_distinct(count_distinct) = vect(i)
3821 ENDDO vectm2
3822 ENDIF
3823ELSE
3824 IF (lback) THEN
3825 vect1: DO i = 1, SIZE(vect)
3826! DO j = i-1, 1, -1
3827! IF (vect(j) == vect(i)) CYCLE vect1
3828 DO j = count_distinct, 1, -1
3829 IF (pack_distinct(j) == vect(i)) cycle vect1
3830 ENDDO
3831 count_distinct = count_distinct + 1
3832 IF (count_distinct > dim) EXIT
3833 pack_distinct(count_distinct) = vect(i)
3834 ENDDO vect1
3835 ELSE
3836 vect2: DO i = 1, SIZE(vect)
3837! DO j = 1, i-1
3838! IF (vect(j) == vect(i)) CYCLE vect2
3839 DO j = 1, count_distinct
3840 IF (pack_distinct(j) == vect(i)) cycle vect2
3841 ENDDO
3842 count_distinct = count_distinct + 1
3843 IF (count_distinct > dim) EXIT
3844 pack_distinct(count_distinct) = vect(i)
3845 ENDDO vect2
3846 ENDIF
3847ENDIF
3848
3849END SUBROUTINE pack_distinct_c
3850
3852FUNCTION map(mask) RESULT(mapidx)
3853LOGICAL,INTENT(in) :: mask(:)
3854INTEGER :: mapidx(count(mask))
3855
3856INTEGER :: i,j
3857
3858j = 0
3859DO i=1, SIZE(mask)
3860 j = j + 1
3861 IF (mask(i)) mapidx(j)=i
3862ENDDO
3863
3864END FUNCTION map
3865
3866#define ARRAYOF_ORIGEQ 1
3867
3868#undef ARRAYOF_ORIGTYPE
3869#undef ARRAYOF_TYPE
3870#define ARRAYOF_ORIGTYPE INTEGER
3871#define ARRAYOF_TYPE arrayof_integer
3872#include "arrayof_post.F90"
3873
3874#undef ARRAYOF_ORIGTYPE
3875#undef ARRAYOF_TYPE
3876#define ARRAYOF_ORIGTYPE REAL
3877#define ARRAYOF_TYPE arrayof_real
3878#include "arrayof_post.F90"
3879
3880#undef ARRAYOF_ORIGTYPE
3881#undef ARRAYOF_TYPE
3882#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3883#define ARRAYOF_TYPE arrayof_doubleprecision
3884#include "arrayof_post.F90"
3885
3886#undef ARRAYOF_ORIGEQ
3887
3888#undef ARRAYOF_ORIGTYPE
3889#undef ARRAYOF_TYPE
3890#define ARRAYOF_ORIGTYPE LOGICAL
3891#define ARRAYOF_TYPE arrayof_logical
3892#include "arrayof_post.F90"
3893
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 |