libsim Versione 7.2.1

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

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