libsim Versione 7.2.0

◆ count_distinct_sorted_r()

integer function count_distinct_sorted_r ( real, dimension(:), intent(in)  vect,
logical, dimension(:), intent(in), optional  mask 
)
private

conta gli elementi distinti in un sorted array

Definizione alla linea 2141 del file array_utilities.F90.

2142! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2143! authors:
2144! Davide Cesari <dcesari@arpa.emr.it>
2145! Paolo Patruno <ppatruno@arpa.emr.it>
2146
2147! This program is free software; you can redistribute it and/or
2148! modify it under the terms of the GNU General Public License as
2149! published by the Free Software Foundation; either version 2 of
2150! the License, or (at your option) any later version.
2151
2152! This program is distributed in the hope that it will be useful,
2153! but WITHOUT ANY WARRANTY; without even the implied warranty of
2154! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2155! GNU General Public License for more details.
2156
2157! You should have received a copy of the GNU General Public License
2158! along with this program. If not, see <http://www.gnu.org/licenses/>.
2159
2160
2161
2164#include "config.h"
2165MODULE array_utilities
2166
2167IMPLICIT NONE
2168
2169! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
2170!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
2171
2172#undef VOL7D_POLY_TYPE_AUTO
2173
2174#undef VOL7D_POLY_TYPE
2175#undef VOL7D_POLY_TYPES
2176#define VOL7D_POLY_TYPE INTEGER
2177#define VOL7D_POLY_TYPES _i
2178#define ENABLE_SORT
2179#include "array_utilities_pre.F90"
2180#undef ENABLE_SORT
2181
2182#undef VOL7D_POLY_TYPE
2183#undef VOL7D_POLY_TYPES
2184#define VOL7D_POLY_TYPE REAL
2185#define VOL7D_POLY_TYPES _r
2186#define ENABLE_SORT
2187#include "array_utilities_pre.F90"
2188#undef ENABLE_SORT
2189
2190#undef VOL7D_POLY_TYPE
2191#undef VOL7D_POLY_TYPES
2192#define VOL7D_POLY_TYPE DOUBLEPRECISION
2193#define VOL7D_POLY_TYPES _d
2194#define ENABLE_SORT
2195#include "array_utilities_pre.F90"
2196#undef ENABLE_SORT
2197
2198#define VOL7D_NO_PACK
2199#undef VOL7D_POLY_TYPE
2200#undef VOL7D_POLY_TYPES
2201#define VOL7D_POLY_TYPE CHARACTER(len=*)
2202#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2203#define VOL7D_POLY_TYPES _c
2204#define ENABLE_SORT
2205#include "array_utilities_pre.F90"
2206#undef VOL7D_POLY_TYPE_AUTO
2207#undef ENABLE_SORT
2208
2209
2210#define ARRAYOF_ORIGEQ 1
2211
2212#define ARRAYOF_ORIGTYPE INTEGER
2213#define ARRAYOF_TYPE arrayof_integer
2214#include "arrayof_pre.F90"
2215
2216#undef ARRAYOF_ORIGTYPE
2217#undef ARRAYOF_TYPE
2218#define ARRAYOF_ORIGTYPE REAL
2219#define ARRAYOF_TYPE arrayof_real
2220#include "arrayof_pre.F90"
2221
2222#undef ARRAYOF_ORIGTYPE
2223#undef ARRAYOF_TYPE
2224#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2225#define ARRAYOF_TYPE arrayof_doubleprecision
2226#include "arrayof_pre.F90"
2227
2228#undef ARRAYOF_ORIGEQ
2229
2230#undef ARRAYOF_ORIGTYPE
2231#undef ARRAYOF_TYPE
2232#define ARRAYOF_ORIGTYPE LOGICAL
2233#define ARRAYOF_TYPE arrayof_logical
2234#include "arrayof_pre.F90"
2235
2236PRIVATE
2237! from arrayof
2239PUBLIC insert_unique, append_unique
2240
2241PUBLIC sort, index, index_c, &
2242 count_distinct_sorted, pack_distinct_sorted, &
2243 count_distinct, pack_distinct, count_and_pack_distinct, &
2244 map_distinct, map_inv_distinct, &
2245 firsttrue, lasttrue, pack_distinct_c, map
2246
2247CONTAINS
2248
2249
2252FUNCTION firsttrue(v) RESULT(i)
2253LOGICAL,INTENT(in) :: v(:)
2254INTEGER :: i
2255
2256DO i = 1, SIZE(v)
2257 IF (v(i)) RETURN
2258ENDDO
2259i = 0
2260
2261END FUNCTION firsttrue
2262
2263
2266FUNCTION lasttrue(v) RESULT(i)
2267LOGICAL,INTENT(in) :: v(:)
2268INTEGER :: i
2269
2270DO i = SIZE(v), 1, -1
2271 IF (v(i)) RETURN
2272ENDDO
2273
2274END FUNCTION lasttrue
2275
2276
2277! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
2278#undef VOL7D_POLY_TYPE_AUTO
2279#undef VOL7D_NO_PACK
2280
2281#undef VOL7D_POLY_TYPE
2282#undef VOL7D_POLY_TYPES
2283#define VOL7D_POLY_TYPE INTEGER
2284#define VOL7D_POLY_TYPES _i
2285#define ENABLE_SORT
2286#include "array_utilities_inc.F90"
2287#undef ENABLE_SORT
2288
2289#undef VOL7D_POLY_TYPE
2290#undef VOL7D_POLY_TYPES
2291#define VOL7D_POLY_TYPE REAL
2292#define VOL7D_POLY_TYPES _r
2293#define ENABLE_SORT
2294#include "array_utilities_inc.F90"
2295#undef ENABLE_SORT
2296
2297#undef VOL7D_POLY_TYPE
2298#undef VOL7D_POLY_TYPES
2299#define VOL7D_POLY_TYPE DOUBLEPRECISION
2300#define VOL7D_POLY_TYPES _d
2301#define ENABLE_SORT
2302#include "array_utilities_inc.F90"
2303#undef ENABLE_SORT
2304
2305#define VOL7D_NO_PACK
2306#undef VOL7D_POLY_TYPE
2307#undef VOL7D_POLY_TYPES
2308#define VOL7D_POLY_TYPE CHARACTER(len=*)
2309#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
2310#define VOL7D_POLY_TYPES _c
2311#define ENABLE_SORT
2312#include "array_utilities_inc.F90"
2313#undef VOL7D_POLY_TYPE_AUTO
2314#undef ENABLE_SORT
2315
2316SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
2317CHARACTER(len=*),INTENT(in) :: vect(:)
2318LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
2319CHARACTER(len=LEN(vect)) :: pack_distinct(:)
2320
2321INTEGER :: count_distinct
2322INTEGER :: i, j, dim
2323LOGICAL :: lback
2324
2325dim = SIZE(pack_distinct)
2326IF (PRESENT(back)) THEN
2327 lback = back
2328ELSE
2329 lback = .false.
2330ENDIF
2331count_distinct = 0
2332
2333IF (PRESENT (mask)) THEN
2334 IF (lback) THEN
2335 vectm1: DO i = 1, SIZE(vect)
2336 IF (.NOT.mask(i)) cycle vectm1
2337! DO j = i-1, 1, -1
2338! IF (vect(j) == vect(i)) CYCLE vectm1
2339 DO j = count_distinct, 1, -1
2340 IF (pack_distinct(j) == vect(i)) cycle vectm1
2341 ENDDO
2342 count_distinct = count_distinct + 1
2343 IF (count_distinct > dim) EXIT
2344 pack_distinct(count_distinct) = vect(i)
2345 ENDDO vectm1
2346 ELSE
2347 vectm2: DO i = 1, SIZE(vect)
2348 IF (.NOT.mask(i)) cycle vectm2
2349! DO j = 1, i-1
2350! IF (vect(j) == vect(i)) CYCLE vectm2
2351 DO j = 1, count_distinct
2352 IF (pack_distinct(j) == vect(i)) cycle vectm2
2353 ENDDO
2354 count_distinct = count_distinct + 1
2355 IF (count_distinct > dim) EXIT
2356 pack_distinct(count_distinct) = vect(i)
2357 ENDDO vectm2
2358 ENDIF
2359ELSE
2360 IF (lback) THEN
2361 vect1: DO i = 1, SIZE(vect)
2362! DO j = i-1, 1, -1
2363! IF (vect(j) == vect(i)) CYCLE vect1
2364 DO j = count_distinct, 1, -1
2365 IF (pack_distinct(j) == vect(i)) cycle vect1
2366 ENDDO
2367 count_distinct = count_distinct + 1
2368 IF (count_distinct > dim) EXIT
2369 pack_distinct(count_distinct) = vect(i)
2370 ENDDO vect1
2371 ELSE
2372 vect2: DO i = 1, SIZE(vect)
2373! DO j = 1, i-1
2374! IF (vect(j) == vect(i)) CYCLE vect2
2375 DO j = 1, count_distinct
2376 IF (pack_distinct(j) == vect(i)) cycle vect2
2377 ENDDO
2378 count_distinct = count_distinct + 1
2379 IF (count_distinct > dim) EXIT
2380 pack_distinct(count_distinct) = vect(i)
2381 ENDDO vect2
2382 ENDIF
2383ENDIF
2384
2385END SUBROUTINE pack_distinct_c
2386
2388FUNCTION map(mask) RESULT(mapidx)
2389LOGICAL,INTENT(in) :: mask(:)
2390INTEGER :: mapidx(count(mask))
2391
2392INTEGER :: i,j
2393
2394j = 0
2395DO i=1, SIZE(mask)
2396 j = j + 1
2397 IF (mask(i)) mapidx(j)=i
2398ENDDO
2399
2400END FUNCTION map
2401
2402#define ARRAYOF_ORIGEQ 1
2403
2404#undef ARRAYOF_ORIGTYPE
2405#undef ARRAYOF_TYPE
2406#define ARRAYOF_ORIGTYPE INTEGER
2407#define ARRAYOF_TYPE arrayof_integer
2408#include "arrayof_post.F90"
2409
2410#undef ARRAYOF_ORIGTYPE
2411#undef ARRAYOF_TYPE
2412#define ARRAYOF_ORIGTYPE REAL
2413#define ARRAYOF_TYPE arrayof_real
2414#include "arrayof_post.F90"
2415
2416#undef ARRAYOF_ORIGTYPE
2417#undef ARRAYOF_TYPE
2418#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
2419#define ARRAYOF_TYPE arrayof_doubleprecision
2420#include "arrayof_post.F90"
2421
2422#undef ARRAYOF_ORIGEQ
2423
2424#undef ARRAYOF_ORIGTYPE
2425#undef ARRAYOF_TYPE
2426#define ARRAYOF_ORIGTYPE LOGICAL
2427#define ARRAYOF_TYPE arrayof_logical
2428#include "arrayof_post.F90"
2429
2430END 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.