libsim  Versione7.2.6
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 USE dballef
231 #endif
232 TYPE(vol7d_timerange),INTENT(in) :: this
233 CHARACTER(len=80) :: to_char_timerange
234 
235 #ifdef HAVE_DBALLE
236 INTEGER :: handle, ier
238 handle = 0
239 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
240 ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
241 ier = idba_fatto(handle)
243 to_char_timerange="Timerange: "//to_char_timerange
244 
245 #else
246 
247 to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
248  trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
249 
250 #endif
251 
252 END FUNCTION to_char_timerange
253 
255 ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
256 TYPE(vol7d_timerange),INTENT(IN) :: this, that
257 LOGICAL :: res
258 
259 
260 res = &
261  this%timerange == that%timerange .AND. &
262  this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
263  this%timerange == 254)
264 
265 END FUNCTION vol7d_timerange_eq
266 
267 
268 ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
269 TYPE(vol7d_timerange),INTENT(IN) :: this, that
270 LOGICAL :: res
271 
272 IF (.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.
276 ELSE
277  res = .false.
278 ENDIF
279 
280 END FUNCTION vol7d_timerange_almost_eq
281 
283 ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
284 TYPE(vol7d_timerange),INTENT(IN) :: this, that
285 LOGICAL :: res
286 
287 res = .NOT.(this == that)
288 
289 END FUNCTION vol7d_timerange_ne
290 
291 
292 ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
293 TYPE(vol7d_timerange),INTENT(IN) :: this, that
294 LOGICAL :: res
295 
296 IF (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.
301 ELSE
302  res = .false.
303 ENDIF
304 
305 END FUNCTION vol7d_timerange_gt
306 
307 
308 ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
309 TYPE(vol7d_timerange),INTENT(IN) :: this, that
310 LOGICAL :: res
311 
312 IF (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.
317 ELSE
318  res = .false.
319 ENDIF
320 
321 END FUNCTION vol7d_timerange_lt
322 
323 
324 ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
325 TYPE(vol7d_timerange),INTENT(IN) :: this, that
326 LOGICAL :: res
327 
328 IF (this == that) THEN
329  res = .true.
330 ELSE IF (this > that) THEN
331  res = .true.
332 ELSE
333  res = .false.
334 ENDIF
335 
336 END FUNCTION vol7d_timerange_ge
337 
338 
339 ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
340 TYPE(vol7d_timerange),INTENT(IN) :: this, that
341 LOGICAL :: res
342 
343 IF (this == that) THEN
344  res = .true.
345 ELSE IF (this < that) THEN
346  res = .true.
347 ELSE
348  res = .false.
349 ENDIF
350 
351 END FUNCTION vol7d_timerange_le
352 
353 
354 ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
355 TYPE(vol7d_timerange),INTENT(IN) :: this
356 LOGICAL :: c_e
357 c_e = this /= vol7d_timerange_miss
358 END FUNCTION vol7d_timerange_c_e
359 
360 
361 #include "array_utilities_inc.F90"
362 
363 #include "arrayof_post.F90"
364 
365 
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:255

Generated with Doxygen.