libsim Versione 7.2.0

◆ arrayof_vol7d_timerange_append_unique()

integer function, private arrayof_vol7d_timerange_append_unique ( type(arrayof_vol7d_timerange this,
type(vol7d_timerange), intent(in)  content 
)
private

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.

Parametri
thisarray object to extend
[in]contentobject of TYPE TYPE(vol7d_timerange) to append

Definizione alla linea 1972 del file vol7d_timerange_class.F90.

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