libsim Versione 7.2.6

◆ pack_distinct_d()

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

compatta gli elementi distinti di vect in un array

Definizione alla linea 3450 del file array_utilities.F90.

3452! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3453! authors:
3454! Davide Cesari <dcesari@arpa.emr.it>
3455! Paolo Patruno <ppatruno@arpa.emr.it>
3456
3457! This program is free software; you can redistribute it and/or
3458! modify it under the terms of the GNU General Public License as
3459! published by the Free Software Foundation; either version 2 of
3460! the License, or (at your option) any later version.
3461
3462! This program is distributed in the hope that it will be useful,
3463! but WITHOUT ANY WARRANTY; without even the implied warranty of
3464! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3465! GNU General Public License for more details.
3466
3467! You should have received a copy of the GNU General Public License
3468! along with this program. If not, see <http://www.gnu.org/licenses/>.
3469
3470
3471
3472!> This module defines usefull general purpose function and subroutine
3473!!\ingroup base
3474#include "config.h"
3475MODULE array_utilities
3476
3477IMPLICIT NONE
3478
3479! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
3480!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
3481
3482#undef VOL7D_POLY_TYPE_AUTO
3483
3484#undef VOL7D_POLY_TYPE
3485#undef VOL7D_POLY_TYPES
3486#define VOL7D_POLY_TYPE INTEGER
3487#define VOL7D_POLY_TYPES _i
3488#define ENABLE_SORT
3489#include "array_utilities_pre.F90"
3490#undef ENABLE_SORT
3491
3492#undef VOL7D_POLY_TYPE
3493#undef VOL7D_POLY_TYPES
3494#define VOL7D_POLY_TYPE REAL
3495#define VOL7D_POLY_TYPES _r
3496#define ENABLE_SORT
3497#include "array_utilities_pre.F90"
3498#undef ENABLE_SORT
3499
3500#undef VOL7D_POLY_TYPE
3501#undef VOL7D_POLY_TYPES
3502#define VOL7D_POLY_TYPE DOUBLEPRECISION
3503#define VOL7D_POLY_TYPES _d
3504#define ENABLE_SORT
3505#include "array_utilities_pre.F90"
3506#undef ENABLE_SORT
3507
3508#define VOL7D_NO_PACK
3509#undef VOL7D_POLY_TYPE
3510#undef VOL7D_POLY_TYPES
3511#define VOL7D_POLY_TYPE CHARACTER(len=*)
3512#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3513#define VOL7D_POLY_TYPES _c
3514#define ENABLE_SORT
3515#include "array_utilities_pre.F90"
3516#undef VOL7D_POLY_TYPE_AUTO
3517#undef ENABLE_SORT
3518
3519
3520#define ARRAYOF_ORIGEQ 1
3521
3522#define ARRAYOF_ORIGTYPE INTEGER
3523#define ARRAYOF_TYPE arrayof_integer
3524#include "arrayof_pre.F90"
3525
3526#undef ARRAYOF_ORIGTYPE
3527#undef ARRAYOF_TYPE
3528#define ARRAYOF_ORIGTYPE REAL
3529#define ARRAYOF_TYPE arrayof_real
3530#include "arrayof_pre.F90"
3531
3532#undef ARRAYOF_ORIGTYPE
3533#undef ARRAYOF_TYPE
3534#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3535#define ARRAYOF_TYPE arrayof_doubleprecision
3536#include "arrayof_pre.F90"
3537
3538#undef ARRAYOF_ORIGEQ
3539
3540#undef ARRAYOF_ORIGTYPE
3541#undef ARRAYOF_TYPE
3542#define ARRAYOF_ORIGTYPE LOGICAL
3543#define ARRAYOF_TYPE arrayof_logical
3544#include "arrayof_pre.F90"
3545
3546PRIVATE
3547! from arrayof
3549PUBLIC insert_unique, append_unique
3550
3551PUBLIC sort, index, index_c, &
3552 count_distinct_sorted, pack_distinct_sorted, &
3553 count_distinct, pack_distinct, count_and_pack_distinct, &
3554 map_distinct, map_inv_distinct, &
3555 firsttrue, lasttrue, pack_distinct_c, map
3556
3557CONTAINS
3558
3559
3560!> Return the index ot the first true element of the input logical array \a v.
3561!! If no \c .TRUE. elements are found, it returns 0.
3562FUNCTION firsttrue(v) RESULT(i)
3563LOGICAL,INTENT(in) :: v(:) !< logical array to test
3564INTEGER :: i
3565
3566DO i = 1, SIZE(v)
3567 IF (v(i)) RETURN
3568ENDDO
3569i = 0
3570
3571END FUNCTION firsttrue
3572
3573
3574!> Return the index ot the last true element of the input logical array \a v.
3575!! If no \c .TRUE. elements are found, it returns 0.
3576FUNCTION lasttrue(v) RESULT(i)
3577LOGICAL,INTENT(in) :: v(:) !< logical array to test
3578INTEGER :: i
3579
3580DO i = SIZE(v), 1, -1
3581 IF (v(i)) RETURN
3582ENDDO
3583
3584END FUNCTION lasttrue
3585
3586
3587! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
3588#undef VOL7D_POLY_TYPE_AUTO
3589#undef VOL7D_NO_PACK
3590
3591#undef VOL7D_POLY_TYPE
3592#undef VOL7D_POLY_TYPES
3593#define VOL7D_POLY_TYPE INTEGER
3594#define VOL7D_POLY_TYPES _i
3595#define ENABLE_SORT
3596#include "array_utilities_inc.F90"
3597#undef ENABLE_SORT
3598
3599#undef VOL7D_POLY_TYPE
3600#undef VOL7D_POLY_TYPES
3601#define VOL7D_POLY_TYPE REAL
3602#define VOL7D_POLY_TYPES _r
3603#define ENABLE_SORT
3604#include "array_utilities_inc.F90"
3605#undef ENABLE_SORT
3606
3607#undef VOL7D_POLY_TYPE
3608#undef VOL7D_POLY_TYPES
3609#define VOL7D_POLY_TYPE DOUBLEPRECISION
3610#define VOL7D_POLY_TYPES _d
3611#define ENABLE_SORT
3612#include "array_utilities_inc.F90"
3613#undef ENABLE_SORT
3614
3615#define VOL7D_NO_PACK
3616#undef VOL7D_POLY_TYPE
3617#undef VOL7D_POLY_TYPES
3618#define VOL7D_POLY_TYPE CHARACTER(len=*)
3619#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3620#define VOL7D_POLY_TYPES _c
3621#define ENABLE_SORT
3622#include "array_utilities_inc.F90"
3623#undef VOL7D_POLY_TYPE_AUTO
3624#undef ENABLE_SORT
3625
3626SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
3627CHARACTER(len=*),INTENT(in) :: vect(:)
3628LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
3629CHARACTER(len=LEN(vect)) :: pack_distinct(:)
3630
3631INTEGER :: count_distinct
3632INTEGER :: i, j, dim
3633LOGICAL :: lback
3634
3635dim = SIZE(pack_distinct)
3636IF (PRESENT(back)) THEN
3637 lback = back
3638ELSE
3639 lback = .false.
3640ENDIF
3641count_distinct = 0
3642
3643IF (PRESENT (mask)) THEN
3644 IF (lback) THEN
3645 vectm1: DO i = 1, SIZE(vect)
3646 IF (.NOT.mask(i)) cycle vectm1
3647! DO j = i-1, 1, -1
3648! IF (vect(j) == vect(i)) CYCLE vectm1
3649 DO j = count_distinct, 1, -1
3650 IF (pack_distinct(j) == vect(i)) cycle vectm1
3651 ENDDO
3652 count_distinct = count_distinct + 1
3653 IF (count_distinct > dim) EXIT
3654 pack_distinct(count_distinct) = vect(i)
3655 ENDDO vectm1
3656 ELSE
3657 vectm2: DO i = 1, SIZE(vect)
3658 IF (.NOT.mask(i)) cycle vectm2
3659! DO j = 1, i-1
3660! IF (vect(j) == vect(i)) CYCLE vectm2
3661 DO j = 1, count_distinct
3662 IF (pack_distinct(j) == vect(i)) cycle vectm2
3663 ENDDO
3664 count_distinct = count_distinct + 1
3665 IF (count_distinct > dim) EXIT
3666 pack_distinct(count_distinct) = vect(i)
3667 ENDDO vectm2
3668 ENDIF
3669ELSE
3670 IF (lback) THEN
3671 vect1: DO i = 1, SIZE(vect)
3672! DO j = i-1, 1, -1
3673! IF (vect(j) == vect(i)) CYCLE vect1
3674 DO j = count_distinct, 1, -1
3675 IF (pack_distinct(j) == vect(i)) cycle vect1
3676 ENDDO
3677 count_distinct = count_distinct + 1
3678 IF (count_distinct > dim) EXIT
3679 pack_distinct(count_distinct) = vect(i)
3680 ENDDO vect1
3681 ELSE
3682 vect2: DO i = 1, SIZE(vect)
3683! DO j = 1, i-1
3684! IF (vect(j) == vect(i)) CYCLE vect2
3685 DO j = 1, count_distinct
3686 IF (pack_distinct(j) == vect(i)) cycle vect2
3687 ENDDO
3688 count_distinct = count_distinct + 1
3689 IF (count_distinct > dim) EXIT
3690 pack_distinct(count_distinct) = vect(i)
3691 ENDDO vect2
3692 ENDIF
3693ENDIF
3694
3695END SUBROUTINE pack_distinct_c
3696
3697!> Return the index of the array only where the mask is true
3698FUNCTION map(mask) RESULT(mapidx)
3699LOGICAL,INTENT(in) :: mask(:)
3700INTEGER :: mapidx(count(mask))
3701
3702INTEGER :: i,j
3703
3704j = 0
3705DO i=1, SIZE(mask)
3706 j = j + 1
3707 IF (mask(i)) mapidx(j)=i
3708ENDDO
3709
3710END FUNCTION map
3711
3712#define ARRAYOF_ORIGEQ 1
3713
3714#undef ARRAYOF_ORIGTYPE
3715#undef ARRAYOF_TYPE
3716#define ARRAYOF_ORIGTYPE INTEGER
3717#define ARRAYOF_TYPE arrayof_integer
3718#include "arrayof_post.F90"
3719
3720#undef ARRAYOF_ORIGTYPE
3721#undef ARRAYOF_TYPE
3722#define ARRAYOF_ORIGTYPE REAL
3723#define ARRAYOF_TYPE arrayof_real
3724#include "arrayof_post.F90"
3725
3726#undef ARRAYOF_ORIGTYPE
3727#undef ARRAYOF_TYPE
3728#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3729#define ARRAYOF_TYPE arrayof_doubleprecision
3730#include "arrayof_post.F90"
3731
3732#undef ARRAYOF_ORIGEQ
3733
3734#undef ARRAYOF_ORIGTYPE
3735#undef ARRAYOF_TYPE
3736#define ARRAYOF_ORIGTYPE LOGICAL
3737#define ARRAYOF_TYPE arrayof_logical
3738#include "arrayof_post.F90"
3739
3740END 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.