libsim Versione 7.2.4

◆ arrayof_vol7d_timerange_insert()

subroutine, private arrayof_vol7d_timerange_insert ( 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.

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 1922 del file vol7d_timerange_class.F90.

1923! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1924! authors:
1925! Davide Cesari <dcesari@arpa.emr.it>
1926! Paolo Patruno <ppatruno@arpa.emr.it>
1927
1928! This program is free software; you can redistribute it and/or
1929! modify it under the terms of the GNU General Public License as
1930! published by the Free Software Foundation; either version 2 of
1931! the License, or (at your option) any later version.
1932
1933! This program is distributed in the hope that it will be useful,
1934! but WITHOUT ANY WARRANTY; without even the implied warranty of
1935! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1936! GNU General Public License for more details.
1937
1938! You should have received a copy of the GNU General Public License
1939! along with this program. If not, see <http://www.gnu.org/licenses/>.
1940#include "config.h"
1941
1950USE kinds
1953IMPLICIT NONE
1954
1959TYPE vol7d_timerange
1960 INTEGER :: timerange
1961 INTEGER :: p1
1962 INTEGER :: p2
1963END TYPE vol7d_timerange
1964
1966TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1967 vol7d_timerange(imiss,imiss,imiss)
1968
1972INTERFACE init
1973 MODULE PROCEDURE vol7d_timerange_init
1974END INTERFACE
1975
1978INTERFACE delete
1979 MODULE PROCEDURE vol7d_timerange_delete
1980END INTERFACE
1981
1985INTERFACE OPERATOR (==)
1986 MODULE PROCEDURE vol7d_timerange_eq
1987END INTERFACE
1988
1992INTERFACE OPERATOR (/=)
1993 MODULE PROCEDURE vol7d_timerange_ne
1994END INTERFACE
1995
1999INTERFACE OPERATOR (>)
2000 MODULE PROCEDURE vol7d_timerange_gt
2001END INTERFACE
2002
2006INTERFACE OPERATOR (<)
2007 MODULE PROCEDURE vol7d_timerange_lt
2008END INTERFACE
2009
2013INTERFACE OPERATOR (>=)
2014 MODULE PROCEDURE vol7d_timerange_ge
2015END INTERFACE
2016
2020INTERFACE OPERATOR (<=)
2021 MODULE PROCEDURE vol7d_timerange_le
2022END INTERFACE
2023
2026INTERFACE OPERATOR (.almosteq.)
2027 MODULE PROCEDURE vol7d_timerange_almost_eq
2028END INTERFACE
2029
2030
2031! da documentare in inglese assieme al resto
2033INTERFACE c_e
2034 MODULE PROCEDURE vol7d_timerange_c_e
2035END INTERFACE
2036
2037#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
2038#define VOL7D_POLY_TYPES _timerange
2039#define ENABLE_SORT
2040#include "array_utilities_pre.F90"
2041
2043INTERFACE display
2044 MODULE PROCEDURE display_timerange
2045END INTERFACE
2046
2048INTERFACE to_char
2049 MODULE PROCEDURE to_char_timerange
2050END INTERFACE
2051
2052#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
2053#define ARRAYOF_TYPE arrayof_vol7d_timerange
2054#define ARRAYOF_ORIGEQ 1
2055#include "arrayof_pre.F90"
2056
2057
2058type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
2059 vol7d_timerange(254,0,imiss),&
2060 vol7d_timerange(3,0,3600)/)
2061
2062
2063! from arrayof
2064PUBLIC insert, append, remove, packarray
2065PUBLIC insert_unique, append_unique
2066PUBLIC almost_equal_timeranges
2067
2068CONTAINS
2069
2070
2076FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
2077INTEGER,INTENT(IN),OPTIONAL :: timerange
2078INTEGER,INTENT(IN),OPTIONAL :: p1
2079INTEGER,INTENT(IN),OPTIONAL :: p2
2080
2081TYPE(vol7d_timerange) :: this
2082
2083CALL init(this, timerange, p1, p2)
2084
2085END FUNCTION vol7d_timerange_new
2086
2087
2091SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
2092TYPE(vol7d_timerange),INTENT(INOUT) :: this
2093INTEGER,INTENT(IN),OPTIONAL :: timerange
2094INTEGER,INTENT(IN),OPTIONAL :: p1
2095INTEGER,INTENT(IN),OPTIONAL :: p2
2096
2097IF (PRESENT(timerange)) THEN
2098 this%timerange = timerange
2099ELSE
2100 this%timerange = imiss
2101 this%p1 = imiss
2102 this%p2 = imiss
2103 RETURN
2104ENDIF
2105!!$IF (timerange == 1) THEN ! p1 sempre 0
2106!!$ this%p1 = 0
2107!!$ this%p2 = imiss
2108!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
2109!!$ IF (PRESENT(p1)) THEN
2110!!$ this%p1 = p1
2111!!$ ELSE
2112!!$ this%p1 = 0
2113!!$ ENDIF
2114!!$ this%p2 = imiss
2115!!$ELSE ! tutti gli altri
2116 IF (PRESENT(p1)) THEN
2117 this%p1 = p1
2118 ELSE
2119 this%p1 = imiss
2120 ENDIF
2121 IF (PRESENT(p2)) THEN
2122 this%p2 = p2
2123 ELSE
2124 this%p2 = imiss
2125 ENDIF
2126!!$END IF
2127
2128END SUBROUTINE vol7d_timerange_init
2129
2130
2132SUBROUTINE vol7d_timerange_delete(this)
2133TYPE(vol7d_timerange),INTENT(INOUT) :: this
2134
2135this%timerange = imiss
2136this%p1 = imiss
2137this%p2 = imiss
2138
2139END SUBROUTINE vol7d_timerange_delete
2140
2141
2142SUBROUTINE display_timerange(this)
2143TYPE(vol7d_timerange),INTENT(in) :: this
2144
2145print*,to_char_timerange(this)
2146
2147END SUBROUTINE display_timerange
2148
2149
2150FUNCTION to_char_timerange(this)
2151#ifdef HAVE_DBALLE
2152USE dballef
2153#endif
2154TYPE(vol7d_timerange),INTENT(in) :: this
2155CHARACTER(len=80) :: to_char_timerange
2156
2157#ifdef HAVE_DBALLE
2158INTEGER :: handle, ier
2159
2160handle = 0
2161ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
2162ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
2163ier = idba_fatto(handle)
2164
2165to_char_timerange="Timerange: "//to_char_timerange
2166
2167#else
2168
2169to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
2170 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
2171
2172#endif
2173
2174END FUNCTION to_char_timerange
2175
2176
2177ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
2178TYPE(vol7d_timerange),INTENT(IN) :: this, that
2179LOGICAL :: res
2180
2181
2182res = &
2183 this%timerange == that%timerange .AND. &
2184 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
2185 this%timerange == 254)
2186
2187END FUNCTION vol7d_timerange_eq
2188
2189
2190ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
2191TYPE(vol7d_timerange),INTENT(IN) :: this, that
2192LOGICAL :: res
2193
2194IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
2195 this%p1 == that%p1 .AND. &
2196 this%p2 == that%p2) THEN
2197 res = .true.
2198ELSE
2199 res = .false.
2200ENDIF
2201
2202END FUNCTION vol7d_timerange_almost_eq
2203
2204
2205ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
2206TYPE(vol7d_timerange),INTENT(IN) :: this, that
2207LOGICAL :: res
2208
2209res = .NOT.(this == that)
2210
2211END FUNCTION vol7d_timerange_ne
2212
2213
2214ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
2215TYPE(vol7d_timerange),INTENT(IN) :: this, that
2216LOGICAL :: res
2217
2218IF (this%timerange > that%timerange .OR. &
2219 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
2220 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2221 this%p2 > that%p2)) THEN
2222 res = .true.
2223ELSE
2224 res = .false.
2225ENDIF
2226
2227END FUNCTION vol7d_timerange_gt
2228
2229
2230ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
2231TYPE(vol7d_timerange),INTENT(IN) :: this, that
2232LOGICAL :: res
2233
2234IF (this%timerange < that%timerange .OR. &
2235 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
2236 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
2237 this%p2 < that%p2)) THEN
2238 res = .true.
2239ELSE
2240 res = .false.
2241ENDIF
2242
2243END FUNCTION vol7d_timerange_lt
2244
2245
2246ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
2247TYPE(vol7d_timerange),INTENT(IN) :: this, that
2248LOGICAL :: res
2249
2250IF (this == that) THEN
2251 res = .true.
2252ELSE IF (this > that) THEN
2253 res = .true.
2254ELSE
2255 res = .false.
2256ENDIF
2257
2258END FUNCTION vol7d_timerange_ge
2259
2260
2261ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
2262TYPE(vol7d_timerange),INTENT(IN) :: this, that
2263LOGICAL :: res
2264
2265IF (this == that) THEN
2266 res = .true.
2267ELSE IF (this < that) THEN
2268 res = .true.
2269ELSE
2270 res = .false.
2271ENDIF
2272
2273END FUNCTION vol7d_timerange_le
2274
2275
2276ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
2277TYPE(vol7d_timerange),INTENT(IN) :: this
2278LOGICAL :: c_e
2279c_e = this /= vol7d_timerange_miss
2280END FUNCTION vol7d_timerange_c_e
2281
2282
2283#include "array_utilities_inc.F90"
2284
2285#include "arrayof_post.F90"
2286
2287
2288END 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.