libsim Versione 7.1.11

◆ arrayof_vol7d_timerange_insert_array()

subroutine, private arrayof_vol7d_timerange_insert_array ( type(arrayof_vol7d_timerange this,
type(vol7d_timerange), dimension(:), intent(in), optional  content,
integer, intent(in), optional  nelem,
integer, intent(in), optional  pos 
)
private

Method for inserting a number of elements of the array at a desired position.

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

Parametri
thisarray object to extend
[in]contentobject of TYPE TYPE(vol7d_timerange) to insert, if not provided, space is reserved but not initialized
[in]nelemnumber of elements to add, mutually exclusive with the previous parameter, if both are not provided, a single element is added without initialization
[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 1888 del file vol7d_timerange_class.F90.

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