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