libsim Versione 7.2.1

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

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