libsim Versione 7.2.0

◆ arrayof_vol7d_timerange_packarray()

subroutine arrayof_vol7d_timerange_packarray ( type(arrayof_vol7d_timerange this)

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.

Parametri
thisobject to be packed

Definizione alla linea 2103 del file vol7d_timerange_class.F90.

2104! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2105! authors:
2106! Davide Cesari <dcesari@arpa.emr.it>
2107! Paolo Patruno <ppatruno@arpa.emr.it>
2108
2109! This program is free software; you can redistribute it and/or
2110! modify it under the terms of the GNU General Public License as
2111! published by the Free Software Foundation; either version 2 of
2112! the License, or (at your option) any later version.
2113
2114! This program is distributed in the hope that it will be useful,
2115! but WITHOUT ANY WARRANTY; without even the implied warranty of
2116! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2117! GNU General Public License for more details.
2118
2119! You should have received a copy of the GNU General Public License
2120! along with this program. If not, see <http://www.gnu.org/licenses/>.
2121#include "config.h"
2122
2131USE kinds
2134IMPLICIT NONE
2135
2140TYPE vol7d_timerange
2141 INTEGER :: timerange
2142 INTEGER :: p1
2143 INTEGER :: p2
2144END TYPE vol7d_timerange
2145
2147TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
2148 vol7d_timerange(imiss,imiss,imiss)
2149
2153INTERFACE init
2154 MODULE PROCEDURE vol7d_timerange_init
2155END INTERFACE
2156
2159INTERFACE delete
2160 MODULE PROCEDURE vol7d_timerange_delete
2161END INTERFACE
2162
2166INTERFACE OPERATOR (==)
2167 MODULE PROCEDURE vol7d_timerange_eq
2168END INTERFACE
2169
2173INTERFACE OPERATOR (/=)
2174 MODULE PROCEDURE vol7d_timerange_ne
2175END INTERFACE
2176
2180INTERFACE OPERATOR (>)
2181 MODULE PROCEDURE vol7d_timerange_gt
2182END INTERFACE
2183
2187INTERFACE OPERATOR (<)
2188 MODULE PROCEDURE vol7d_timerange_lt
2189END INTERFACE
2190
2194INTERFACE OPERATOR (>=)
2195 MODULE PROCEDURE vol7d_timerange_ge
2196END INTERFACE
2197
2201INTERFACE OPERATOR (<=)
2202 MODULE PROCEDURE vol7d_timerange_le
2203END INTERFACE
2204
2207INTERFACE OPERATOR (.almosteq.)
2208 MODULE PROCEDURE vol7d_timerange_almost_eq
2209END INTERFACE
2210
2211
2212! da documentare in inglese assieme al resto
2214INTERFACE c_e
2215 MODULE PROCEDURE vol7d_timerange_c_e
2216END INTERFACE
2217
2218#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
2219#define VOL7D_POLY_TYPES _timerange
2220#define ENABLE_SORT
2221#include "array_utilities_pre.F90"
2222
2224INTERFACE display
2225 MODULE PROCEDURE display_timerange
2226END INTERFACE
2227
2229INTERFACE to_char
2230 MODULE PROCEDURE to_char_timerange
2231END INTERFACE
2232
2233#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
2234#define ARRAYOF_TYPE arrayof_vol7d_timerange
2235#define ARRAYOF_ORIGEQ 1
2236#include "arrayof_pre.F90"
2237
2238
2239type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
2240 vol7d_timerange(254,0,imiss),&
2241 vol7d_timerange(3,0,3600)/)
2242
2243
2244! from arrayof
2245PUBLIC insert, append, remove, packarray
2246PUBLIC insert_unique, append_unique
2247PUBLIC almost_equal_timeranges
2248
2249CONTAINS
2250
2251
2257FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
2258INTEGER,INTENT(IN),OPTIONAL :: timerange
2259INTEGER,INTENT(IN),OPTIONAL :: p1
2260INTEGER,INTENT(IN),OPTIONAL :: p2
2261
2262TYPE(vol7d_timerange) :: this
2263
2264CALL init(this, timerange, p1, p2)
2265
2266END FUNCTION vol7d_timerange_new
2267
2268
2272SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
2273TYPE(vol7d_timerange),INTENT(INOUT) :: this
2274INTEGER,INTENT(IN),OPTIONAL :: timerange
2275INTEGER,INTENT(IN),OPTIONAL :: p1
2276INTEGER,INTENT(IN),OPTIONAL :: p2
2277
2278IF (PRESENT(timerange)) THEN
2279 this%timerange = timerange
2280ELSE
2281 this%timerange = imiss
2282 this%p1 = imiss
2283 this%p2 = imiss
2284 RETURN
2285ENDIF
2286!!$IF (timerange == 1) THEN ! p1 sempre 0
2287!!$ this%p1 = 0
2288!!$ this%p2 = imiss
2289!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
2290!!$ IF (PRESENT(p1)) THEN
2291!!$ this%p1 = p1
2292!!$ ELSE
2293!!$ this%p1 = 0
2294!!$ ENDIF
2295!!$ this%p2 = imiss
2296!!$ELSE ! tutti gli altri
2297 IF (PRESENT(p1)) THEN
2298 this%p1 = p1
2299 ELSE
2300 this%p1 = imiss
2301 ENDIF
2302 IF (PRESENT(p2)) THEN
2303 this%p2 = p2
2304 ELSE
2305 this%p2 = imiss
2306 ENDIF
2307!!$END IF
2308
2309END SUBROUTINE vol7d_timerange_init
2310
2311
2313SUBROUTINE vol7d_timerange_delete(this)
2314TYPE(vol7d_timerange),INTENT(INOUT) :: this
2315
2316this%timerange = imiss
2317this%p1 = imiss
2318this%p2 = imiss
2319
2320END SUBROUTINE vol7d_timerange_delete
2321
2322
2323SUBROUTINE display_timerange(this)
2324TYPE(vol7d_timerange),INTENT(in) :: this
2325
2326print*,to_char_timerange(this)
2327
2328END SUBROUTINE display_timerange
2329
2330
2331FUNCTION to_char_timerange(this)
2332#ifdef HAVE_DBALLE
2333USE dballef
2334#endif
2335TYPE(vol7d_timerange),INTENT(in) :: this
2336CHARACTER(len=80) :: to_char_timerange
2337
2338#ifdef HAVE_DBALLE
2339INTEGER :: handle, ier
2340
2341handle = 0
2342ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
2343ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
2344ier = idba_fatto(handle)
2345
2346to_char_timerange="Timerange: "//to_char_timerange
2347
2348#else
2349
2350to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
2351 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
2352
2353#endif
2354
2355END FUNCTION to_char_timerange
2356
2357
2358ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
2359TYPE(vol7d_timerange),INTENT(IN) :: this, that
2360LOGICAL :: res
2361
2362
2363res = &
2364 this%timerange == that%timerange .AND. &
2365 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
2366 this%timerange == 254)
2367
2368END FUNCTION vol7d_timerange_eq
2369
2370
2371ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
2372TYPE(vol7d_timerange),INTENT(IN) :: this, that
2373LOGICAL :: res
2374
2375IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
2376 this%p1 == that%p1 .AND. &
2377 this%p2 == that%p2) THEN
2378 res = .true.
2379ELSE
2380 res = .false.
2381ENDIF
2382
2383END FUNCTION vol7d_timerange_almost_eq
2384
2385
2386ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
2387TYPE(vol7d_timerange),INTENT(IN) :: this, that
2388LOGICAL :: res
2389
2390res = .NOT.(this == that)
2391
2392END FUNCTION vol7d_timerange_ne
2393
2394
2395ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
2396TYPE(vol7d_timerange),INTENT(IN) :: this, that
2397LOGICAL :: res
2398
2399IF (this%timerange > that%timerange .OR. &
2400 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
2401 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2402 this%p2 > that%p2)) THEN
2403 res = .true.
2404ELSE
2405 res = .false.
2406ENDIF
2407
2408END FUNCTION vol7d_timerange_gt
2409
2410
2411ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
2412TYPE(vol7d_timerange),INTENT(IN) :: this, that
2413LOGICAL :: res
2414
2415IF (this%timerange < that%timerange .OR. &
2416 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
2417 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2418 this%p2 < that%p2)) THEN
2419 res = .true.
2420ELSE
2421 res = .false.
2422ENDIF
2423
2424END FUNCTION vol7d_timerange_lt
2425
2426
2427ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
2428TYPE(vol7d_timerange),INTENT(IN) :: this, that
2429LOGICAL :: res
2430
2431IF (this == that) THEN
2432 res = .true.
2433ELSE IF (this > that) THEN
2434 res = .true.
2435ELSE
2436 res = .false.
2437ENDIF
2438
2439END FUNCTION vol7d_timerange_ge
2440
2441
2442ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
2443TYPE(vol7d_timerange),INTENT(IN) :: this, that
2444LOGICAL :: res
2445
2446IF (this == that) THEN
2447 res = .true.
2448ELSE IF (this < that) THEN
2449 res = .true.
2450ELSE
2451 res = .false.
2452ENDIF
2453
2454END FUNCTION vol7d_timerange_le
2455
2456
2457ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
2458TYPE(vol7d_timerange),INTENT(IN) :: this
2459LOGICAL :: c_e
2460c_e = this /= vol7d_timerange_miss
2461END FUNCTION vol7d_timerange_c_e
2462
2463
2464#include "array_utilities_inc.F90"
2465
2466#include "arrayof_post.F90"
2467
2468
2469END MODULE vol7d_timerange_class
Quick method to append an element to the array.
Distruttore per la classe vol7d_timerange.
Costruttore per la classe vol7d_timerange.
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.
Represent timerange object in a pretty string.
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:245
Definitions of constants and functions for working with missing values.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini.
Definisce l'intervallo temporale di un'osservazione meteo.

Generated with Doxygen.