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