libsim Versione 7.2.1
vol7d_timerange_class.F90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18#include "config.h"
19
28USE kinds
31IMPLICIT NONE
32
38 INTEGER :: timerange
39 INTEGER :: p1
40 INTEGER :: p2
41END TYPE vol7d_timerange
42
44TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
45 vol7d_timerange(imiss,imiss,imiss)
46
50INTERFACE init
51 MODULE PROCEDURE vol7d_timerange_init
52END INTERFACE
53
56INTERFACE delete
57 MODULE PROCEDURE vol7d_timerange_delete
58END INTERFACE
59
63INTERFACE OPERATOR (==)
64 MODULE PROCEDURE vol7d_timerange_eq
65END INTERFACE
66
70INTERFACE OPERATOR (/=)
71 MODULE PROCEDURE vol7d_timerange_ne
72END INTERFACE
73
77INTERFACE OPERATOR (>)
78 MODULE PROCEDURE vol7d_timerange_gt
79END INTERFACE
80
84INTERFACE OPERATOR (<)
85 MODULE PROCEDURE vol7d_timerange_lt
86END INTERFACE
87
91INTERFACE OPERATOR (>=)
92 MODULE PROCEDURE vol7d_timerange_ge
93END INTERFACE
94
98INTERFACE OPERATOR (<=)
99 MODULE PROCEDURE vol7d_timerange_le
100END INTERFACE
101
104INTERFACE OPERATOR (.almosteq.)
105 MODULE PROCEDURE vol7d_timerange_almost_eq
106END INTERFACE
107
108
109! da documentare in inglese assieme al resto
111INTERFACE c_e
112 MODULE PROCEDURE vol7d_timerange_c_e
113END INTERFACE
114
115#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
116#define VOL7D_POLY_TYPES _timerange
117#define ENABLE_SORT
118#include "array_utilities_pre.F90"
119
121INTERFACE display
122 MODULE PROCEDURE display_timerange
123END INTERFACE
124
126INTERFACE to_char
127 MODULE PROCEDURE to_char_timerange
128END INTERFACE
129
130#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
131#define ARRAYOF_TYPE arrayof_vol7d_timerange
132#define ARRAYOF_ORIGEQ 1
133#include "arrayof_pre.F90"
134
135
136type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
137 vol7d_timerange(254,0,imiss),&
138 vol7d_timerange(3,0,3600)/)
139
140
141! from arrayof
143PUBLIC insert_unique, append_unique
144PUBLIC almost_equal_timeranges
145
146CONTAINS
147
148
154FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
155INTEGER,INTENT(IN),OPTIONAL :: timerange
156INTEGER,INTENT(IN),OPTIONAL :: p1
157INTEGER,INTENT(IN),OPTIONAL :: p2
158
159TYPE(vol7d_timerange) :: this
160
161CALL init(this, timerange, p1, p2)
162
163END FUNCTION vol7d_timerange_new
164
165
169SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
170TYPE(vol7d_timerange),INTENT(INOUT) :: this
171INTEGER,INTENT(IN),OPTIONAL :: timerange
172INTEGER,INTENT(IN),OPTIONAL :: p1
173INTEGER,INTENT(IN),OPTIONAL :: p2
174
175IF (PRESENT(timerange)) THEN
176 this%timerange = timerange
177ELSE
178 this%timerange = imiss
179 this%p1 = imiss
180 this%p2 = imiss
181 RETURN
182ENDIF
183!!$IF (timerange == 1) THEN ! p1 sempre 0
184!!$ this%p1 = 0
185!!$ this%p2 = imiss
186!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
187!!$ IF (PRESENT(p1)) THEN
188!!$ this%p1 = p1
189!!$ ELSE
190!!$ this%p1 = 0
191!!$ ENDIF
192!!$ this%p2 = imiss
193!!$ELSE ! tutti gli altri
194 IF (PRESENT(p1)) THEN
195 this%p1 = p1
196 ELSE
197 this%p1 = imiss
198 ENDIF
199 IF (PRESENT(p2)) THEN
200 this%p2 = p2
201 ELSE
202 this%p2 = imiss
203 ENDIF
204!!$END IF
205
206END SUBROUTINE vol7d_timerange_init
207
208
210SUBROUTINE vol7d_timerange_delete(this)
211TYPE(vol7d_timerange),INTENT(INOUT) :: this
212
213this%timerange = imiss
214this%p1 = imiss
215this%p2 = imiss
216
217END SUBROUTINE vol7d_timerange_delete
218
219
220SUBROUTINE display_timerange(this)
221TYPE(vol7d_timerange),INTENT(in) :: this
222
223print*,to_char_timerange(this)
224
225END SUBROUTINE display_timerange
228FUNCTION to_char_timerange(this)
229#ifdef HAVE_DBALLE
230USE dballef
231#endif
232TYPE(vol7d_timerange),INTENT(in) :: this
233CHARACTER(len=80) :: to_char_timerange
234
235#ifdef HAVE_DBALLE
236INTEGER :: handle, ier
237
238handle = 0
239ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
240ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
241ier = idba_fatto(handle)
242
243to_char_timerange="Timerange: "//to_char_timerange
245#else
246
247to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
248 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
249
250#endif
252END FUNCTION to_char_timerange
253
254
255ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
256TYPE(vol7d_timerange),INTENT(IN) :: this, that
257LOGICAL :: res
259
260res = &
261 this%timerange == that%timerange .AND. &
262 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
263 this%timerange == 254)
264
265END FUNCTION vol7d_timerange_eq
266
267
268ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
269TYPE(vol7d_timerange),INTENT(IN) :: this, that
270LOGICAL :: res
271
272IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
273 this%p1 == that%p1 .AND. &
274 this%p2 == that%p2) THEN
275 res = .true.
276ELSE
277 res = .false.
278ENDIF
280END FUNCTION vol7d_timerange_almost_eq
281
282
283ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
284TYPE(vol7d_timerange),INTENT(IN) :: this, that
285LOGICAL :: res
287res = .NOT.(this == that)
288
289END FUNCTION vol7d_timerange_ne
290
291
292ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
293TYPE(vol7d_timerange),INTENT(IN) :: this, that
294LOGICAL :: res
295
296IF (this%timerange > that%timerange .OR. &
297 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
298 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
299 this%p2 > that%p2)) THEN
300 res = .true.
301ELSE
302 res = .false.
303ENDIF
304
305END FUNCTION vol7d_timerange_gt
306
307
308ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
309TYPE(vol7d_timerange),INTENT(IN) :: this, that
310LOGICAL :: res
311
312IF (this%timerange < that%timerange .OR. &
313 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
314 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
315 this%p2 < that%p2)) THEN
316 res = .true.
317ELSE
318 res = .false.
319ENDIF
320
321END FUNCTION vol7d_timerange_lt
322
323
324ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
325TYPE(vol7d_timerange),INTENT(IN) :: this, that
326LOGICAL :: res
327
328IF (this == that) THEN
329 res = .true.
330ELSE IF (this > that) THEN
331 res = .true.
332ELSE
333 res = .false.
334ENDIF
335
336END FUNCTION vol7d_timerange_ge
337
338
339ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
340TYPE(vol7d_timerange),INTENT(IN) :: this, that
341LOGICAL :: res
342
343IF (this == that) THEN
344 res = .true.
345ELSE IF (this < that) THEN
346 res = .true.
347ELSE
348 res = .false.
349ENDIF
350
351END FUNCTION vol7d_timerange_le
352
353
354ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
355TYPE(vol7d_timerange),INTENT(IN) :: this
356LOGICAL :: c_e
357c_e = this /= vol7d_timerange_miss
358END FUNCTION vol7d_timerange_c_e
359
360
361#include "array_utilities_inc.F90"
362
363#include "arrayof_post.F90"
365
366END MODULE vol7d_timerange_class
Index method.
Quick method to append an element to the array.
Distruttore per la classe vol7d_timerange.
Index method with sorted array.
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.
Derived type defining a dynamically extensible array of TYPE(vol7d_timerange) elements.
Definisce l'intervallo temporale di un'osservazione meteo.

Generated with Doxygen.