libsim Versione 7.1.11
|
◆ arrayof_vol7d_timerange_append_unique()
Quick function to append an element to the array only if it is not present in the array yet. The return value is the position at which the element has been appended or at which it has been found.
Definizione alla linea 1978 del file vol7d_timerange_class.F90. 1979! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1980! authors:
1981! Davide Cesari <dcesari@arpa.emr.it>
1982! Paolo Patruno <ppatruno@arpa.emr.it>
1983
1984! This program is free software; you can redistribute it and/or
1985! modify it under the terms of the GNU General Public License as
1986! published by the Free Software Foundation; either version 2 of
1987! the License, or (at your option) any later version.
1988
1989! This program is distributed in the hope that it will be useful,
1990! but WITHOUT ANY WARRANTY; without even the implied warranty of
1991! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1992! GNU General Public License for more details.
1993
1994! You should have received a copy of the GNU General Public License
1995! along with this program. If not, see <http://www.gnu.org/licenses/>.
1996#include "config.h"
1997
2009IMPLICIT NONE
2010
2016 INTEGER :: timerange
2017 INTEGER :: p1
2018 INTEGER :: p2
2020
2022TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
2023 vol7d_timerange(imiss,imiss,imiss)
2024
2029 MODULE PROCEDURE vol7d_timerange_init
2030END INTERFACE
2031
2035 MODULE PROCEDURE vol7d_timerange_delete
2036END INTERFACE
2037
2041INTERFACE OPERATOR (==)
2042 MODULE PROCEDURE vol7d_timerange_eq
2043END INTERFACE
2044
2048INTERFACE OPERATOR (/=)
2049 MODULE PROCEDURE vol7d_timerange_ne
2050END INTERFACE
2051
2055INTERFACE OPERATOR (>)
2056 MODULE PROCEDURE vol7d_timerange_gt
2057END INTERFACE
2058
2062INTERFACE OPERATOR (<)
2063 MODULE PROCEDURE vol7d_timerange_lt
2064END INTERFACE
2065
2069INTERFACE OPERATOR (>=)
2070 MODULE PROCEDURE vol7d_timerange_ge
2071END INTERFACE
2072
2076INTERFACE OPERATOR (<=)
2077 MODULE PROCEDURE vol7d_timerange_le
2078END INTERFACE
2079
2082INTERFACE OPERATOR (.almosteq.)
2083 MODULE PROCEDURE vol7d_timerange_almost_eq
2084END INTERFACE
2085
2086
2087! da documentare in inglese assieme al resto
2090 MODULE PROCEDURE vol7d_timerange_c_e
2091END INTERFACE
2092
2093#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
2094#define VOL7D_POLY_TYPES _timerange
2095#define ENABLE_SORT
2096#include "array_utilities_pre.F90"
2097
2100 MODULE PROCEDURE display_timerange
2101END INTERFACE
2102
2105 MODULE PROCEDURE to_char_timerange
2106END INTERFACE
2107
2108#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
2109#define ARRAYOF_TYPE arrayof_vol7d_timerange
2110#define ARRAYOF_ORIGEQ 1
2111#include "arrayof_pre.F90"
2112
2113
2114type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
2115 vol7d_timerange(254,0,imiss),&
2116 vol7d_timerange(3,0,3600)/)
2117
2118
2119! from arrayof
2121PUBLIC insert_unique, append_unique
2122PUBLIC almost_equal_timeranges
2123
2124CONTAINS
2125
2126
2132FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
2133INTEGER,INTENT(IN),OPTIONAL :: timerange
2134INTEGER,INTENT(IN),OPTIONAL :: p1
2135INTEGER,INTENT(IN),OPTIONAL :: p2
2136
2137TYPE(vol7d_timerange) :: this
2138
2140
2141END FUNCTION vol7d_timerange_new
2142
2143
2147SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
2148TYPE(vol7d_timerange),INTENT(INOUT) :: this
2149INTEGER,INTENT(IN),OPTIONAL :: timerange
2150INTEGER,INTENT(IN),OPTIONAL :: p1
2151INTEGER,INTENT(IN),OPTIONAL :: p2
2152
2153IF (PRESENT(timerange)) THEN
2154 this%timerange = timerange
2155ELSE
2156 this%timerange = imiss
2157 this%p1 = imiss
2158 this%p2 = imiss
2159 RETURN
2160ENDIF
2161!!$IF (timerange == 1) THEN ! p1 sempre 0
2162!!$ this%p1 = 0
2163!!$ this%p2 = imiss
2164!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
2165!!$ IF (PRESENT(p1)) THEN
2166!!$ this%p1 = p1
2167!!$ ELSE
2168!!$ this%p1 = 0
2169!!$ ENDIF
2170!!$ this%p2 = imiss
2171!!$ELSE ! tutti gli altri
2172 IF (PRESENT(p1)) THEN
2173 this%p1 = p1
2174 ELSE
2175 this%p1 = imiss
2176 ENDIF
2177 IF (PRESENT(p2)) THEN
2178 this%p2 = p2
2179 ELSE
2180 this%p2 = imiss
2181 ENDIF
2182!!$END IF
2183
2184END SUBROUTINE vol7d_timerange_init
2185
2186
2188SUBROUTINE vol7d_timerange_delete(this)
2189TYPE(vol7d_timerange),INTENT(INOUT) :: this
2190
2191this%timerange = imiss
2192this%p1 = imiss
2193this%p2 = imiss
2194
2195END SUBROUTINE vol7d_timerange_delete
2196
2197
2198SUBROUTINE display_timerange(this)
2199TYPE(vol7d_timerange),INTENT(in) :: this
2200
2201print*,to_char_timerange(this)
2202
2203END SUBROUTINE display_timerange
2204
2205
2206FUNCTION to_char_timerange(this)
2207#ifdef HAVE_DBALLE
2208USE dballef
2209#endif
2210TYPE(vol7d_timerange),INTENT(in) :: this
2211CHARACTER(len=80) :: to_char_timerange
2212
2213#ifdef HAVE_DBALLE
2214INTEGER :: handle, ier
2215
2216handle = 0
2217ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
2218ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
2219ier = idba_fatto(handle)
2220
2221to_char_timerange="Timerange: "//to_char_timerange
2222
2223#else
2224
2227
2228#endif
2229
2230END FUNCTION to_char_timerange
2231
2232
2233ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
2234TYPE(vol7d_timerange),INTENT(IN) :: this, that
2235LOGICAL :: res
2236
2237
2238res = &
2239 this%timerange == that%timerange .AND. &
2240 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
2241 this%timerange == 254)
2242
2243END FUNCTION vol7d_timerange_eq
2244
2245
2246ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
2247TYPE(vol7d_timerange),INTENT(IN) :: this, that
2248LOGICAL :: res
2249
2250IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
2251 this%p1 == that%p1 .AND. &
2252 this%p2 == that%p2) THEN
2253 res = .true.
2254ELSE
2255 res = .false.
2256ENDIF
2257
2258END FUNCTION vol7d_timerange_almost_eq
2259
2260
2261ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
2262TYPE(vol7d_timerange),INTENT(IN) :: this, that
2263LOGICAL :: res
2264
2265res = .NOT.(this == that)
2266
2267END FUNCTION vol7d_timerange_ne
2268
2269
2270ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
2271TYPE(vol7d_timerange),INTENT(IN) :: this, that
2272LOGICAL :: res
2273
2274IF (this%timerange > that%timerange .OR. &
2275 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
2276 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2277 this%p2 > that%p2)) THEN
2278 res = .true.
2279ELSE
2280 res = .false.
2281ENDIF
2282
2283END FUNCTION vol7d_timerange_gt
2284
2285
2286ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
2287TYPE(vol7d_timerange),INTENT(IN) :: this, that
2288LOGICAL :: res
2289
2290IF (this%timerange < that%timerange .OR. &
2291 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
2292 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2293 this%p2 < that%p2)) THEN
2294 res = .true.
2295ELSE
2296 res = .false.
2297ENDIF
2298
2299END FUNCTION vol7d_timerange_lt
2300
2301
2302ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
2303TYPE(vol7d_timerange),INTENT(IN) :: this, that
2304LOGICAL :: res
2305
2306IF (this == that) THEN
2307 res = .true.
2308ELSE IF (this > that) THEN
2309 res = .true.
2310ELSE
2311 res = .false.
2312ENDIF
2313
2314END FUNCTION vol7d_timerange_ge
2315
2316
2317ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
2318TYPE(vol7d_timerange),INTENT(IN) :: this, that
2319LOGICAL :: res
2320
2321IF (this == that) THEN
2322 res = .true.
2323ELSE IF (this < that) THEN
2324 res = .true.
2325ELSE
2326 res = .false.
2327ENDIF
2328
2329END FUNCTION vol7d_timerange_le
2330
2331
2332ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
2333TYPE(vol7d_timerange),INTENT(IN) :: this
2334LOGICAL :: c_e
2335c_e = this /= vol7d_timerange_miss
2336END FUNCTION vol7d_timerange_c_e
2337
2338
2339#include "array_utilities_inc.F90"
2340
2341#include "arrayof_post.F90"
2342
2343
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 |