libsim Versione 7.2.1

◆ map_distinct_r()

integer function, dimension(size(vect)) map_distinct_r ( real, dimension(:), intent(in) vect,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back )
private

map distinct

Definizione alla linea 2434 del file array_utilities.F90.

2435! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2436! authors:
2437! Davide Cesari <dcesari@arpa.emr.it>
2438! Paolo Patruno <ppatruno@arpa.emr.it>
2439
2440! This program is free software; you can redistribute it and/or
2441! modify it under the terms of the GNU General Public License as
2442! published by the Free Software Foundation; either version 2 of
2443! the License, or (at your option) any later version.
2444
2445! This program is distributed in the hope that it will be useful,
2446! but WITHOUT ANY WARRANTY; without even the implied warranty of
2447! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2448! GNU General Public License for more details.
2449
2450! You should have received a copy of the GNU General Public License
2451! along with this program. If not, see <http://www.gnu.org/licenses/>.
2452
2453
2454
2457#include "config.h"
2458MODULE array_utilities
2459
2460IMPLICIT NONE
2461
2462! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2463!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2464
2465#undef VOL7D_POLY_TYPE_AUTO
2466
2467#undef VOL7D_POLY_TYPE
2468#undef VOL7D_POLY_TYPES
2469#define VOL7D_POLY_TYPE INTEGER
2470#define VOL7D_POLY_TYPES _i
2471#define ENABLE_SORT
2472#include "array_utilities_pre.F90"
2473#undef ENABLE_SORT
2474
2475#undef VOL7D_POLY_TYPE
2476#undef VOL7D_POLY_TYPES
2477#define VOL7D_POLY_TYPE REAL
2478#define VOL7D_POLY_TYPES _r
2479#define ENABLE_SORT
2480#include "array_utilities_pre.F90"
2481#undef ENABLE_SORT
2482
2483#undef VOL7D_POLY_TYPE
2484#undef VOL7D_POLY_TYPES
2485#define VOL7D_POLY_TYPE DOUBLEPRECISION
2486#define VOL7D_POLY_TYPES _d
2487#define ENABLE_SORT
2488#include "array_utilities_pre.F90"
2489#undef ENABLE_SORT
2490
2491#define VOL7D_NO_PACK
2492#undef VOL7D_POLY_TYPE
2493#undef VOL7D_POLY_TYPES
2494#define VOL7D_POLY_TYPE CHARACTER(len=*)
2495#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2496#define VOL7D_POLY_TYPES _c
2497#define ENABLE_SORT
2498#include "array_utilities_pre.F90"
2499#undef VOL7D_POLY_TYPE_AUTO
2500#undef ENABLE_SORT
2501
2502
2503#define ARRAYOF_ORIGEQ 1
2504
2505#define ARRAYOF_ORIGTYPE INTEGER
2506#define ARRAYOF_TYPE arrayof_integer
2507#include "arrayof_pre.F90"
2508
2509#undef ARRAYOF_ORIGTYPE
2510#undef ARRAYOF_TYPE
2511#define ARRAYOF_ORIGTYPE REAL
2512#define ARRAYOF_TYPE arrayof_real
2513#include "arrayof_pre.F90"
2514
2515#undef ARRAYOF_ORIGTYPE
2516#undef ARRAYOF_TYPE
2517#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2518#define ARRAYOF_TYPE arrayof_doubleprecision
2519#include "arrayof_pre.F90"
2520
2521#undef ARRAYOF_ORIGEQ
2522
2523#undef ARRAYOF_ORIGTYPE
2524#undef ARRAYOF_TYPE
2525#define ARRAYOF_ORIGTYPE LOGICAL
2526#define ARRAYOF_TYPE arrayof_logical
2527#include "arrayof_pre.F90"
2528
2529PRIVATE
2530! from arrayof
2532PUBLIC insert_unique, append_unique
2533
2534PUBLIC sort, index, index_c, &
2535 count_distinct_sorted, pack_distinct_sorted, &
2536 count_distinct, pack_distinct, count_and_pack_distinct, &
2537 map_distinct, map_inv_distinct, &
2538 firsttrue, lasttrue, pack_distinct_c, map
2539
2540CONTAINS
2541
2542
2545FUNCTION firsttrue(v) RESULT(i)
2546LOGICAL,INTENT(in) :: v(:)
2547INTEGER :: i
2548
2549DO i = 1, SIZE(v)
2550 IF (v(i)) RETURN
2551ENDDO
2552i = 0
2553
2554END FUNCTION firsttrue
2555
2556
2559FUNCTION lasttrue(v) RESULT(i)
2560LOGICAL,INTENT(in) :: v(:)
2561INTEGER :: i
2562
2563DO i = SIZE(v), 1, -1
2564 IF (v(i)) RETURN
2565ENDDO
2566
2567END FUNCTION lasttrue
2568
2569
2570! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2571#undef VOL7D_POLY_TYPE_AUTO
2572#undef VOL7D_NO_PACK
2573
2574#undef VOL7D_POLY_TYPE
2575#undef VOL7D_POLY_TYPES
2576#define VOL7D_POLY_TYPE INTEGER
2577#define VOL7D_POLY_TYPES _i
2578#define ENABLE_SORT
2579#include "array_utilities_inc.F90"
2580#undef ENABLE_SORT
2581
2582#undef VOL7D_POLY_TYPE
2583#undef VOL7D_POLY_TYPES
2584#define VOL7D_POLY_TYPE REAL
2585#define VOL7D_POLY_TYPES _r
2586#define ENABLE_SORT
2587#include "array_utilities_inc.F90"
2588#undef ENABLE_SORT
2589
2590#undef VOL7D_POLY_TYPE
2591#undef VOL7D_POLY_TYPES
2592#define VOL7D_POLY_TYPE DOUBLEPRECISION
2593#define VOL7D_POLY_TYPES _d
2594#define ENABLE_SORT
2595#include "array_utilities_inc.F90"
2596#undef ENABLE_SORT
2597
2598#define VOL7D_NO_PACK
2599#undef VOL7D_POLY_TYPE
2600#undef VOL7D_POLY_TYPES
2601#define VOL7D_POLY_TYPE CHARACTER(len=*)
2602#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2603#define VOL7D_POLY_TYPES _c
2604#define ENABLE_SORT
2605#include "array_utilities_inc.F90"
2606#undef VOL7D_POLY_TYPE_AUTO
2607#undef ENABLE_SORT
2608
2609SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2610CHARACTER(len=*),INTENT(in) :: vect(:)
2611LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2612CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2613
2614INTEGER :: count_distinct
2615INTEGER :: i, j, dim
2616LOGICAL :: lback
2617
2618dim = SIZE(pack_distinct)
2619IF (PRESENT(back)) THEN
2620 lback = back
2621ELSE
2622 lback = .false.
2623ENDIF
2624count_distinct = 0
2625
2626IF (PRESENT (mask)) THEN
2627 IF (lback) THEN
2628 vectm1: DO i = 1, SIZE(vect)
2629 IF (.NOT.mask(i)) cycle vectm1
2630! DO j = i-1, 1, -1
2631! IF (vect(j) == vect(i)) CYCLE vectm1
2632 DO j = count_distinct, 1, -1
2633 IF (pack_distinct(j) == vect(i)) cycle vectm1
2634 ENDDO
2635 count_distinct = count_distinct + 1
2636 IF (count_distinct > dim) EXIT
2637 pack_distinct(count_distinct) = vect(i)
2638 ENDDO vectm1
2639 ELSE
2640 vectm2: DO i = 1, SIZE(vect)
2641 IF (.NOT.mask(i)) cycle vectm2
2642! DO j = 1, i-1
2643! IF (vect(j) == vect(i)) CYCLE vectm2
2644 DO j = 1, count_distinct
2645 IF (pack_distinct(j) == vect(i)) cycle vectm2
2646 ENDDO
2647 count_distinct = count_distinct + 1
2648 IF (count_distinct > dim) EXIT
2649 pack_distinct(count_distinct) = vect(i)
2650 ENDDO vectm2
2651 ENDIF
2652ELSE
2653 IF (lback) THEN
2654 vect1: DO i = 1, SIZE(vect)
2655! DO j = i-1, 1, -1
2656! IF (vect(j) == vect(i)) CYCLE vect1
2657 DO j = count_distinct, 1, -1
2658 IF (pack_distinct(j) == vect(i)) cycle vect1
2659 ENDDO
2660 count_distinct = count_distinct + 1
2661 IF (count_distinct > dim) EXIT
2662 pack_distinct(count_distinct) = vect(i)
2663 ENDDO vect1
2664 ELSE
2665 vect2: DO i = 1, SIZE(vect)
2666! DO j = 1, i-1
2667! IF (vect(j) == vect(i)) CYCLE vect2
2668 DO j = 1, count_distinct
2669 IF (pack_distinct(j) == vect(i)) cycle vect2
2670 ENDDO
2671 count_distinct = count_distinct + 1
2672 IF (count_distinct > dim) EXIT
2673 pack_distinct(count_distinct) = vect(i)
2674 ENDDO vect2
2675 ENDIF
2676ENDIF
2677
2678END SUBROUTINE pack_distinct_c
2679
2681FUNCTION map(mask) RESULT(mapidx)
2682LOGICAL,INTENT(in) :: mask(:)
2683INTEGER :: mapidx(count(mask))
2684
2685INTEGER :: i,j
2686
2687j = 0
2688DO i=1, SIZE(mask)
2689 j = j + 1
2690 IF (mask(i)) mapidx(j)=i
2691ENDDO
2692
2693END FUNCTION map
2694
2695#define ARRAYOF_ORIGEQ 1
2696
2697#undef ARRAYOF_ORIGTYPE
2698#undef ARRAYOF_TYPE
2699#define ARRAYOF_ORIGTYPE INTEGER
2700#define ARRAYOF_TYPE arrayof_integer
2701#include "arrayof_post.F90"
2702
2703#undef ARRAYOF_ORIGTYPE
2704#undef ARRAYOF_TYPE
2705#define ARRAYOF_ORIGTYPE REAL
2706#define ARRAYOF_TYPE arrayof_real
2707#include "arrayof_post.F90"
2708
2709#undef ARRAYOF_ORIGTYPE
2710#undef ARRAYOF_TYPE
2711#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2712#define ARRAYOF_TYPE arrayof_doubleprecision
2713#include "arrayof_post.F90"
2714
2715#undef ARRAYOF_ORIGEQ
2716
2717#undef ARRAYOF_ORIGTYPE
2718#undef ARRAYOF_TYPE
2719#define ARRAYOF_ORIGTYPE LOGICAL
2720#define ARRAYOF_TYPE arrayof_logical
2721#include "arrayof_post.F90"
2722
2723END 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.