libsim  Versione6.3.0
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 
28 USE kinds
31 IMPLICIT NONE
32 
37 TYPE vol7d_timerange
38  INTEGER :: timerange
39  INTEGER :: p1
40  INTEGER :: p2
41 END TYPE vol7d_timerange
42 
44 TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
45  vol7d_timerange(imiss,imiss,imiss)
46 
50 INTERFACE init
51  MODULE PROCEDURE vol7d_timerange_init
52 END INTERFACE
53 
56 INTERFACE delete
57  MODULE PROCEDURE vol7d_timerange_delete
58 END INTERFACE
59 
63 INTERFACE OPERATOR (==)
64  MODULE PROCEDURE vol7d_timerange_eq
65 END INTERFACE
66 
70 INTERFACE OPERATOR (/=)
71  MODULE PROCEDURE vol7d_timerange_ne
72 END INTERFACE
73 
77 INTERFACE OPERATOR (>)
78  MODULE PROCEDURE vol7d_timerange_gt
79 END INTERFACE
80 
84 INTERFACE OPERATOR (<)
85  MODULE PROCEDURE vol7d_timerange_lt
86 END INTERFACE
87 
91 INTERFACE OPERATOR (>=)
92  MODULE PROCEDURE vol7d_timerange_ge
93 END INTERFACE
94 
98 INTERFACE OPERATOR (<=)
99  MODULE PROCEDURE vol7d_timerange_le
100 END INTERFACE
101 
104 INTERFACE OPERATOR (.almosteq.)
105  MODULE PROCEDURE vol7d_timerange_almost_eq
106 END INTERFACE
107 
108 
109 ! da documentare in inglese assieme al resto
111 INTERFACE c_e
112  MODULE PROCEDURE vol7d_timerange_c_e
113 END 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 
121 INTERFACE display
122  MODULE PROCEDURE display_timerange
123 END INTERFACE
124 
126 INTERFACE to_char
127  MODULE PROCEDURE to_char_timerange
128 END 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 
136 type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
137  vol7d_timerange(254,0,imiss),&
138  vol7d_timerange(3,0,3600)/)
139 
140 
141 ! from arrayof
142 PUBLIC insert, append, remove, packarray
143 PUBLIC insert_unique, append_unique
144 PUBLIC almost_equal_timeranges
145 
146 CONTAINS
147 
148 
154 FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
155 INTEGER,INTENT(IN),OPTIONAL :: timerange
156 INTEGER,INTENT(IN),OPTIONAL :: p1
157 INTEGER,INTENT(IN),OPTIONAL :: p2
158 
159 TYPE(vol7d_timerange) :: this
160 
161 CALL init(this, timerange, p1, p2)
162 
163 END FUNCTION vol7d_timerange_new
164 
165 
169 SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
170 TYPE(vol7d_timerange),INTENT(INOUT) :: this
171 INTEGER,INTENT(IN),OPTIONAL :: timerange
172 INTEGER,INTENT(IN),OPTIONAL :: p1
173 INTEGER,INTENT(IN),OPTIONAL :: p2
174 
175 IF (PRESENT(timerange)) THEN
176  this%timerange = timerange
177 ELSE
178  this%timerange = imiss
179  this%p1 = imiss
180  this%p2 = imiss
181  RETURN
182 ENDIF
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 
206 END SUBROUTINE vol7d_timerange_init
207 
208 
210 SUBROUTINE vol7d_timerange_delete(this)
211 TYPE(vol7d_timerange),INTENT(INOUT) :: this
212 
213 this%timerange = imiss
214 this%p1 = imiss
215 this%p2 = imiss
216 
217 END SUBROUTINE vol7d_timerange_delete
218 
219 
220 SUBROUTINE display_timerange(this)
221 TYPE(vol7d_timerange),INTENT(in) :: this
222 
223 print*,to_char_timerange(this)
224 
225 END SUBROUTINE display_timerange
226 
227 
228 FUNCTION to_char_timerange(this)
229 #ifdef HAVE_DBALLE
230 #ifdef HAVE_DBALLEF_MOD
231 USE dballef
232 #else
233 include 'dballeff.h'
234 #endif
235 #endif
236 TYPE(vol7d_timerange),INTENT(in) :: this
237 CHARACTER(len=80) :: to_char_timerange
238 
239 #ifdef HAVE_DBALLE
240 INTEGER :: handle, ier
241 
242 handle = 0
243 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
244 ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
245 ier = idba_fatto(handle)
246 
247 to_char_timerange="Timerange: "//to_char_timerange
248 
249 #else
251 to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
252  trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
254 #endif
255 
256 END FUNCTION to_char_timerange
258 
259 ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
260 TYPE(vol7d_timerange),INTENT(IN) :: this, that
261 LOGICAL :: res
262 
264 res = &
265  this%timerange == that%timerange .AND. &
266  this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
267  this%timerange == 254)
268 
269 END FUNCTION vol7d_timerange_eq
270 
271 
272 ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
273 TYPE(vol7d_timerange),INTENT(IN) :: this, that
274 LOGICAL :: res
275 
276 IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
277  this%p1 == that%p1 .AND. &
278  this%p2 == that%p2) THEN
279  res = .true.
280 ELSE
281  res = .false.
282 ENDIF
284 END FUNCTION vol7d_timerange_almost_eq
285 
286 
287 ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
288 TYPE(vol7d_timerange),INTENT(IN) :: this, that
289 LOGICAL :: res
291 res = .NOT.(this == that)
292 
293 END FUNCTION vol7d_timerange_ne
294 
295 
296 ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
297 TYPE(vol7d_timerange),INTENT(IN) :: this, that
298 LOGICAL :: res
299 
300 IF (this%timerange > that%timerange .OR. &
301  (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
302  (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
303  this%p2 > that%p2)) THEN
304  res = .true.
305 ELSE
306  res = .false.
307 ENDIF
308 
309 END FUNCTION vol7d_timerange_gt
310 
312 ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
313 TYPE(vol7d_timerange),INTENT(IN) :: this, that
314 LOGICAL :: res
315 
316 IF (this%timerange < that%timerange .OR. &
317  (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
318  (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
319  this%p2 < that%p2)) THEN
320  res = .true.
321 ELSE
322  res = .false.
323 ENDIF
325 END FUNCTION vol7d_timerange_lt
326 
327 
328 ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
329 TYPE(vol7d_timerange),INTENT(IN) :: this, that
330 LOGICAL :: res
331 
332 IF (this == that) THEN
333  res = .true.
334 ELSE IF (this > that) THEN
335  res = .true.
336 ELSE
337  res = .false.
338 ENDIF
339 
340 END FUNCTION vol7d_timerange_ge
341 
342 
343 ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
344 TYPE(vol7d_timerange),INTENT(IN) :: this, that
345 LOGICAL :: res
346 
347 IF (this == that) THEN
348  res = .true.
349 ELSE IF (this < that) THEN
350  res = .true.
351 ELSE
352  res = .false.
353 ENDIF
354 
355 END FUNCTION vol7d_timerange_le
356 
357 
358 ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
359 TYPE(vol7d_timerange),INTENT(IN) :: this
360 LOGICAL :: c_e
361 c_e = this /= vol7d_timerange_miss
362 END FUNCTION vol7d_timerange_c_e
363 
364 
365 #include "array_utilities_inc.F90"
366 
367 #include "arrayof_post.F90"
368 
370 END MODULE vol7d_timerange_class
Distruttore per la classe vol7d_timerange.
Represent timerange object in a pretty string.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Definisce l&#39;intervallo temporale di un&#39;osservazione meteo.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. ...
Definitions of constants and functions for working with missing values.
Method for inserting elements of the array at a desired position.
Quick method to append an element to the array.
Utilities for CHARACTER variables.
Costruttore per la classe vol7d_timerange.
Method for removing elements of the array at a desired position.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:270

Generated with Doxygen.