libsim Versione 7.1.11

◆ arrayof_vol7d_timerange_insert()

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

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

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