libsim Versione 7.1.11
vol7d_var_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
24MODULE vol7d_var_class
25USE kinds
28IMPLICIT NONE
29
38TYPE vol7d_var
39 CHARACTER(len=10) :: btable=cmiss
40 CHARACTER(len=65) :: description=cmiss
41 CHARACTER(len=24) :: unit=cmiss
42 INTEGER :: scalefactor=imiss
43
44 INTEGER :: r=imiss
45 INTEGER :: d=imiss
46 INTEGER :: i=imiss
47 INTEGER :: b=imiss
48 INTEGER :: c=imiss
49 INTEGER :: gribhint(4)=imiss
50END TYPE vol7d_var
51
53TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
54 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
55 (/imiss,imiss,imiss,imiss/))
56
60INTERFACE init
61 MODULE PROCEDURE vol7d_var_init
62END INTERFACE
63
66INTERFACE delete
67 MODULE PROCEDURE vol7d_var_delete
68END INTERFACE
69
75INTERFACE OPERATOR (==)
76 MODULE PROCEDURE vol7d_var_eq
77END INTERFACE
78
84INTERFACE OPERATOR (/=)
85 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
86END INTERFACE
87
89INTERFACE c_e
90 MODULE PROCEDURE vol7d_var_c_e
91END INTERFACE
92
93#define VOL7D_POLY_TYPE TYPE(vol7d_var)
94#define VOL7D_POLY_TYPES _var
95#include "array_utilities_pre.F90"
96
98INTERFACE display
99 MODULE PROCEDURE display_var, display_var_vect
100END INTERFACE
101
102
103TYPE vol7d_var_features
104 TYPE(vol7d_var) :: var
105 REAL :: posdef
106 INTEGER :: vartype
107END TYPE vol7d_var_features
108
109TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
110
111! constants for vol7d_vartype
112INTEGER,PARAMETER :: var_ord=0
113INTEGER,PARAMETER :: var_dir360=1
114INTEGER,PARAMETER :: var_press=2
115INTEGER,PARAMETER :: var_ucomp=3
116INTEGER,PARAMETER :: var_vcomp=4
117INTEGER,PARAMETER :: var_wcomp=5
118
119
120CONTAINS
121
127elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
128TYPE(vol7d_var),INTENT(INOUT) :: this
129CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
130CHARACTER(len=*),INTENT(in),OPTIONAL :: description
131CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
132INTEGER,INTENT(in),OPTIONAL :: scalefactor
133
134IF (PRESENT(btable)) THEN
135 this%btable = btable
136ELSE
137 this%btable = cmiss
138 this%description = cmiss
139 this%unit = cmiss
140 this%scalefactor = imiss
141 RETURN
142ENDIF
143IF (PRESENT(description)) THEN
144 this%description = description
145ELSE
146 this%description = cmiss
147ENDIF
148IF (PRESENT(unit)) THEN
149 this%unit = unit
150ELSE
151 this%unit = cmiss
152ENDIF
153if (present(scalefactor)) then
154 this%scalefactor = scalefactor
155else
156 this%scalefactor = imiss
157endif
158
159this%r = -1
160this%d = -1
161this%i = -1
162this%b = -1
163this%c = -1
164
165END SUBROUTINE vol7d_var_init
166
167
168ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
169CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
170CHARACTER(len=*),INTENT(in),OPTIONAL :: description
171CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
172INTEGER,INTENT(in),OPTIONAL :: scalefactor
173
174TYPE(vol7d_var) :: this
175
176CALL init(this, btable, description, unit, scalefactor)
177
178END FUNCTION vol7d_var_new
179
180
182elemental SUBROUTINE vol7d_var_delete(this)
183TYPE(vol7d_var),INTENT(INOUT) :: this
184
185this%btable = cmiss
186this%description = cmiss
187this%unit = cmiss
188this%scalefactor = imiss
189
190END SUBROUTINE vol7d_var_delete
191
192
193ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
194TYPE(vol7d_var),INTENT(IN) :: this, that
195LOGICAL :: res
196
197res = this%btable == that%btable
198
199END FUNCTION vol7d_var_eq
200
201
202ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
203TYPE(vol7d_var),INTENT(IN) :: this, that
204LOGICAL :: res
205
206res = .NOT.(this == that)
207
208END FUNCTION vol7d_var_ne
209
210
211FUNCTION vol7d_var_nesv(this, that) RESULT(res)
212TYPE(vol7d_var),INTENT(IN) :: this, that(:)
213LOGICAL :: res(SIZE(that))
214
215INTEGER :: i
216
217DO i = 1, SIZE(that)
218 res(i) = .NOT.(this == that(i))
219ENDDO
220
221END FUNCTION vol7d_var_nesv
222
223
224
226subroutine display_var(this)
227
228TYPE(vol7d_var),INTENT(in) :: this
229
230print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
231 " scale factor",this%scalefactor
233end subroutine display_var
237subroutine display_var_vect(this)
239TYPE(vol7d_var),INTENT(in) :: this(:)
240integer :: i
242do i=1,size(this)
243 call display_var(this(i))
244end do
245
246end subroutine display_var_vect
248FUNCTION vol7d_var_c_e(this) RESULT(c_e)
249TYPE(vol7d_var),INTENT(IN) :: this
250LOGICAL :: c_e
251c_e = this /= vol7d_var_miss
252END FUNCTION vol7d_var_c_e
253
263SUBROUTINE vol7d_var_features_init()
264INTEGER :: un, i, n
265TYPE(csv_record) :: csv
266CHARACTER(len=1024) :: line
267
268IF (ALLOCATED(var_features)) RETURN
270un = open_package_file('varbufr.csv', filetype_data)
271n=0
272DO WHILE(.true.)
273 READ(un,*,END=100)
274 n = n + 1
275ENDDO
276
277100 CONTINUE
279rewind(un)
280ALLOCATE(var_features(n))
281
282DO i = 1, n
283 READ(un,'(A)',END=200)line
284 CALL init(csv, line)
285 CALL csv_record_getfield(csv, var_features(i)%var%btable)
286 CALL csv_record_getfield(csv)
287 CALL csv_record_getfield(csv)
288 CALL csv_record_getfield(csv, var_features(i)%posdef)
289 CALL csv_record_getfield(csv, var_features(i)%vartype)
290 CALL delete(csv)
291ENDDO
292
293200 CONTINUE
294CLOSE(un)
295
296END SUBROUTINE vol7d_var_features_init
297
298
302SUBROUTINE vol7d_var_features_delete()
303IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
304END SUBROUTINE vol7d_var_features_delete
305
306
313ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
314TYPE(vol7d_var),INTENT(in) :: this
315INTEGER :: vartype
316
317INTEGER :: i
318
319vartype = imiss
320
321IF (ALLOCATED(var_features)) THEN
322 DO i = 1, SIZE(var_features)
323 IF (this == var_features(i)%var) THEN
324 vartype = var_features(i)%vartype
325 RETURN
326 ENDIF
327 ENDDO
328ENDIF
329
330END FUNCTION vol7d_var_features_vartype
331
332
343ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
344TYPE(vol7d_var),INTENT(in) :: this
345REAL,INTENT(inout) :: val
346
347INTEGER :: i
349IF (ALLOCATED(var_features)) THEN
350 DO i = 1, SIZE(var_features)
351 IF (this == var_features(i)%var) THEN
352 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
353 RETURN
354 ENDIF
355 ENDDO
356ENDIF
357
358END SUBROUTINE vol7d_var_features_posdef_apply
359
360
365ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
366TYPE(vol7d_var),INTENT(in) :: this
367
368INTEGER :: vartype
369
370vartype = var_ord
371SELECT CASE(this%btable)
372CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
373 vartype = var_dir360
374CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
375 vartype = var_press
376CASE('B11003', 'B11200') ! u-component
377 vartype = var_ucomp
378CASE('B11004', 'B11201') ! v-component
379 vartype = var_vcomp
380CASE('B11005', 'B11006') ! w-component
381 vartype = var_wcomp
382END SELECT
383
384END FUNCTION vol7d_vartype
385
386
387#include "array_utilities_inc.F90"
388
389
390END MODULE vol7d_var_class
Index method.
Distruttore per la classe vol7d_var.
display on the screen a brief content of object
Costruttore per la classe vol7d_var.
Utilities for managing files.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:251
Definitions of constants and functions for working with missing values.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Class for interpreting the records of a csv file.
Definisce una variabile meteorologica osservata o un suo attributo.

Generated with Doxygen.