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