libsim Versione 7.2.1

◆ arrayof_vol7d_timerange_insert_unique()

subroutine, private arrayof_vol7d_timerange_insert_unique ( type(arrayof_vol7d_timerange) this,
type(vol7d_timerange), intent(in) content,
integer, intent(in), optional pos )
private

Method for inserting an element of the array at a desired position only if it is not present in the array yet.

If necessary, the array is reallocated to accomodate the new element.

Parametri
thisarray object to extend
[in]contentobject of TYPE TYPE(vol7d_timerange) to insert
[in]posposition where to insert, if it is out of range, it is clipped, if it is not provided, the object is appended

Definizione alla linea 1952 del file vol7d_timerange_class.F90.

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