libsim Versione 7.2.6
|
◆ count_distinct_r()
conta gli elementi distinti in vect Definizione alla linea 2175 del file array_utilities.F90. 2176! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2177! authors:
2178! Davide Cesari <dcesari@arpa.emr.it>
2179! Paolo Patruno <ppatruno@arpa.emr.it>
2180
2181! This program is free software; you can redistribute it and/or
2182! modify it under the terms of the GNU General Public License as
2183! published by the Free Software Foundation; either version 2 of
2184! the License, or (at your option) any later version.
2185
2186! This program is distributed in the hope that it will be useful,
2187! but WITHOUT ANY WARRANTY; without even the implied warranty of
2188! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2189! GNU General Public License for more details.
2190
2191! You should have received a copy of the GNU General Public License
2192! along with this program. If not, see <http://www.gnu.org/licenses/>.
2193
2194
2195
2196!> This module defines usefull general purpose function and subroutine
2197!!\ingroup base
2198#include "config.h"
2200
2201IMPLICIT NONE
2202
2203! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2204!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2205
2206#undef VOL7D_POLY_TYPE_AUTO
2207
2208#undef VOL7D_POLY_TYPE
2209#undef VOL7D_POLY_TYPES
2210#define VOL7D_POLY_TYPE INTEGER
2211#define VOL7D_POLY_TYPES _i
2212#define ENABLE_SORT
2213#include "array_utilities_pre.F90"
2214#undef ENABLE_SORT
2215
2216#undef VOL7D_POLY_TYPE
2217#undef VOL7D_POLY_TYPES
2218#define VOL7D_POLY_TYPE REAL
2219#define VOL7D_POLY_TYPES _r
2220#define ENABLE_SORT
2221#include "array_utilities_pre.F90"
2222#undef ENABLE_SORT
2223
2224#undef VOL7D_POLY_TYPE
2225#undef VOL7D_POLY_TYPES
2226#define VOL7D_POLY_TYPE DOUBLEPRECISION
2227#define VOL7D_POLY_TYPES _d
2228#define ENABLE_SORT
2229#include "array_utilities_pre.F90"
2230#undef ENABLE_SORT
2231
2232#define VOL7D_NO_PACK
2233#undef VOL7D_POLY_TYPE
2234#undef VOL7D_POLY_TYPES
2235#define VOL7D_POLY_TYPE CHARACTER(len=*)
2236#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2237#define VOL7D_POLY_TYPES _c
2238#define ENABLE_SORT
2239#include "array_utilities_pre.F90"
2240#undef VOL7D_POLY_TYPE_AUTO
2241#undef ENABLE_SORT
2242
2243
2244#define ARRAYOF_ORIGEQ 1
2245
2246#define ARRAYOF_ORIGTYPE INTEGER
2247#define ARRAYOF_TYPE arrayof_integer
2248#include "arrayof_pre.F90"
2249
2250#undef ARRAYOF_ORIGTYPE
2251#undef ARRAYOF_TYPE
2252#define ARRAYOF_ORIGTYPE REAL
2253#define ARRAYOF_TYPE arrayof_real
2254#include "arrayof_pre.F90"
2255
2256#undef ARRAYOF_ORIGTYPE
2257#undef ARRAYOF_TYPE
2258#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2259#define ARRAYOF_TYPE arrayof_doubleprecision
2260#include "arrayof_pre.F90"
2261
2262#undef ARRAYOF_ORIGEQ
2263
2264#undef ARRAYOF_ORIGTYPE
2265#undef ARRAYOF_TYPE
2266#define ARRAYOF_ORIGTYPE LOGICAL
2267#define ARRAYOF_TYPE arrayof_logical
2268#include "arrayof_pre.F90"
2269
2270PRIVATE
2271! from arrayof
2273PUBLIC insert_unique, append_unique
2274
2276 count_distinct_sorted, pack_distinct_sorted, &
2277 count_distinct, pack_distinct, count_and_pack_distinct, &
2278 map_distinct, map_inv_distinct, &
2279 firsttrue, lasttrue, pack_distinct_c, map
2280
2281CONTAINS
2282
2283
2284!> Return the index ot the first true element of the input logical array \a v.
2285!! If no \c .TRUE. elements are found, it returns 0.
2286FUNCTION firsttrue(v) RESULT(i)
2287LOGICAL,INTENT(in) :: v(:) !< logical array to test
2288INTEGER :: i
2289
2290DO i = 1, SIZE(v)
2291 IF (v(i)) RETURN
2292ENDDO
2293i = 0
2294
2295END FUNCTION firsttrue
2296
2297
2298!> Return the index ot the last true element of the input logical array \a v.
2299!! If no \c .TRUE. elements are found, it returns 0.
2300FUNCTION lasttrue(v) RESULT(i)
2301LOGICAL,INTENT(in) :: v(:) !< logical array to test
2302INTEGER :: i
2303
2304DO i = SIZE(v), 1, -1
2305 IF (v(i)) RETURN
2306ENDDO
2307
2308END FUNCTION lasttrue
2309
2310
2311! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2312#undef VOL7D_POLY_TYPE_AUTO
2313#undef VOL7D_NO_PACK
2314
2315#undef VOL7D_POLY_TYPE
2316#undef VOL7D_POLY_TYPES
2317#define VOL7D_POLY_TYPE INTEGER
2318#define VOL7D_POLY_TYPES _i
2319#define ENABLE_SORT
2320#include "array_utilities_inc.F90"
2321#undef ENABLE_SORT
2322
2323#undef VOL7D_POLY_TYPE
2324#undef VOL7D_POLY_TYPES
2325#define VOL7D_POLY_TYPE REAL
2326#define VOL7D_POLY_TYPES _r
2327#define ENABLE_SORT
2328#include "array_utilities_inc.F90"
2329#undef ENABLE_SORT
2330
2331#undef VOL7D_POLY_TYPE
2332#undef VOL7D_POLY_TYPES
2333#define VOL7D_POLY_TYPE DOUBLEPRECISION
2334#define VOL7D_POLY_TYPES _d
2335#define ENABLE_SORT
2336#include "array_utilities_inc.F90"
2337#undef ENABLE_SORT
2338
2339#define VOL7D_NO_PACK
2340#undef VOL7D_POLY_TYPE
2341#undef VOL7D_POLY_TYPES
2342#define VOL7D_POLY_TYPE CHARACTER(len=*)
2343#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2344#define VOL7D_POLY_TYPES _c
2345#define ENABLE_SORT
2346#include "array_utilities_inc.F90"
2347#undef VOL7D_POLY_TYPE_AUTO
2348#undef ENABLE_SORT
2349
2350SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2351CHARACTER(len=*),INTENT(in) :: vect(:)
2352LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2353CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2354
2355INTEGER :: count_distinct
2356INTEGER :: i, j, dim
2357LOGICAL :: lback
2358
2359dim = SIZE(pack_distinct)
2360IF (PRESENT(back)) THEN
2361 lback = back
2362ELSE
2363 lback = .false.
2364ENDIF
2365count_distinct = 0
2366
2367IF (PRESENT (mask)) THEN
2368 IF (lback) THEN
2369 vectm1: DO i = 1, SIZE(vect)
2370 IF (.NOT.mask(i)) cycle vectm1
2371! DO j = i-1, 1, -1
2372! IF (vect(j) == vect(i)) CYCLE vectm1
2373 DO j = count_distinct, 1, -1
2374 IF (pack_distinct(j) == vect(i)) cycle vectm1
2375 ENDDO
2376 count_distinct = count_distinct + 1
2377 IF (count_distinct > dim) EXIT
2378 pack_distinct(count_distinct) = vect(i)
2379 ENDDO vectm1
2380 ELSE
2381 vectm2: DO i = 1, SIZE(vect)
2382 IF (.NOT.mask(i)) cycle vectm2
2383! DO j = 1, i-1
2384! IF (vect(j) == vect(i)) CYCLE vectm2
2385 DO j = 1, count_distinct
2386 IF (pack_distinct(j) == vect(i)) cycle vectm2
2387 ENDDO
2388 count_distinct = count_distinct + 1
2389 IF (count_distinct > dim) EXIT
2390 pack_distinct(count_distinct) = vect(i)
2391 ENDDO vectm2
2392 ENDIF
2393ELSE
2394 IF (lback) THEN
2395 vect1: DO i = 1, SIZE(vect)
2396! DO j = i-1, 1, -1
2397! IF (vect(j) == vect(i)) CYCLE vect1
2398 DO j = count_distinct, 1, -1
2399 IF (pack_distinct(j) == vect(i)) cycle vect1
2400 ENDDO
2401 count_distinct = count_distinct + 1
2402 IF (count_distinct > dim) EXIT
2403 pack_distinct(count_distinct) = vect(i)
2404 ENDDO vect1
2405 ELSE
2406 vect2: DO i = 1, SIZE(vect)
2407! DO j = 1, i-1
2408! IF (vect(j) == vect(i)) CYCLE vect2
2409 DO j = 1, count_distinct
2410 IF (pack_distinct(j) == vect(i)) cycle vect2
2411 ENDDO
2412 count_distinct = count_distinct + 1
2413 IF (count_distinct > dim) EXIT
2414 pack_distinct(count_distinct) = vect(i)
2415 ENDDO vect2
2416 ENDIF
2417ENDIF
2418
2419END SUBROUTINE pack_distinct_c
2420
2421!> Return the index of the array only where the mask is true
2422FUNCTION map(mask) RESULT(mapidx)
2423LOGICAL,INTENT(in) :: mask(:)
2424INTEGER :: mapidx(count(mask))
2425
2426INTEGER :: i,j
2427
2428j = 0
2429DO i=1, SIZE(mask)
2430 j = j + 1
2431 IF (mask(i)) mapidx(j)=i
2432ENDDO
2433
2434END FUNCTION map
2435
2436#define ARRAYOF_ORIGEQ 1
2437
2438#undef ARRAYOF_ORIGTYPE
2439#undef ARRAYOF_TYPE
2440#define ARRAYOF_ORIGTYPE INTEGER
2441#define ARRAYOF_TYPE arrayof_integer
2442#include "arrayof_post.F90"
2443
2444#undef ARRAYOF_ORIGTYPE
2445#undef ARRAYOF_TYPE
2446#define ARRAYOF_ORIGTYPE REAL
2447#define ARRAYOF_TYPE arrayof_real
2448#include "arrayof_post.F90"
2449
2450#undef ARRAYOF_ORIGTYPE
2451#undef ARRAYOF_TYPE
2452#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2453#define ARRAYOF_TYPE arrayof_doubleprecision
2454#include "arrayof_post.F90"
2455
2456#undef ARRAYOF_ORIGEQ
2457
2458#undef ARRAYOF_ORIGTYPE
2459#undef ARRAYOF_TYPE
2460#define ARRAYOF_ORIGTYPE LOGICAL
2461#define ARRAYOF_TYPE arrayof_logical
2462#include "arrayof_post.F90"
2463
Quick method to append an element to the array. Definition array_utilities.F90:508 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 |