libsim Versione 7.1.11
|
◆ count_distinct_d()
conta gli elementi distinti in vect Definizione alla linea 3346 del file array_utilities.F90. 3347! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
3348! authors:
3349! Davide Cesari <dcesari@arpa.emr.it>
3350! Paolo Patruno <ppatruno@arpa.emr.it>
3351
3352! This program is free software; you can redistribute it and/or
3353! modify it under the terms of the GNU General Public License as
3354! published by the Free Software Foundation; either version 2 of
3355! the License, or (at your option) any later version.
3356
3357! This program is distributed in the hope that it will be useful,
3358! but WITHOUT ANY WARRANTY; without even the implied warranty of
3359! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3360! GNU General Public License for more details.
3361
3362! You should have received a copy of the GNU General Public License
3363! along with this program. If not, see <http://www.gnu.org/licenses/>.
3364
3365
3366
3369#include "config.h"
3371
3372IMPLICIT NONE
3373
3374! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
3375!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
3376
3377#undef VOL7D_POLY_TYPE_AUTO
3378
3379#undef VOL7D_POLY_TYPE
3380#undef VOL7D_POLY_TYPES
3381#define VOL7D_POLY_TYPE INTEGER
3382#define VOL7D_POLY_TYPES _i
3383#define ENABLE_SORT
3384#include "array_utilities_pre.F90"
3385#undef ENABLE_SORT
3386
3387#undef VOL7D_POLY_TYPE
3388#undef VOL7D_POLY_TYPES
3389#define VOL7D_POLY_TYPE REAL
3390#define VOL7D_POLY_TYPES _r
3391#define ENABLE_SORT
3392#include "array_utilities_pre.F90"
3393#undef ENABLE_SORT
3394
3395#undef VOL7D_POLY_TYPE
3396#undef VOL7D_POLY_TYPES
3397#define VOL7D_POLY_TYPE DOUBLEPRECISION
3398#define VOL7D_POLY_TYPES _d
3399#define ENABLE_SORT
3400#include "array_utilities_pre.F90"
3401#undef ENABLE_SORT
3402
3403#define VOL7D_NO_PACK
3404#undef VOL7D_POLY_TYPE
3405#undef VOL7D_POLY_TYPES
3406#define VOL7D_POLY_TYPE CHARACTER(len=*)
3407#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3408#define VOL7D_POLY_TYPES _c
3409#define ENABLE_SORT
3410#include "array_utilities_pre.F90"
3411#undef VOL7D_POLY_TYPE_AUTO
3412#undef ENABLE_SORT
3413
3414
3415#define ARRAYOF_ORIGEQ 1
3416
3417#define ARRAYOF_ORIGTYPE INTEGER
3418#define ARRAYOF_TYPE arrayof_integer
3419#include "arrayof_pre.F90"
3420
3421#undef ARRAYOF_ORIGTYPE
3422#undef ARRAYOF_TYPE
3423#define ARRAYOF_ORIGTYPE REAL
3424#define ARRAYOF_TYPE arrayof_real
3425#include "arrayof_pre.F90"
3426
3427#undef ARRAYOF_ORIGTYPE
3428#undef ARRAYOF_TYPE
3429#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3430#define ARRAYOF_TYPE arrayof_doubleprecision
3431#include "arrayof_pre.F90"
3432
3433#undef ARRAYOF_ORIGEQ
3434
3435#undef ARRAYOF_ORIGTYPE
3436#undef ARRAYOF_TYPE
3437#define ARRAYOF_ORIGTYPE LOGICAL
3438#define ARRAYOF_TYPE arrayof_logical
3439#include "arrayof_pre.F90"
3440
3441PRIVATE
3442! from arrayof
3444PUBLIC insert_unique, append_unique
3445
3447 count_distinct_sorted, pack_distinct_sorted, &
3448 count_distinct, pack_distinct, count_and_pack_distinct, &
3449 map_distinct, map_inv_distinct, &
3450 firsttrue, lasttrue, pack_distinct_c, map
3451
3452CONTAINS
3453
3454
3457FUNCTION firsttrue(v) RESULT(i)
3458LOGICAL,INTENT(in) :: v(:)
3459INTEGER :: i
3460
3461DO i = 1, SIZE(v)
3462 IF (v(i)) RETURN
3463ENDDO
3464i = 0
3465
3466END FUNCTION firsttrue
3467
3468
3471FUNCTION lasttrue(v) RESULT(i)
3472LOGICAL,INTENT(in) :: v(:)
3473INTEGER :: i
3474
3475DO i = SIZE(v), 1, -1
3476 IF (v(i)) RETURN
3477ENDDO
3478
3479END FUNCTION lasttrue
3480
3481
3482! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
3483#undef VOL7D_POLY_TYPE_AUTO
3484#undef VOL7D_NO_PACK
3485
3486#undef VOL7D_POLY_TYPE
3487#undef VOL7D_POLY_TYPES
3488#define VOL7D_POLY_TYPE INTEGER
3489#define VOL7D_POLY_TYPES _i
3490#define ENABLE_SORT
3491#include "array_utilities_inc.F90"
3492#undef ENABLE_SORT
3493
3494#undef VOL7D_POLY_TYPE
3495#undef VOL7D_POLY_TYPES
3496#define VOL7D_POLY_TYPE REAL
3497#define VOL7D_POLY_TYPES _r
3498#define ENABLE_SORT
3499#include "array_utilities_inc.F90"
3500#undef ENABLE_SORT
3501
3502#undef VOL7D_POLY_TYPE
3503#undef VOL7D_POLY_TYPES
3504#define VOL7D_POLY_TYPE DOUBLEPRECISION
3505#define VOL7D_POLY_TYPES _d
3506#define ENABLE_SORT
3507#include "array_utilities_inc.F90"
3508#undef ENABLE_SORT
3509
3510#define VOL7D_NO_PACK
3511#undef VOL7D_POLY_TYPE
3512#undef VOL7D_POLY_TYPES
3513#define VOL7D_POLY_TYPE CHARACTER(len=*)
3514#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
3515#define VOL7D_POLY_TYPES _c
3516#define ENABLE_SORT
3517#include "array_utilities_inc.F90"
3518#undef VOL7D_POLY_TYPE_AUTO
3519#undef ENABLE_SORT
3520
3521SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
3522CHARACTER(len=*),INTENT(in) :: vect(:)
3523LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
3524CHARACTER(len=LEN(vect)) :: pack_distinct(:)
3525
3526INTEGER :: count_distinct
3527INTEGER :: i, j, dim
3528LOGICAL :: lback
3529
3530dim = SIZE(pack_distinct)
3531IF (PRESENT(back)) THEN
3532 lback = back
3533ELSE
3534 lback = .false.
3535ENDIF
3536count_distinct = 0
3537
3538IF (PRESENT (mask)) THEN
3539 IF (lback) THEN
3540 vectm1: DO i = 1, SIZE(vect)
3541 IF (.NOT.mask(i)) cycle vectm1
3542! DO j = i-1, 1, -1
3543! IF (vect(j) == vect(i)) CYCLE vectm1
3544 DO j = count_distinct, 1, -1
3545 IF (pack_distinct(j) == vect(i)) cycle vectm1
3546 ENDDO
3547 count_distinct = count_distinct + 1
3548 IF (count_distinct > dim) EXIT
3549 pack_distinct(count_distinct) = vect(i)
3550 ENDDO vectm1
3551 ELSE
3552 vectm2: DO i = 1, SIZE(vect)
3553 IF (.NOT.mask(i)) cycle vectm2
3554! DO j = 1, i-1
3555! IF (vect(j) == vect(i)) CYCLE vectm2
3556 DO j = 1, count_distinct
3557 IF (pack_distinct(j) == vect(i)) cycle vectm2
3558 ENDDO
3559 count_distinct = count_distinct + 1
3560 IF (count_distinct > dim) EXIT
3561 pack_distinct(count_distinct) = vect(i)
3562 ENDDO vectm2
3563 ENDIF
3564ELSE
3565 IF (lback) THEN
3566 vect1: DO i = 1, SIZE(vect)
3567! DO j = i-1, 1, -1
3568! IF (vect(j) == vect(i)) CYCLE vect1
3569 DO j = count_distinct, 1, -1
3570 IF (pack_distinct(j) == vect(i)) cycle vect1
3571 ENDDO
3572 count_distinct = count_distinct + 1
3573 IF (count_distinct > dim) EXIT
3574 pack_distinct(count_distinct) = vect(i)
3575 ENDDO vect1
3576 ELSE
3577 vect2: DO i = 1, SIZE(vect)
3578! DO j = 1, i-1
3579! IF (vect(j) == vect(i)) CYCLE vect2
3580 DO j = 1, count_distinct
3581 IF (pack_distinct(j) == vect(i)) cycle vect2
3582 ENDDO
3583 count_distinct = count_distinct + 1
3584 IF (count_distinct > dim) EXIT
3585 pack_distinct(count_distinct) = vect(i)
3586 ENDDO vect2
3587 ENDIF
3588ENDIF
3589
3590END SUBROUTINE pack_distinct_c
3591
3593FUNCTION map(mask) RESULT(mapidx)
3594LOGICAL,INTENT(in) :: mask(:)
3595INTEGER :: mapidx(count(mask))
3596
3597INTEGER :: i,j
3598
3599j = 0
3600DO i=1, SIZE(mask)
3601 j = j + 1
3602 IF (mask(i)) mapidx(j)=i
3603ENDDO
3604
3605END FUNCTION map
3606
3607#define ARRAYOF_ORIGEQ 1
3608
3609#undef ARRAYOF_ORIGTYPE
3610#undef ARRAYOF_TYPE
3611#define ARRAYOF_ORIGTYPE INTEGER
3612#define ARRAYOF_TYPE arrayof_integer
3613#include "arrayof_post.F90"
3614
3615#undef ARRAYOF_ORIGTYPE
3616#undef ARRAYOF_TYPE
3617#define ARRAYOF_ORIGTYPE REAL
3618#define ARRAYOF_TYPE arrayof_real
3619#include "arrayof_post.F90"
3620
3621#undef ARRAYOF_ORIGTYPE
3622#undef ARRAYOF_TYPE
3623#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
3624#define ARRAYOF_TYPE arrayof_doubleprecision
3625#include "arrayof_post.F90"
3626
3627#undef ARRAYOF_ORIGEQ
3628
3629#undef ARRAYOF_ORIGTYPE
3630#undef ARRAYOF_TYPE
3631#define ARRAYOF_ORIGTYPE LOGICAL
3632#define ARRAYOF_TYPE arrayof_logical
3633#include "arrayof_post.F90"
3634
Quick method to append an element to the array. Definition: array_utilities.F90:514 Destructor for finalizing an array object. Definition: array_utilities.F90:527 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:505 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:537 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:520 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:218 |