libsim Versione 7.1.11
|
◆ arrayof_vol7d_timerange_packarray()
Method for packing the array object reducing at a minimum the memory occupation, without destroying its contents. The value of this::overalloc remains unchanged. After the call to the method, the object can continue to be used, extended and shortened as before. If the object is empty the array is allocated to zero length.
Definizione alla linea 2109 del file vol7d_timerange_class.F90. 2110! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2111! authors:
2112! Davide Cesari <dcesari@arpa.emr.it>
2113! Paolo Patruno <ppatruno@arpa.emr.it>
2114
2115! This program is free software; you can redistribute it and/or
2116! modify it under the terms of the GNU General Public License as
2117! published by the Free Software Foundation; either version 2 of
2118! the License, or (at your option) any later version.
2119
2120! This program is distributed in the hope that it will be useful,
2121! but WITHOUT ANY WARRANTY; without even the implied warranty of
2122! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2123! GNU General Public License for more details.
2124
2125! You should have received a copy of the GNU General Public License
2126! along with this program. If not, see <http://www.gnu.org/licenses/>.
2127#include "config.h"
2128
2140IMPLICIT NONE
2141
2147 INTEGER :: timerange
2148 INTEGER :: p1
2149 INTEGER :: p2
2151
2153TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
2154 vol7d_timerange(imiss,imiss,imiss)
2155
2160 MODULE PROCEDURE vol7d_timerange_init
2161END INTERFACE
2162
2166 MODULE PROCEDURE vol7d_timerange_delete
2167END INTERFACE
2168
2172INTERFACE OPERATOR (==)
2173 MODULE PROCEDURE vol7d_timerange_eq
2174END INTERFACE
2175
2179INTERFACE OPERATOR (/=)
2180 MODULE PROCEDURE vol7d_timerange_ne
2181END INTERFACE
2182
2186INTERFACE OPERATOR (>)
2187 MODULE PROCEDURE vol7d_timerange_gt
2188END INTERFACE
2189
2193INTERFACE OPERATOR (<)
2194 MODULE PROCEDURE vol7d_timerange_lt
2195END INTERFACE
2196
2200INTERFACE OPERATOR (>=)
2201 MODULE PROCEDURE vol7d_timerange_ge
2202END INTERFACE
2203
2207INTERFACE OPERATOR (<=)
2208 MODULE PROCEDURE vol7d_timerange_le
2209END INTERFACE
2210
2213INTERFACE OPERATOR (.almosteq.)
2214 MODULE PROCEDURE vol7d_timerange_almost_eq
2215END INTERFACE
2216
2217
2218! da documentare in inglese assieme al resto
2221 MODULE PROCEDURE vol7d_timerange_c_e
2222END INTERFACE
2223
2224#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
2225#define VOL7D_POLY_TYPES _timerange
2226#define ENABLE_SORT
2227#include "array_utilities_pre.F90"
2228
2231 MODULE PROCEDURE display_timerange
2232END INTERFACE
2233
2236 MODULE PROCEDURE to_char_timerange
2237END INTERFACE
2238
2239#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
2240#define ARRAYOF_TYPE arrayof_vol7d_timerange
2241#define ARRAYOF_ORIGEQ 1
2242#include "arrayof_pre.F90"
2243
2244
2245type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
2246 vol7d_timerange(254,0,imiss),&
2247 vol7d_timerange(3,0,3600)/)
2248
2249
2250! from arrayof
2252PUBLIC insert_unique, append_unique
2253PUBLIC almost_equal_timeranges
2254
2255CONTAINS
2256
2257
2263FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
2264INTEGER,INTENT(IN),OPTIONAL :: timerange
2265INTEGER,INTENT(IN),OPTIONAL :: p1
2266INTEGER,INTENT(IN),OPTIONAL :: p2
2267
2268TYPE(vol7d_timerange) :: this
2269
2271
2272END FUNCTION vol7d_timerange_new
2273
2274
2278SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
2279TYPE(vol7d_timerange),INTENT(INOUT) :: this
2280INTEGER,INTENT(IN),OPTIONAL :: timerange
2281INTEGER,INTENT(IN),OPTIONAL :: p1
2282INTEGER,INTENT(IN),OPTIONAL :: p2
2283
2284IF (PRESENT(timerange)) THEN
2285 this%timerange = timerange
2286ELSE
2287 this%timerange = imiss
2288 this%p1 = imiss
2289 this%p2 = imiss
2290 RETURN
2291ENDIF
2292!!$IF (timerange == 1) THEN ! p1 sempre 0
2293!!$ this%p1 = 0
2294!!$ this%p2 = imiss
2295!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
2296!!$ IF (PRESENT(p1)) THEN
2297!!$ this%p1 = p1
2298!!$ ELSE
2299!!$ this%p1 = 0
2300!!$ ENDIF
2301!!$ this%p2 = imiss
2302!!$ELSE ! tutti gli altri
2303 IF (PRESENT(p1)) THEN
2304 this%p1 = p1
2305 ELSE
2306 this%p1 = imiss
2307 ENDIF
2308 IF (PRESENT(p2)) THEN
2309 this%p2 = p2
2310 ELSE
2311 this%p2 = imiss
2312 ENDIF
2313!!$END IF
2314
2315END SUBROUTINE vol7d_timerange_init
2316
2317
2319SUBROUTINE vol7d_timerange_delete(this)
2320TYPE(vol7d_timerange),INTENT(INOUT) :: this
2321
2322this%timerange = imiss
2323this%p1 = imiss
2324this%p2 = imiss
2325
2326END SUBROUTINE vol7d_timerange_delete
2327
2328
2329SUBROUTINE display_timerange(this)
2330TYPE(vol7d_timerange),INTENT(in) :: this
2331
2332print*,to_char_timerange(this)
2333
2334END SUBROUTINE display_timerange
2335
2336
2337FUNCTION to_char_timerange(this)
2338#ifdef HAVE_DBALLE
2339USE dballef
2340#endif
2341TYPE(vol7d_timerange),INTENT(in) :: this
2342CHARACTER(len=80) :: to_char_timerange
2343
2344#ifdef HAVE_DBALLE
2345INTEGER :: handle, ier
2346
2347handle = 0
2348ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
2349ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
2350ier = idba_fatto(handle)
2351
2352to_char_timerange="Timerange: "//to_char_timerange
2353
2354#else
2355
2358
2359#endif
2360
2361END FUNCTION to_char_timerange
2362
2363
2364ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
2365TYPE(vol7d_timerange),INTENT(IN) :: this, that
2366LOGICAL :: res
2367
2368
2369res = &
2370 this%timerange == that%timerange .AND. &
2371 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
2372 this%timerange == 254)
2373
2374END FUNCTION vol7d_timerange_eq
2375
2376
2377ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
2378TYPE(vol7d_timerange),INTENT(IN) :: this, that
2379LOGICAL :: res
2380
2381IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
2382 this%p1 == that%p1 .AND. &
2383 this%p2 == that%p2) THEN
2384 res = .true.
2385ELSE
2386 res = .false.
2387ENDIF
2388
2389END FUNCTION vol7d_timerange_almost_eq
2390
2391
2392ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
2393TYPE(vol7d_timerange),INTENT(IN) :: this, that
2394LOGICAL :: res
2395
2396res = .NOT.(this == that)
2397
2398END FUNCTION vol7d_timerange_ne
2399
2400
2401ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
2402TYPE(vol7d_timerange),INTENT(IN) :: this, that
2403LOGICAL :: res
2404
2405IF (this%timerange > that%timerange .OR. &
2406 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
2407 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2408 this%p2 > that%p2)) THEN
2409 res = .true.
2410ELSE
2411 res = .false.
2412ENDIF
2413
2414END FUNCTION vol7d_timerange_gt
2415
2416
2417ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
2418TYPE(vol7d_timerange),INTENT(IN) :: this, that
2419LOGICAL :: res
2420
2421IF (this%timerange < that%timerange .OR. &
2422 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
2423 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2424 this%p2 < that%p2)) THEN
2425 res = .true.
2426ELSE
2427 res = .false.
2428ENDIF
2429
2430END FUNCTION vol7d_timerange_lt
2431
2432
2433ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
2434TYPE(vol7d_timerange),INTENT(IN) :: this, that
2435LOGICAL :: res
2436
2437IF (this == that) THEN
2438 res = .true.
2439ELSE IF (this > that) THEN
2440 res = .true.
2441ELSE
2442 res = .false.
2443ENDIF
2444
2445END FUNCTION vol7d_timerange_ge
2446
2447
2448ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
2449TYPE(vol7d_timerange),INTENT(IN) :: this, that
2450LOGICAL :: res
2451
2452IF (this == that) THEN
2453 res = .true.
2454ELSE IF (this < that) THEN
2455 res = .true.
2456ELSE
2457 res = .false.
2458ENDIF
2459
2460END FUNCTION vol7d_timerange_le
2461
2462
2463ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
2464TYPE(vol7d_timerange),INTENT(IN) :: this
2465LOGICAL :: c_e
2466c_e = this /= vol7d_timerange_miss
2467END FUNCTION vol7d_timerange_c_e
2468
2469
2470#include "array_utilities_inc.F90"
2471
2472#include "arrayof_post.F90"
2473
2474
Quick method to append an element to the array. Definition: vol7d_timerange_class.F90:431 Distruttore per la classe vol7d_timerange. Definition: vol7d_timerange_class.F90:250 Costruttore per la classe vol7d_timerange. Definition: vol7d_timerange_class.F90:244 Method for inserting elements of the array at a desired position. Definition: vol7d_timerange_class.F90:422 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: vol7d_timerange_class.F90:454 Method for removing elements of the array at a desired position. Definition: vol7d_timerange_class.F90:437 Represent timerange object in a pretty string. Definition: vol7d_timerange_class.F90:375 Definition of constants to be used for declaring variables of a desired type. Definition: kinds.F90:251 Definitions of constants and functions for working with missing values. Definition: missing_values.f90:50 Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. Definition: vol7d_timerange_class.F90:221 Definisce l'intervallo temporale di un'osservazione meteo. Definition: vol7d_timerange_class.F90:231 |