18 MODULE vol7d_serialize_geojson_class
19 use,
INTRINSIC :: iso_c_binding
28 CHARACTER(len=8),
PUBLIC :: variant=
'simple' 30 PROCEDURE :: vol7d_serialize_optionparser
31 PROCEDURE :: vol7d_serialize_parse
32 PROCEDURE :: vol7d_serialize_export
33 END TYPE vol7d_serialize_geojson
36 PUBLIC vol7d_serialize_geojson, vol7d_serialize_geojson_new
40 FUNCTION vol7d_serialize_geojson_new()
RESULT(this)
41 TYPE(vol7d_serialize_geojson) :: this
43 this%vol7d_serialize = vol7d_serialize_new()
45 END FUNCTION vol7d_serialize_geojson_new
48 SUBROUTINE vol7d_serialize_optionparser(this, opt, ext)
49 CLASS(vol7d_serialize_geojson),
INTENT(inout) :: this
50 TYPE(optionparser),
INTENT(inout),
OPTIONAL :: opt
51 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: ext
53 IF (
PRESENT(ext))
THEN 60 this%column=
'ana,time,timerange,level,network,var,value' 61 this%loop=
'time,timerange,level,var,ana,network' 69 help=
'variant of geojson output, accepted values are ''simple'' and ''rich''')
71 END SUBROUTINE vol7d_serialize_optionparser
74 SUBROUTINE vol7d_serialize_parse(this, category)
75 CLASS(vol7d_serialize_geojson),
INTENT(inout) :: this
76 INTEGER,
INTENT(in),
OPTIONAL :: category
79 IF (this%variant /=
'simple' .AND. this%variant /=
'rich')
THEN 80 IF (
PRESENT(category))
THEN 81 CALL l4f_category_log(category, l4f_error,
'error in command-line parameters')
82 CALL l4f_category_log(category, l4f_error,
'value '//trim(this%variant)// &
83 ' not valid for --'//trim(this%ext)//
'-variant parameter.')
88 CALL this%vol7d_serialize%vol7d_serialize_parse(category)
90 END SUBROUTINE vol7d_serialize_parse
93 SUBROUTINE vol7d_serialize_export(this, iun)
94 CLASS(vol7d_serialize_geojson),
INTENT(inout) :: this
95 INTEGER,
INTENT(in),
TARGET :: iun
98 TYPE(vol7d_serialize_iterline) :: linei
99 TYPE(vol7d_serialize_itercol) :: coli
101 WRITE(iun,
'(A)')
'{"type":"FeatureCollection", "features":[' 104 linei = this%vol7d_serialize_iterline_new()
106 CALL linei%vol7d_serialize_iterline_set_callback(vol7d_ana_callback_gj, &
107 vol7d_time_callback_gj, vol7d_level_callback_gj, &
108 vol7d_timerange_callback_gj, vol7d_network_callback_gj, &
109 vol7d_var_callback_gj, vol7d_attr_callback_gj, &
110 vol7d_valuer_callback_gj, vol7d_valued_callback_gj, &
111 vol7d_valuei_callback_gj, vol7d_valueb_callback_gj, vol7d_valuec_callback_gj, &
112 vol7d_valuer_attr_callback_gj, vol7d_valued_attr_callback_gj, &
113 vol7d_valuei_attr_callback_gj, vol7d_valueb_attr_callback_gj, vol7d_valuec_attr_callback_gj)
115 DO WHILE(linei%next())
125 coli = linei%vol7d_serialize_itercol_new()
126 DO WHILE(coli%next())
128 CALL coli%export(c_loc(iun))
136 END SUBROUTINE vol7d_serialize_export
139 SUBROUTINE vol7d_ana_callback_gj(ana, genericptr)
140 TYPE(vol7d_ana),
INTENT(in) :: ana
141 TYPE(c_ptr),
VALUE :: genericptr
143 INTEGER,
POINTER :: iun
144 REAL(kind=fp_geo) :: l1, l2
146 CALL c_f_pointer(genericptr, iun)
148 CALL getval(ana%coord, lon=l1, lat=l2)
149 WRITE(iun,
'(A)')
'"type":"Feature", "geometry":{"type":"Point", "coordinates":['//
t2c(l1,
'null')//
', '//
t2c(l2,
'null')//
']},' 150 WRITE(iun,
'(A)')
'"properties":{' 152 END SUBROUTINE vol7d_ana_callback_gj
155 SUBROUTINE vol7d_time_callback_gj(time, genericptr)
156 TYPE(datetime),
INTENT(in) :: time
157 TYPE(c_ptr),
VALUE :: genericptr
159 INTEGER,
POINTER :: iun
160 CHARACTER(len=19) :: isodate
162 CALL c_f_pointer(genericptr, iun)
164 IF (time /= datetime_miss)
THEN 165 CALL getval(time, isodate=isodate)
166 WRITE(iun,
'(A)')
'"datetime":"'//trim(isodate)//
'",' 168 WRITE(iun,
'(A)')
'"datetime":null,' 171 END SUBROUTINE vol7d_time_callback_gj
174 SUBROUTINE vol7d_level_callback_gj(level, genericptr)
175 TYPE(vol7d_level),
INTENT(in) :: level
176 TYPE(c_ptr),
VALUE :: genericptr
178 INTEGER,
POINTER :: iun
180 CALL c_f_pointer(genericptr, iun)
182 WRITE(iun,
'(A,/,A,/,A,/,A)') &
183 '"level_t1":'//
t2c(level%level1,
'null')//
',', &
184 '"level_v1":'//
t2c(level%l1,
'null')//
',', &
185 '"level_t2":'//
t2c(level%level2,
'null')//
',', &
186 '"level_v2":'//
t2c(level%l2,
'null')//
',' 188 END SUBROUTINE vol7d_level_callback_gj
191 SUBROUTINE vol7d_timerange_callback_gj(timerange, genericptr)
192 TYPE(vol7d_timerange),
INTENT(in) :: timerange
193 TYPE(c_ptr),
VALUE :: genericptr
195 INTEGER,
POINTER :: iun
197 CALL c_f_pointer(genericptr, iun)
199 WRITE(iun,
'(A,/,A,/,A)') &
200 '"trange_pind":'//
t2c(timerange%timerange,
'null')//
',', &
201 '"trange_p1":'//
t2c(timerange%p1,
'null')//
',', &
202 '"trange_p2":'//
t2c(timerange%p2,
'null')//
',' 204 END SUBROUTINE vol7d_timerange_callback_gj
207 SUBROUTINE vol7d_network_callback_gj(network, genericptr)
208 TYPE(vol7d_network),
INTENT(in) :: network
209 TYPE(c_ptr),
VALUE :: genericptr
211 INTEGER,
POINTER :: iun
213 CALL c_f_pointer(genericptr, iun)
215 IF (
c_e(network))
THEN 216 WRITE(iun,
'(A)')
'"network":"'//trim(network%name)//
'",' 218 WRITE(iun,
'(A)')
'"network":null,' 221 END SUBROUTINE vol7d_network_callback_gj
224 SUBROUTINE vol7d_var_callback_gj(var, genericptr)
225 TYPE(vol7d_var),
INTENT(in) :: var
226 TYPE(c_ptr),
VALUE :: genericptr
228 INTEGER,
POINTER :: iun
230 CALL c_f_pointer(genericptr, iun)
233 WRITE(iun,
'(A)')
'"bcode":"'//trim(var%btable)//
'",' 235 WRITE(iun,
'(A)')
'"bcode":null,' 238 END SUBROUTINE vol7d_var_callback_gj
241 SUBROUTINE vol7d_attr_callback_gj(var, attr, genericptr)
242 TYPE(vol7d_var),
INTENT(in) :: var
243 TYPE(vol7d_var),
INTENT(in) :: attr
244 TYPE(c_ptr),
VALUE :: genericptr
246 INTEGER,
POINTER :: iun
248 CALL c_f_pointer(genericptr, iun)
250 IF (
c_e(var) .AND.
c_e(attr))
THEN 251 WRITE(iun,
'(A)')
'"bcode":"'//trim(var%btable)//
'.'//trim(attr%btable)//
'",' 253 WRITE(iun,
'(A)')
'"bcode":null,' 256 END SUBROUTINE vol7d_attr_callback_gj
259 SUBROUTINE vol7d_valuer_callback_gj(valu, var, genericptr)
260 REAL,
INTENT(in) :: valu
261 TYPE(vol7d_var),
INTENT(in) :: var
262 TYPE(c_ptr),
VALUE :: genericptr
264 INTEGER,
POINTER :: iun
266 CALL c_f_pointer(genericptr, iun)
268 WRITE(iun,
'(A)')
'"value":'//
t2c(valu,
'null')
270 END SUBROUTINE vol7d_valuer_callback_gj
273 SUBROUTINE vol7d_valued_callback_gj(valu, var, genericptr)
274 DOUBLE PRECISION,
INTENT(in) :: valu
275 TYPE(vol7d_var),
INTENT(in) :: var
276 TYPE(c_ptr),
VALUE :: genericptr
278 INTEGER,
POINTER :: iun
280 CALL c_f_pointer(genericptr, iun)
282 WRITE(iun,
'(A)')
'"value":'//
t2c(valu,
'null')
284 END SUBROUTINE vol7d_valued_callback_gj
287 SUBROUTINE vol7d_valuei_callback_gj(valu, var, genericptr)
288 INTEGER,
INTENT(in) :: valu
289 TYPE(vol7d_var),
INTENT(in) :: var
290 TYPE(c_ptr),
VALUE :: genericptr
292 INTEGER,
POINTER :: iun
294 CALL c_f_pointer(genericptr, iun)
297 IF (
c_e(var%scalefactor) .AND. &
298 .NOT.(var%scalefactor == 0 .AND. var%unit ==
'NUMERIC'))
THEN 299 WRITE(iun,
'(A)')
'"value":'//
t2c(
realdat(valu, var))
301 WRITE(iun,
'(A)')
'"value":'//
t2c(valu)
304 WRITE(iun,
'(A)')
'"value":null' 307 END SUBROUTINE vol7d_valuei_callback_gj
310 SUBROUTINE vol7d_valueb_callback_gj(valu, var, genericptr)
311 INTEGER(kind=int_b),
INTENT(in) :: valu
312 TYPE(vol7d_var),
INTENT(in) :: var
313 TYPE(c_ptr),
VALUE :: genericptr
315 CALL vol7d_valuei_callback_gj(int(valu), var, genericptr)
317 END SUBROUTINE vol7d_valueb_callback_gj
320 SUBROUTINE vol7d_valuec_callback_gj(valu, var, genericptr)
321 CHARACTER(len=*),
INTENT(in) :: valu
322 TYPE(vol7d_var),
INTENT(in) :: var
323 TYPE(c_ptr),
VALUE :: genericptr
325 INTEGER,
POINTER :: iun
327 CALL c_f_pointer(genericptr, iun)
330 IF (
c_e(var%scalefactor) .AND. var%unit /=
'CCITTIA5' .AND. &
331 .NOT.(var%scalefactor == 0 .AND. var%unit ==
'NUMERIC'))
THEN 332 WRITE(iun,
'(A)')
'"value":'//
t2c(
realdat(valu, var))
334 WRITE(iun,
'(A)')
'"value":"'//trim(valu)//
'"' 337 WRITE(iun,
'(A)')
'"value":null' 340 END SUBROUTINE vol7d_valuec_callback_gj
343 SUBROUTINE vol7d_valuer_attr_callback_gj(valu, var, attr, genericptr)
344 REAL,
INTENT(in) :: valu
345 TYPE(vol7d_var),
INTENT(in) :: var
346 TYPE(vol7d_var),
INTENT(in) :: attr
347 TYPE(c_ptr),
VALUE :: genericptr
349 CALL vol7d_valuer_callback_gj(valu, attr, genericptr)
351 END SUBROUTINE vol7d_valuer_attr_callback_gj
354 SUBROUTINE vol7d_valued_attr_callback_gj(valu, var, attr, genericptr)
355 DOUBLE PRECISION,
INTENT(in) :: valu
356 TYPE(vol7d_var),
INTENT(in) :: var
357 TYPE(vol7d_var),
INTENT(in) :: attr
358 TYPE(c_ptr),
VALUE :: genericptr
360 CALL vol7d_valued_callback_gj(valu, attr, genericptr)
362 END SUBROUTINE vol7d_valued_attr_callback_gj
365 SUBROUTINE vol7d_valuei_attr_callback_gj(valu, var, attr, genericptr)
366 INTEGER,
INTENT(in) :: valu
367 TYPE(vol7d_var),
INTENT(in) :: var
368 TYPE(vol7d_var),
INTENT(in) :: attr
369 TYPE(c_ptr),
VALUE :: genericptr
371 CALL vol7d_valuei_callback_gj(valu, attr, genericptr)
373 END SUBROUTINE vol7d_valuei_attr_callback_gj
376 SUBROUTINE vol7d_valueb_attr_callback_gj(valu, var, attr, genericptr)
377 INTEGER(kind=int_b),
INTENT(in) :: valu
378 TYPE(vol7d_var),
INTENT(in) :: var
379 TYPE(vol7d_var),
INTENT(in) :: attr
380 TYPE(c_ptr),
VALUE :: genericptr
382 CALL vol7d_valuei_callback_gj(int(valu), attr, genericptr)
384 END SUBROUTINE vol7d_valueb_attr_callback_gj
387 SUBROUTINE vol7d_valuec_attr_callback_gj(valu, var, attr, genericptr)
388 CHARACTER(len=*),
INTENT(in) :: valu
389 TYPE(vol7d_var),
INTENT(in) :: var
390 TYPE(vol7d_var),
INTENT(in) :: attr
391 TYPE(c_ptr),
VALUE :: genericptr
393 INTEGER,
POINTER :: iun
395 CALL vol7d_valuec_callback_gj(valu, attr, genericptr)
397 END SUBROUTINE vol7d_valuec_attr_callback_gj
399 END MODULE vol7d_serialize_geojson_class
Extension of vol7d_class for serializing the contents of a volume.
Set of functions that return a trimmed CHARACTER representation of the input variable.
Module for parsing command-line optons.
Test for a missing volume.
Classe per la gestione di un volume completo di dati osservati.
Class for serializing a vol7d object.
Utilities for CHARACTER variables.
Add a new option of a specific type.