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

Generated with Doxygen.