libsim Versione 7.2.4
vol7d_serialize_geojson_class.F03
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/>.
18MODULE vol7d_serialize_geojson_class
19use,INTRINSIC :: iso_c_binding
24IMPLICIT NONE
25
26TYPE,EXTENDS(vol7d_serialize) :: vol7d_serialize_geojson
27 PRIVATE
28 CHARACTER(len=8),PUBLIC :: variant='simple'
29 CONTAINS
30 PROCEDURE :: vol7d_serialize_optionparser
31 PROCEDURE :: vol7d_serialize_parse
32 PROCEDURE :: vol7d_serialize_export
33END TYPE vol7d_serialize_geojson
34
35PRIVATE
36PUBLIC vol7d_serialize_geojson, vol7d_serialize_geojson_new
37
38CONTAINS
39
40FUNCTION vol7d_serialize_geojson_new() RESULT(this)
41TYPE(vol7d_serialize_geojson) :: this
42
43this%vol7d_serialize = vol7d_serialize_new()
44
45END FUNCTION vol7d_serialize_geojson_new
46
47
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
52
53IF (PRESENT(ext)) THEN
54 this%ext = ext
55ELSE
56 this%ext = 'geojson'
57ENDIF
58
59! reset unconditionally some parameters
60this%column='ana,time,timerange,level,network,var,value'
61this%loop='time,timerange,level,var,ana,network'
62
63! the generic method is not called since everything has a predefined
64! configuration
65! add a specific parameter
66IF (present(opt)) &
67 CALL optionparser_add(opt, ' ', trim(this%ext)//'-variant', this%variant, &
68 this%variant, &
69 help='variant of geojson output, accepted values are ''simple'' and ''rich''')
70
71END SUBROUTINE vol7d_serialize_optionparser
72
73
74SUBROUTINE vol7d_serialize_parse(this, category)
75CLASS(vol7d_serialize_geojson),INTENT(inout) :: this
76INTEGER,INTENT(in),OPTIONAL :: category
77
78! check own parameters
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.')
84 ENDIF
85 CALL raise_error()
86ENDIF
87! call the original method
88CALL this%vol7d_serialize%vol7d_serialize_parse(category)
89
90END SUBROUTINE vol7d_serialize_parse
91
92
93SUBROUTINE vol7d_serialize_export(this, iun)
94CLASS(vol7d_serialize_geojson),INTENT(inout) :: this
95INTEGER,INTENT(in),TARGET :: iun
96
97INTEGER :: i, l
98TYPE(vol7d_serialize_iterline) :: linei
99TYPE(vol7d_serialize_itercol) :: coli
100
101WRITE(iun,'(A)')'{"type":"FeatureCollection", "features":['
102
103l = 0
104linei = this%vol7d_serialize_iterline_new()
105
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)
114
115DO WHILE(linei%next())
116! open feature
117 IF (l == 0) THEN
118 WRITE(iun,'(A)')'{'
119 ELSE
120 WRITE(iun,'(A)')',{'
121 ENDIF
122 l = l + 1
123
124 i = 0
125 coli = linei%vol7d_serialize_itercol_new()
126 DO WHILE(coli%next())
127 i = i + 1
128 CALL coli%export(c_loc(iun))
129 END DO
130! close property and feature
131 WRITE(iun,'(A)')'}}'
132END DO
133! close feature list and featurecollection
134WRITE(iun,'(A)')']}'
135
136END SUBROUTINE vol7d_serialize_export
137
138
139SUBROUTINE vol7d_ana_callback_gj(ana, genericptr)
140TYPE(vol7d_ana), INTENT(in) :: ana
141TYPE(c_ptr),VALUE :: genericptr
142
143INTEGER,POINTER :: iun
144REAL(kind=fp_geo) :: l1, l2
145
146CALL c_f_pointer(genericptr, iun)
147
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":{'
151
152END SUBROUTINE vol7d_ana_callback_gj
153
154
155SUBROUTINE vol7d_time_callback_gj(time, genericptr)
156TYPE(datetime), INTENT(in) :: time
157TYPE(c_ptr),VALUE :: genericptr
158
159INTEGER,POINTER :: iun
160CHARACTER(len=19) :: isodate
161
162CALL c_f_pointer(genericptr, iun)
163
164IF (time /= datetime_miss) THEN
165 CALL getval(time, isodate=isodate)
166 WRITE(iun,'(A)')'"datetime":"'//trim(isodate)//'",'
167ELSE
168 WRITE(iun,'(A)')'"datetime":null,'
169ENDIF
170
171END SUBROUTINE vol7d_time_callback_gj
172
173
174SUBROUTINE vol7d_level_callback_gj(level, genericptr)
175TYPE(vol7d_level), INTENT(in) :: level
176TYPE(c_ptr),VALUE :: genericptr
177
178INTEGER,POINTER :: iun
179
180CALL c_f_pointer(genericptr, iun)
181
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')//','
187
188END SUBROUTINE vol7d_level_callback_gj
189
190
191SUBROUTINE vol7d_timerange_callback_gj(timerange, genericptr)
192TYPE(vol7d_timerange), INTENT(in) :: timerange
193TYPE(c_ptr),VALUE :: genericptr
194
195INTEGER,POINTER :: iun
196
197CALL c_f_pointer(genericptr, iun)
198
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')//','
203
204END SUBROUTINE vol7d_timerange_callback_gj
205
206
207SUBROUTINE vol7d_network_callback_gj(network, genericptr)
208TYPE(vol7d_network), INTENT(in) :: network
209TYPE(c_ptr),VALUE :: genericptr
210
211INTEGER,POINTER :: iun
212
213CALL c_f_pointer(genericptr, iun)
214
215IF (c_e(network)) THEN
216 WRITE(iun,'(A)')'"network":"'//trim(network%name)//'",'
217ELSE
218 WRITE(iun,'(A)')'"network":null,'
219ENDIF
220
221END SUBROUTINE vol7d_network_callback_gj
222
223
224SUBROUTINE vol7d_var_callback_gj(var, genericptr)
225TYPE(vol7d_var), INTENT(in) :: var
226TYPE(c_ptr),VALUE :: genericptr
227
228INTEGER,POINTER :: iun
229
230CALL c_f_pointer(genericptr, iun)
231
232IF (c_e(var)) THEN
233 WRITE(iun,'(A)')'"bcode":"'//trim(var%btable)//'",'
234ELSE
235 WRITE(iun,'(A)')'"bcode":null,'
236ENDIF
237
238END SUBROUTINE vol7d_var_callback_gj
239
240
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
245
246INTEGER,POINTER :: iun
247
248CALL c_f_pointer(genericptr, iun)
249
250IF (c_e(var) .AND. c_e(attr)) THEN
251 WRITE(iun,'(A)')'"bcode":"'//trim(var%btable)//'.'//trim(attr%btable)//'",'
252ELSE
253 WRITE(iun,'(A)')'"bcode":null,'
254ENDIF
255
256END SUBROUTINE vol7d_attr_callback_gj
257
258
259SUBROUTINE vol7d_valuer_callback_gj(valu, var, genericptr)
260REAL,INTENT(in) :: valu
261TYPE(vol7d_var),INTENT(in) :: var
262TYPE(c_ptr),VALUE :: genericptr
263
264INTEGER,POINTER :: iun
265
266CALL c_f_pointer(genericptr, iun)
267
268WRITE(iun,'(A)')'"value":'//t2c(valu, 'null') !//','
269
270END SUBROUTINE vol7d_valuer_callback_gj
271
272
273SUBROUTINE vol7d_valued_callback_gj(valu, var, genericptr)
274DOUBLE PRECISION,INTENT(in) :: valu
275TYPE(vol7d_var),INTENT(in) :: var
276TYPE(c_ptr),VALUE :: genericptr
277
278INTEGER,POINTER :: iun
279
280CALL c_f_pointer(genericptr, iun)
281
282WRITE(iun,'(A)')'"value":'//t2c(valu, 'null') !//','
283
284END SUBROUTINE vol7d_valued_callback_gj
285
286
287SUBROUTINE vol7d_valuei_callback_gj(valu, var, genericptr)
288INTEGER,INTENT(in) :: valu
289TYPE(vol7d_var),INTENT(in) :: var
290TYPE(c_ptr),VALUE :: genericptr
291
292INTEGER,POINTER :: iun
293
294CALL c_f_pointer(genericptr, iun)
295
296IF (c_e(valu)) THEN
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)) !//','
300 ELSE
301 WRITE(iun,'(A)')'"value":'//t2c(valu) !//','
302 ENDIF
303ELSE
304 WRITE(iun,'(A)')'"value":null'
305ENDIF
306
307END SUBROUTINE vol7d_valuei_callback_gj
308
309
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
314
315CALL vol7d_valuei_callback_gj(int(valu), var, genericptr)
316
317END SUBROUTINE vol7d_valueb_callback_gj
318
319
320SUBROUTINE vol7d_valuec_callback_gj(valu, var, genericptr)
321CHARACTER(len=*),INTENT(in) :: valu
322TYPE(vol7d_var),INTENT(in) :: var
323TYPE(c_ptr),VALUE :: genericptr
324
325INTEGER,POINTER :: iun
326
327CALL c_f_pointer(genericptr, iun)
328
329IF (c_e(valu)) THEN
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)) !//','
333 ELSE
334 WRITE(iun,'(A)')'"value":"'//trim(valu)//'"'
335 ENDIF
336ELSE
337 WRITE(iun,'(A)')'"value":null'
338ENDIF
339
340END SUBROUTINE vol7d_valuec_callback_gj
341
342
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
348
349CALL vol7d_valuer_callback_gj(valu, attr, genericptr)
350
351END SUBROUTINE vol7d_valuer_attr_callback_gj
352
353
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
359
360CALL vol7d_valued_callback_gj(valu, attr, genericptr)
361
362END SUBROUTINE vol7d_valued_attr_callback_gj
363
364
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
370
371CALL vol7d_valuei_callback_gj(valu, attr, genericptr)
372
373END SUBROUTINE vol7d_valuei_attr_callback_gj
374
375
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
381
382CALL vol7d_valuei_callback_gj(int(valu), attr, genericptr)
383
384END SUBROUTINE vol7d_valueb_attr_callback_gj
385
386
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
392
393INTEGER,POINTER :: iun
394
395CALL vol7d_valuec_callback_gj(valu, attr, genericptr)
396
397END SUBROUTINE vol7d_valuec_attr_callback_gj
398
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.
real data conversion
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.

Generated with Doxygen.