libsim Versione 7.1.11

◆ count_distinct_sorted_d()

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

conta gli elementi distinti in un sorted array

Definizione alla linea 3312 del file array_utilities.F90.

3313! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3314! authors:
3315! Davide Cesari <dcesari@arpa.emr.it>
3316! Paolo Patruno <ppatruno@arpa.emr.it>
3317
3318! This program is free software; you can redistribute it and/or
3319! modify it under the terms of the GNU General Public License as
3320! published by the Free Software Foundation; either version 2 of
3321! the License, or (at your option) any later version.
3322
3323! This program is distributed in the hope that it will be useful,
3324! but WITHOUT ANY WARRANTY; without even the implied warranty of
3325! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3326! GNU General Public License for more details.
3327
3328! You should have received a copy of the GNU General Public License
3329! along with this program. If not, see <http://www.gnu.org/licenses/>.
3330
3331
3332
3335#include "config.h"
3336MODULE array_utilities
3337
3338IMPLICIT NONE
3339
3340! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
3341!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
3342
3343#undef VOL7D_POLY_TYPE_AUTO
3344
3345#undef VOL7D_POLY_TYPE
3346#undef VOL7D_POLY_TYPES
3347#define VOL7D_POLY_TYPE INTEGER
3348#define VOL7D_POLY_TYPES _i
3349#define ENABLE_SORT
3350#include "array_utilities_pre.F90"
3351#undef ENABLE_SORT
3352
3353#undef VOL7D_POLY_TYPE
3354#undef VOL7D_POLY_TYPES
3355#define VOL7D_POLY_TYPE REAL
3356#define VOL7D_POLY_TYPES _r
3357#define ENABLE_SORT
3358#include "array_utilities_pre.F90"
3359#undef ENABLE_SORT
3360
3361#undef VOL7D_POLY_TYPE
3362#undef VOL7D_POLY_TYPES
3363#define VOL7D_POLY_TYPE DOUBLEPRECISION
3364#define VOL7D_POLY_TYPES _d
3365#define ENABLE_SORT
3366#include "array_utilities_pre.F90"
3367#undef ENABLE_SORT
3368
3369#define VOL7D_NO_PACK
3370#undef VOL7D_POLY_TYPE
3371#undef VOL7D_POLY_TYPES
3372#define VOL7D_POLY_TYPE CHARACTER(len=*)
3373#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3374#define VOL7D_POLY_TYPES _c
3375#define ENABLE_SORT
3376#include "array_utilities_pre.F90"
3377#undef VOL7D_POLY_TYPE_AUTO
3378#undef ENABLE_SORT
3379
3380
3381#define ARRAYOF_ORIGEQ 1
3382
3383#define ARRAYOF_ORIGTYPE INTEGER
3384#define ARRAYOF_TYPE arrayof_integer
3385#include "arrayof_pre.F90"
3386
3387#undef ARRAYOF_ORIGTYPE
3388#undef ARRAYOF_TYPE
3389#define ARRAYOF_ORIGTYPE REAL
3390#define ARRAYOF_TYPE arrayof_real
3391#include "arrayof_pre.F90"
3392
3393#undef ARRAYOF_ORIGTYPE
3394#undef ARRAYOF_TYPE
3395#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3396#define ARRAYOF_TYPE arrayof_doubleprecision
3397#include "arrayof_pre.F90"
3398
3399#undef ARRAYOF_ORIGEQ
3400
3401#undef ARRAYOF_ORIGTYPE
3402#undef ARRAYOF_TYPE
3403#define ARRAYOF_ORIGTYPE LOGICAL
3404#define ARRAYOF_TYPE arrayof_logical
3405#include "arrayof_pre.F90"
3406
3407PRIVATE
3408! from arrayof
3410PUBLIC insert_unique, append_unique
3411
3412PUBLIC sort, index, index_c, &
3413 count_distinct_sorted, pack_distinct_sorted, &
3414 count_distinct, pack_distinct, count_and_pack_distinct, &
3415 map_distinct, map_inv_distinct, &
3416 firsttrue, lasttrue, pack_distinct_c, map
3417
3418CONTAINS
3419
3420
3423FUNCTION firsttrue(v) RESULT(i)
3424LOGICAL,INTENT(in) :: v(:)
3425INTEGER :: i
3426
3427DO i = 1, SIZE(v)
3428 IF (v(i)) RETURN
3429ENDDO
3430i = 0
3431
3432END FUNCTION firsttrue
3433
3434
3437FUNCTION lasttrue(v) RESULT(i)
3438LOGICAL,INTENT(in) :: v(:)
3439INTEGER :: i
3440
3441DO i = SIZE(v), 1, -1
3442 IF (v(i)) RETURN
3443ENDDO
3444
3445END FUNCTION lasttrue
3446
3447
3448! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
3449#undef VOL7D_POLY_TYPE_AUTO
3450#undef VOL7D_NO_PACK
3451
3452#undef VOL7D_POLY_TYPE
3453#undef VOL7D_POLY_TYPES
3454#define VOL7D_POLY_TYPE INTEGER
3455#define VOL7D_POLY_TYPES _i
3456#define ENABLE_SORT
3457#include "array_utilities_inc.F90"
3458#undef ENABLE_SORT
3459
3460#undef VOL7D_POLY_TYPE
3461#undef VOL7D_POLY_TYPES
3462#define VOL7D_POLY_TYPE REAL
3463#define VOL7D_POLY_TYPES _r
3464#define ENABLE_SORT
3465#include "array_utilities_inc.F90"
3466#undef ENABLE_SORT
3467
3468#undef VOL7D_POLY_TYPE
3469#undef VOL7D_POLY_TYPES
3470#define VOL7D_POLY_TYPE DOUBLEPRECISION
3471#define VOL7D_POLY_TYPES _d
3472#define ENABLE_SORT
3473#include "array_utilities_inc.F90"
3474#undef ENABLE_SORT
3475
3476#define VOL7D_NO_PACK
3477#undef VOL7D_POLY_TYPE
3478#undef VOL7D_POLY_TYPES
3479#define VOL7D_POLY_TYPE CHARACTER(len=*)
3480#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3481#define VOL7D_POLY_TYPES _c
3482#define ENABLE_SORT
3483#include "array_utilities_inc.F90"
3484#undef VOL7D_POLY_TYPE_AUTO
3485#undef ENABLE_SORT
3486
3487SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
3488CHARACTER(len=*),INTENT(in) :: vect(:)
3489LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
3490CHARACTER(len=LEN(vect)) :: pack_distinct(:)
3491
3492INTEGER :: count_distinct
3493INTEGER :: i, j, dim
3494LOGICAL :: lback
3495
3496dim = SIZE(pack_distinct)
3497IF (PRESENT(back)) THEN
3498 lback = back
3499ELSE
3500 lback = .false.
3501ENDIF
3502count_distinct = 0
3503
3504IF (PRESENT (mask)) THEN
3505 IF (lback) THEN
3506 vectm1: DO i = 1, SIZE(vect)
3507 IF (.NOT.mask(i)) cycle vectm1
3508! DO j = i-1, 1, -1
3509! IF (vect(j) == vect(i)) CYCLE vectm1
3510 DO j = count_distinct, 1, -1
3511 IF (pack_distinct(j) == vect(i)) cycle vectm1
3512 ENDDO
3513 count_distinct = count_distinct + 1
3514 IF (count_distinct > dim) EXIT
3515 pack_distinct(count_distinct) = vect(i)
3516 ENDDO vectm1
3517 ELSE
3518 vectm2: DO i = 1, SIZE(vect)
3519 IF (.NOT.mask(i)) cycle vectm2
3520! DO j = 1, i-1
3521! IF (vect(j) == vect(i)) CYCLE vectm2
3522 DO j = 1, count_distinct
3523 IF (pack_distinct(j) == vect(i)) cycle vectm2
3524 ENDDO
3525 count_distinct = count_distinct + 1
3526 IF (count_distinct > dim) EXIT
3527 pack_distinct(count_distinct) = vect(i)
3528 ENDDO vectm2
3529 ENDIF
3530ELSE
3531 IF (lback) THEN
3532 vect1: DO i = 1, SIZE(vect)
3533! DO j = i-1, 1, -1
3534! IF (vect(j) == vect(i)) CYCLE vect1
3535 DO j = count_distinct, 1, -1
3536 IF (pack_distinct(j) == vect(i)) cycle vect1
3537 ENDDO
3538 count_distinct = count_distinct + 1
3539 IF (count_distinct > dim) EXIT
3540 pack_distinct(count_distinct) = vect(i)
3541 ENDDO vect1
3542 ELSE
3543 vect2: DO i = 1, SIZE(vect)
3544! DO j = 1, i-1
3545! IF (vect(j) == vect(i)) CYCLE vect2
3546 DO j = 1, count_distinct
3547 IF (pack_distinct(j) == vect(i)) cycle vect2
3548 ENDDO
3549 count_distinct = count_distinct + 1
3550 IF (count_distinct > dim) EXIT
3551 pack_distinct(count_distinct) = vect(i)
3552 ENDDO vect2
3553 ENDIF
3554ENDIF
3555
3556END SUBROUTINE pack_distinct_c
3557
3559FUNCTION map(mask) RESULT(mapidx)
3560LOGICAL,INTENT(in) :: mask(:)
3561INTEGER :: mapidx(count(mask))
3562
3563INTEGER :: i,j
3564
3565j = 0
3566DO i=1, SIZE(mask)
3567 j = j + 1
3568 IF (mask(i)) mapidx(j)=i
3569ENDDO
3570
3571END FUNCTION map
3572
3573#define ARRAYOF_ORIGEQ 1
3574
3575#undef ARRAYOF_ORIGTYPE
3576#undef ARRAYOF_TYPE
3577#define ARRAYOF_ORIGTYPE INTEGER
3578#define ARRAYOF_TYPE arrayof_integer
3579#include "arrayof_post.F90"
3580
3581#undef ARRAYOF_ORIGTYPE
3582#undef ARRAYOF_TYPE
3583#define ARRAYOF_ORIGTYPE REAL
3584#define ARRAYOF_TYPE arrayof_real
3585#include "arrayof_post.F90"
3586
3587#undef ARRAYOF_ORIGTYPE
3588#undef ARRAYOF_TYPE
3589#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3590#define ARRAYOF_TYPE arrayof_doubleprecision
3591#include "arrayof_post.F90"
3592
3593#undef ARRAYOF_ORIGEQ
3594
3595#undef ARRAYOF_ORIGTYPE
3596#undef ARRAYOF_TYPE
3597#define ARRAYOF_ORIGTYPE LOGICAL
3598#define ARRAYOF_TYPE arrayof_logical
3599#include "arrayof_post.F90"
3600
3601END 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.