libsim Versione 7.1.11

◆ pack_distinct_sorted_d()

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

compatta gli elementi distinti di vect in un sorted array

Definizione alla linea 3423 del file array_utilities.F90.

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