libsim  Versione6.3.0
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/>.
18 MODULE vol7d_serialize_geojson_class
19 use,INTRINSIC :: iso_c_binding
20 USE vol7d_class
24 IMPLICIT NONE
25 
26 type,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
33 END TYPE vol7d_serialize_geojson
34 
35 PRIVATE
36 PUBLIC vol7d_serialize_geojson, vol7d_serialize_geojson_new
37 
38 CONTAINS
39 
40 FUNCTION vol7d_serialize_geojson_new() RESULT(this)
41 TYPE(vol7d_serialize_geojson) :: this
42 
43 this%vol7d_serialize = vol7d_serialize_new()
44 
45 END FUNCTION vol7d_serialize_geojson_new
46 
47 
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
52 
53 IF (present(ext)) THEN
54  this%ext = ext
55 ELSE
56  this%ext = 'geojson'
57 ENDIF
58 
59 ! reset unconditionally some parameters
60 this%column='ana,time,timerange,level,network,var,value'
61 this%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
66 IF (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 
71 END SUBROUTINE vol7d_serialize_optionparser
72 
73 
74 SUBROUTINE vol7d_serialize_parse(this, category)
75 class(vol7d_serialize_geojson),INTENT(inout) :: this
76 INTEGER,INTENT(in),OPTIONAL :: category
77 
78 ! check own parameters
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.')
84  ENDIF
85  CALL raise_error()
86 ENDIF
87 ! call the original method
88 CALL this%vol7d_serialize%vol7d_serialize_parse(category)
89 
90 END SUBROUTINE vol7d_serialize_parse
91 
92 
93 SUBROUTINE vol7d_serialize_export(this, iun)
94 class(vol7d_serialize_geojson),INTENT(inout) :: this
95 INTEGER,INTENT(in),TARGET :: iun
96 
97 INTEGER :: i, l
98 TYPE(vol7d_serialize_iterline) :: linei
99 TYPE(vol7d_serialize_itercol) :: coli
100 
101 WRITE(iun,'(A)')'{"type":"FeatureCollection", "features":['
102 
103 l = 0
104 linei = this%vol7d_serialize_iterline_new()
105 
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)
114 
115 DO 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)')'}}'
132 END DO
133 ! close feature list and featurecollection
134 WRITE(iun,'(A)')']}'
135 
136 END SUBROUTINE vol7d_serialize_export
137 
138 
139 SUBROUTINE vol7d_ana_callback_gj(ana, genericptr)
140 TYPE(vol7d_ana), INTENT(in) :: ana
141 TYPE(c_ptr),value :: genericptr
142 
143 INTEGER,POINTER :: iun
144 REAL(kind=fp_geo) :: l1, l2
145 
146 CALL c_f_pointer(genericptr, iun)
147 
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":{'
151 
152 END SUBROUTINE vol7d_ana_callback_gj
153 
154 
155 SUBROUTINE vol7d_time_callback_gj(time, genericptr)
156 TYPE(datetime), INTENT(in) :: time
157 TYPE(c_ptr),value :: genericptr
158 
159 INTEGER,POINTER :: iun
160 CHARACTER(len=19) :: isodate
161 
162 CALL c_f_pointer(genericptr, iun)
163 
164 IF (time /= datetime_miss) THEN
165  CALL getval(time, isodate=isodate)
166  WRITE(iun,'(A)')'"datetime":"'//trim(isodate)//'",'
167 ELSE
168  WRITE(iun,'(A)')'"datetime":null,'
169 ENDIF
170 
171 END SUBROUTINE vol7d_time_callback_gj
172 
173 
174 SUBROUTINE vol7d_level_callback_gj(level, genericptr)
175 TYPE(vol7d_level), INTENT(in) :: level
176 TYPE(c_ptr),value :: genericptr
177 
178 INTEGER,POINTER :: iun
179 
180 CALL c_f_pointer(genericptr, iun)
181 
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')//','
187 
188 END SUBROUTINE vol7d_level_callback_gj
189 
190 
191 SUBROUTINE vol7d_timerange_callback_gj(timerange, genericptr)
192 TYPE(vol7d_timerange), INTENT(in) :: timerange
193 TYPE(c_ptr),value :: genericptr
194 
195 INTEGER,POINTER :: iun
196 
197 CALL c_f_pointer(genericptr, iun)
198 
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')//','
203 
204 END SUBROUTINE vol7d_timerange_callback_gj
205 
206 
207 SUBROUTINE vol7d_network_callback_gj(network, genericptr)
208 TYPE(vol7d_network), INTENT(in) :: network
209 TYPE(c_ptr),value :: genericptr
210 
211 INTEGER,POINTER :: iun
212 
213 CALL c_f_pointer(genericptr, iun)
214 
215 IF (c_e(network)) THEN
216  WRITE(iun,'(A)')'"network":"'//trim(network%name)//'",'
217 ELSE
218  WRITE(iun,'(A)')'"network":null,'
219 ENDIF
220 
221 END SUBROUTINE vol7d_network_callback_gj
222 
223 
224 SUBROUTINE vol7d_var_callback_gj(var, genericptr)
225 TYPE(vol7d_var), INTENT(in) :: var
226 TYPE(c_ptr),value :: genericptr
227 
228 INTEGER,POINTER :: iun
229 
230 CALL c_f_pointer(genericptr, iun)
231 
232 IF (c_e(var)) THEN
233  WRITE(iun,'(A)')'"bcode":"'//trim(var%btable)//'",'
234 ELSE
235  WRITE(iun,'(A)')'"bcode":null,'
236 ENDIF
237 
238 END SUBROUTINE vol7d_var_callback_gj
239 
240 
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
245 
246 INTEGER,POINTER :: iun
247 
248 CALL c_f_pointer(genericptr, iun)
249 
250 IF (c_e(var) .AND. c_e(attr)) THEN
251  WRITE(iun,'(A)')'"bcode":"'//trim(var%btable)//'.'//trim(attr%btable)//'",'
252 ELSE
253  WRITE(iun,'(A)')'"bcode":null,'
254 ENDIF
255 
256 END SUBROUTINE vol7d_attr_callback_gj
257 
258 
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
263 
264 INTEGER,POINTER :: iun
265 
266 CALL c_f_pointer(genericptr, iun)
267 
268 WRITE(iun,'(A)')'"value":'//t2c(valu, 'null') !//','
269 
270 END SUBROUTINE vol7d_valuer_callback_gj
271 
272 
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
277 
278 INTEGER,POINTER :: iun
279 
280 CALL c_f_pointer(genericptr, iun)
281 
282 WRITE(iun,'(A)')'"value":'//t2c(valu, 'null') !//','
283 
284 END SUBROUTINE vol7d_valued_callback_gj
285 
286 
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
291 
292 INTEGER,POINTER :: iun
293 
294 CALL c_f_pointer(genericptr, iun)
295 
296 IF (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
303 ELSE
304  WRITE(iun,'(A)')'"value":null'
305 ENDIF
306 
307 END SUBROUTINE vol7d_valuei_callback_gj
308 
309 
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
314 
315 CALL vol7d_valuei_callback_gj(int(valu), var, genericptr)
316 
317 END SUBROUTINE vol7d_valueb_callback_gj
318 
319 
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
324 
325 INTEGER,POINTER :: iun
326 
327 CALL c_f_pointer(genericptr, iun)
328 
329 IF (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
336 ELSE
337  WRITE(iun,'(A)')'"value":null'
338 ENDIF
339 
340 END SUBROUTINE vol7d_valuec_callback_gj
341 
342 
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
348 
349 CALL vol7d_valuer_callback_gj(valu, attr, genericptr)
350 
351 END SUBROUTINE vol7d_valuer_attr_callback_gj
352 
353 
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
359 
360 CALL vol7d_valued_callback_gj(valu, attr, genericptr)
361 
362 END SUBROUTINE vol7d_valued_attr_callback_gj
363 
364 
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
370 
371 CALL vol7d_valuei_callback_gj(valu, attr, genericptr)
372 
373 END SUBROUTINE vol7d_valuei_attr_callback_gj
374 
375 
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
381 
382 CALL vol7d_valuei_callback_gj(int(valu), attr, genericptr)
383 
384 END SUBROUTINE vol7d_valueb_attr_callback_gj
385 
386 
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
392 
393 INTEGER,POINTER :: iun
394 
395 CALL vol7d_valuec_callback_gj(valu, attr, genericptr)
396 
397 END SUBROUTINE vol7d_valuec_attr_callback_gj
398 
399 END MODULE vol7d_serialize_geojson_class
Functions that return a trimmed CHARACTER representation of the input variable.
Classe per la gestione di un volume completo di dati osservati.
Module for parsing command-line optons.
Restituiscono il valore dell&#39;oggetto nella forma desiderata.
Extension of vol7d_class for serializing the contents of a volume.
Utilities for CHARACTER variables.
real data conversion
Emit log message for a category with specific priority.

Generated with Doxygen.