libsim Versione 7.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
20!> Classe per la gestione degli intervalli temporali di osservazioni
21!! meteo e affini.
22!! Questo modulo definisce una classe in grado di rappresentare
23!! l'intervallo di tempo a cui si riferisce un'osservazione meteo,
24!! ad es. valore istantaneo, cumulato, medio, ecc., prendendo in prestito
25!! concetti dal formato grib.
26!! \ingroup vol7d
28USE kinds
31IMPLICIT NONE
32
33!> Definisce l'intervallo temporale di un'osservazione meteo.
34!! I membri di \a vol7d_timerange sono pubblici e quindi liberamente
35!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
36!! il costruttore ::init.
38 INTEGER :: timerange !< proprietà statistiche del dato (es. 0=media, 1=cumulazione, 2=massimo, 3=minimo, 4=differenza... 254=dato istantaneo) tratte dalla code table 4.10 del formato WMO grib edizione 2, vedi http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf
39 INTEGER :: p1 !< termine del periodo di validità del dato, in secondi, a partire dall'istante di riferimento (0 per dati osservati o analizzati)
40 INTEGER :: p2 !< durata del periodo di validità del dato, in secondi (0 per dati istantanei)
41END TYPE vol7d_timerange
42
43!> Valore mancante per vol7d_timerange.
44TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
45 vol7d_timerange(imiss,imiss,imiss)
46
47!> Costruttore per la classe vol7d_timerange.
48!! Deve essere richiamato
49!! per tutti gli oggetti di questo tipo definiti in un programma.
50INTERFACE init
51 MODULE PROCEDURE vol7d_timerange_init
52END INTERFACE
53
54!> Distruttore per la classe vol7d_timerange.
55!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
56INTERFACE delete
57 MODULE PROCEDURE vol7d_timerange_delete
58END INTERFACE
59
60!> Logical equality operator for objects of \a vol7d_timerange class.
61!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
62!! of any shape.
63INTERFACE OPERATOR (==)
64 MODULE PROCEDURE vol7d_timerange_eq
65END INTERFACE
66
67!> Logical inequality operator for objects of \a vol7d_timerange class.
68!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
69!! of any shape.
70INTERFACE OPERATOR (/=)
71 MODULE PROCEDURE vol7d_timerange_ne
72END INTERFACE
73
74!> Logical greater-than operator for objects of \a vol7d_timerange class.
75!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
76!! of any shape.
77INTERFACE OPERATOR (>)
78 MODULE PROCEDURE vol7d_timerange_gt
79END INTERFACE
80
81!> Logical less-than operator for objects of \a vol7d_timerange class.
82!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
83!! of any shape.
84INTERFACE OPERATOR (<)
85 MODULE PROCEDURE vol7d_timerange_lt
86END INTERFACE
87
88!> Logical greater-equal operator for objects of \a vol7d_timerange class.
89!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
90!! of any shape.
91INTERFACE OPERATOR (>=)
92 MODULE PROCEDURE vol7d_timerange_ge
93END INTERFACE
94
95!> Logical less-equal operator for objects of \a vol7d_timerange class.
96!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
97!! of any shape.
98INTERFACE OPERATOR (<=)
99 MODULE PROCEDURE vol7d_timerange_le
100END INTERFACE
101
102!> Logical almost equality operator for objects of \a vol7d_timerange class.
103!! If one component is missing it is not used in comparison.
104INTERFACE OPERATOR (.almosteq.)
105 MODULE PROCEDURE vol7d_timerange_almost_eq
106END INTERFACE
107
108
109! da documentare in inglese assieme al resto
110!> to be documented
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
120!>Print object
121INTERFACE display
122 MODULE PROCEDURE display_timerange
123END INTERFACE
124
125!>Represent timerange object in a pretty string
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
149!> Inizializza un oggetto \a vol7d_timerange con i parametri opzionali forniti.
150!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
151!! rispetto alla versione \c SUBROUTINE \c init.
152!! Se non viene passato nessun parametro opzionale l'oggetto è
153!! inizializzato a valore mancante.
154FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
155INTEGER,INTENT(IN),OPTIONAL :: timerange !< tipo di intervallo temporale
156INTEGER,INTENT(IN),OPTIONAL :: p1 !< valore per il primo istante temporale
157INTEGER,INTENT(IN),OPTIONAL :: p2 !< valore per il secondo istante temporale
158
159TYPE(vol7d_timerange) :: this !< oggetto da inizializzare
160
161CALL init(this, timerange, p1, p2)
162
163END FUNCTION vol7d_timerange_new
164
165
166!> Inizializza un oggetto \a vol7d_timerange con i parametri opzionali forniti.
167!! Se non viene passato nessun parametro opzionale l'oggetto è
168!! inizializzato a valore mancante.
169SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
170TYPE(vol7d_timerange),INTENT(INOUT) :: this !< oggetto da inizializzare
171INTEGER,INTENT(IN),OPTIONAL :: timerange !< tipo di intervallo temporale
172INTEGER,INTENT(IN),OPTIONAL :: p1 !< valore per il primo istante temporale
173INTEGER,INTENT(IN),OPTIONAL :: p2 !< valore per il secondo istante temporale
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
209!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
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.
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.