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