libsim Versione 7.1.11

◆ 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 3456 del file array_utilities.F90.

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