libsim Versione 7.2.6
vol7d_serialize_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
19!> Extension of vol7d_class for serializing the contents of a volume.
20!! This module defines a class which allows to iterate over all the
21!! elements of a vol7d object and call specific callbacks for every
22!! element encountered. The default callbacks provided generate a csv
23!! representation of the volume, but che class can be extended in
24!! F2003 sense and the callbacks can be redefined in order to obtain a
25!! fully configurable serialized output from a vol7d object.
26!!
27!! \ingroup vol7d
29use,INTRINSIC :: iso_c_binding
35IMPLICIT NONE
36
37TYPE vol7d_var_mapper
38 INTEGER :: cat
39 INTEGER :: typ
40 INTEGER :: i5, i7
41END TYPE vol7d_var_mapper
42
43
44!> Class for serializing a vol7d object.
45!! Configurable components are PUBLIC, while the others are PRIVATE and undocumented.
47 PRIVATE
48 CHARACTER(len=512),PUBLIC :: column='time,timerange,ana,level,network' !< columns that appear in output
49 CHARACTER(len=512),PUBLIC :: loop='time,timerange,ana,level,network' !< order of looping on vol7d descriptors, var is optional, all the others are compulsory
50 CHARACTER(len=512),PUBLIC :: variable='all' !< list of variables to output, or 'all'
51 CHARACTER(len=8),PUBLIC :: ext = 'ser' !< extension to use for command-line arguments
52 LOGICAL,PUBLIC :: keep_miss=.false. !< keep in output the elements with all missing data
53 LOGICAL,PUBLIC :: no_rescale=.false. !< do not rescale integer values in output
54 LOGICAL,PUBLIC :: cachedesc=.false. !< cache descriptors that do not change from one line to the next
55 LOGICAL,PUBLIC :: anaonly=.false. !< export only station volumes
56 LOGICAL,PUBLIC :: dataonly=.false. !< export only data volumes
57 LOGICAL :: anavol=.false.
58 INTEGER :: ndvar=5
59 INTEGER :: icolumn(7), looporder(6), loopinvorder(6), &
60 loopstart(6), loopend(6)
61 TYPE(vol7d_var_mapper),ALLOCATABLE :: mapper(:)
62 TYPE(vol7d),POINTER,public :: v7d=>null()
63 PROCEDURE(default_vol7d_ana_header_callback),NOPASS,POINTER :: vol7d_ana_callback
64 PROCEDURE(default_vol7d_time_header_callback),NOPASS,POINTER :: vol7d_time_callback
65 PROCEDURE(default_vol7d_level_header_callback),NOPASS,POINTER :: vol7d_level_callback
66 PROCEDURE(default_vol7d_timerange_header_callback),NOPASS,POINTER :: vol7d_timerange_callback
67 PROCEDURE(default_vol7d_network_header_callback),NOPASS,POINTER :: vol7d_network_callback
68 PROCEDURE(default_vol7d_var_header_callback),NOPASS,POINTER :: vol7d_var_callback
69 PROCEDURE(default_vol7d_val_header_callback),NOPASS,POINTER :: vol7d_val_callback
70 PROCEDURE(default_vol7d_value_var_header_callback),NOPASS,POINTER :: vol7d_value_var_callback
71 PROCEDURE(default_vol7d_value_attr_header_callback),NOPASS,POINTER :: vol7d_value_attr_callback
72 CONTAINS
73 PROCEDURE :: vol7d_serialize_optionparser
74 PROCEDURE :: vol7d_serialize_parse
75 PROCEDURE :: vol7d_serialize_setup
76 PROCEDURE :: vol7d_serialize_set_callback
77 PROCEDURE :: vol7d_serialize_iterline_new
78 PROCEDURE,PRIVATE :: vol7d_serialize_itercol_new_ser
79 generic :: vol7d_serialize_itercol_new=>vol7d_serialize_itercol_new_ser
80END TYPE vol7d_serialize
81
82!> Iterator object for iterating over "lines" in a vol7d serialization.
83!! All the components are private. An object of this class is
84!! constructed starting from a \a vol7d_serialize object as a result of
85!! the \a vol7d_serialize_itercol_new() function method.
87 PRIVATE
88 CLASS(vol7d_serialize),POINTER :: ser=>null()
89 INTEGER :: loopind(6)
90 INTEGER :: status=0
91 INTEGER :: i1, i2, i3, i4, i5, i6
92 INTEGER :: lastind(6)=0
93 LOGICAL :: analine
94 PROCEDURE(default_vol7d_ana_callback),NOPASS,POINTER :: vol7d_ana_callback
95 PROCEDURE(default_vol7d_time_callback),NOPASS,POINTER :: vol7d_time_callback
96 PROCEDURE(default_vol7d_level_callback),NOPASS,POINTER :: vol7d_level_callback
97 PROCEDURE(default_vol7d_timerange_callback),NOPASS,POINTER :: vol7d_timerange_callback
98 PROCEDURE(default_vol7d_network_callback),NOPASS,POINTER :: vol7d_network_callback
99 PROCEDURE(default_vol7d_var_callback),NOPASS,POINTER :: vol7d_var_callback
100 PROCEDURE(default_vol7d_attr_callback),NOPASS,POINTER :: vol7d_attr_callback
101 PROCEDURE(default_vol7d_valuer_var_callback),NOPASS,POINTER :: vol7d_valuer_var_callback
102 PROCEDURE(default_vol7d_valued_var_callback),NOPASS,POINTER :: vol7d_valued_var_callback
103 PROCEDURE(default_vol7d_valuei_var_callback),NOPASS,POINTER :: vol7d_valuei_var_callback
104 PROCEDURE(default_vol7d_valueb_var_callback),NOPASS,POINTER :: vol7d_valueb_var_callback
105 PROCEDURE(default_vol7d_valuec_var_callback),NOPASS,POINTER :: vol7d_valuec_var_callback
106 PROCEDURE(default_vol7d_valuer_attr_callback),NOPASS,POINTER :: vol7d_valuer_attr_callback
107 PROCEDURE(default_vol7d_valued_attr_callback),NOPASS,POINTER :: vol7d_valued_attr_callback
108 PROCEDURE(default_vol7d_valuei_attr_callback),NOPASS,POINTER :: vol7d_valuei_attr_callback
109 PROCEDURE(default_vol7d_valueb_attr_callback),NOPASS,POINTER :: vol7d_valueb_attr_callback
110 PROCEDURE(default_vol7d_valuec_attr_callback),NOPASS,POINTER :: vol7d_valuec_attr_callback
111 CONTAINS
112 PROCEDURE :: vol7d_serialize_iterline_set_callback
113 PROCEDURE,PRIVATE :: vol7d_serialize_iterline_next
114 generic :: next=>vol7d_serialize_iterline_next
115 PROCEDURE,PRIVATE :: vol7d_serialize_itercol_new_line
116 generic :: vol7d_serialize_itercol_new=>vol7d_serialize_itercol_new_line
118
119!> Iterator object for iterating over "column" of a line in a vol7d serialization.
120!! All the components are private. An object of this class is
121!! constructed either starting from a \a vol7d_serialize
122!! object (iterator over "header" columns) or from \a
123!! vol7d_serialize_iterline object (iterator over "body" columns) as
124!! a result of \a the vol7d_serialize_itercol_new() function method.
126 PRIVATE
127 CLASS(vol7d_serialize),POINTER :: ser=>null()
128 CLASS(vol7d_serialize_iterline),POINTER :: line=>null()
129 INTEGER :: i=0, iend=-1
130 LOGICAL :: forcemiss=.false.
131 CONTAINS
132 PROCEDURE,PRIVATE :: vol7d_serialize_itercol_next
133 generic :: next=>vol7d_serialize_itercol_next
134 PROCEDURE,PRIVATE :: vol7d_serialize_itercol_call
135 generic :: export=>vol7d_serialize_itercol_call
137
138PRIVATE
139PUBLIC vol7d_serialize, vol7d_serialize_new, &
141
142CONTAINS
143
144!> Constructor for the vol7d_serialize class.
145!! It has to be called when creating a new object for the sole purpose
146!! of initializing the callbacks to default, which cannot be done
147!! implicitly until a F2008 compiler is available.
148FUNCTION vol7d_serialize_new() RESULT(this)
149TYPE(vol7d_serialize) :: this
150
151! these cannot be done in the class definition until F2008 pointer
152! initialization
153this%vol7d_ana_callback => default_vol7d_ana_header_callback
154this%vol7d_time_callback => default_vol7d_time_header_callback
155this%vol7d_level_callback => default_vol7d_level_header_callback
156this%vol7d_timerange_callback => default_vol7d_timerange_header_callback
157this%vol7d_network_callback => default_vol7d_network_header_callback
158this%vol7d_var_callback => default_vol7d_var_header_callback
159this%vol7d_val_callback => default_vol7d_val_header_callback
160this%vol7d_value_var_callback => default_vol7d_value_var_header_callback
161this%vol7d_value_attr_callback => default_vol7d_value_attr_header_callback
162
163END FUNCTION vol7d_serialize_new
164
165
166!> Method for adding the standard vol7d_serialize command-line options
167!! to a program.
168!! An initialised object of the optionparser class is used for adding
169!! the relevant options, an extension is provided for formatting the
170!! options and the help messages. Alternatively the configurable
171!! options can be set directly since the corresponding members in the
172!! \a vol7d_serialize class are PUBLIC. In both cases the \a
173!! vol7d_serialize_parse method must be successively called in order
174!! to process the configurable options.
175SUBROUTINE vol7d_serialize_optionparser(this, opt, ext)
176CLASS(vol7d_serialize),INTENT(inout) :: this
177TYPE(optionparser),INTENT(inout),OPTIONAL :: opt
178CHARACTER(len=*),INTENT(in),OPTIONAL :: ext
179
180IF (PRESENT(ext)) this%ext = ext
181
182IF (PRESENT(opt)) THEN
183!CALL optionparser_add(opt, ' ', TRIM(this%ext)//'-volume', this%volume, &
184! this%volume, help= &
185! 'vol7d volumes to be output to csv: ''all'' for all volumes, &
186! &''ana'' for station volumes only or ''data'' for data volumes only')
187 CALL optionparser_add(opt, ' ', trim(this%ext)//'-column', this%column, &
188 this%column, help= &
189 'list of columns that have to appear in csv output: &
190 &a comma-separated selection of ''time,timerange,level,ana,network,var,value'' &
191 &in the desired order')
192 CALL optionparser_add(opt, ' ', trim(this%ext)//'-loop', this%loop, &
193 this%loop, help= &
194 'order of looping on descriptors in csv output: &
195 &a comma-separated selection of ''time,timerange,level,ana,network,var'' &
196 &in the desired order, all the identifiers must be present, except ''var'', &
197 &which, if present, enables looping on variables and attributes as well')
198 CALL optionparser_add(opt, ' ', trim(this%ext)//'-variable', this%variable, &
199 this%variable, help= &
200 'list of variables that have to appear in the data columns of csv output: &
201 &''all'' or a comma-separated list of B-table alphanumeric codes, e.g. &
202 &''B10004,B12101'' in the desired order')
203 CALL optionparser_add(opt, ' ', trim(this%ext)//'-keep-miss', this%keep_miss, &
204 help='keep records containing only missing values in csv output, &
205 &normally they are discarded')
206 CALL optionparser_add(opt, ' ', trim(this%ext)//'-norescale', this%no_rescale, &
207 help='do not rescale in output integer variables according to their &
208 &scale factor')
209ENDIF
210
211END SUBROUTINE vol7d_serialize_optionparser
212
213
214!> Method for parsing the command-line options provided.
215!! It must be called after the call to optionparser_parse in order to
216!! validate the options relevant to vol7d_serialize, in case of errors
217!! the raise_error subroutine is called, with possible program abort.
218!! It should be called also in case the configurable parameters are
219!! set directly rather than through command-line.
220SUBROUTINE vol7d_serialize_parse(this, category)
221CLASS(vol7d_serialize),INTENT(inout) :: this !< object having undorgone the vol7d_serialize_optionparser method
222INTEGER,INTENT(in),OPTIONAL :: category !< log4fortran category for logging error messages
223
224CALL parse_v7d_column(this%column, this%icolumn, '--'//trim(this%ext)//'-column', &
225 .false., category)
226CALL parse_v7d_column(this%loop, this%looporder, '--'//trim(this%ext)//'-loop', &
227 .true., category)
228
229END SUBROUTINE vol7d_serialize_parse
230
231
232! internal sobroutine to parse a string like
233! 'time,timerange,level,ana,network,var,value' (ccol) transforming
234! into an integer array of the corresponding PARAMETER values defined
235! in vol7d_class (icol)
236SUBROUTINE parse_v7d_column(ccol, icol, par_name, check_all, category)
237CHARACTER(len=*),INTENT(in) :: ccol
238INTEGER,INTENT(out) :: icol(:)
239CHARACTER(len=*),INTENT(in) :: par_name
240LOGICAL,INTENT(in) :: check_all
241INTEGER,INTENT(in),OPTIONAL :: category
242
243INTEGER :: i, j, nc
244INTEGER,POINTER :: w_s(:), w_e(:)
245
246nc = word_split(ccol, w_s, w_e, ',')
247j = 0
248icol(:) = -1
249DO i = 1, min(nc, SIZE(icol))
250 SELECT CASE(ccol(w_s(i):w_e(i)))
251 CASE('time')
252 j = j + 1
253 icol(j) = vol7d_time_d
254 CASE('timerange')
255 j = j + 1
256 icol(j) = vol7d_timerange_d
257 CASE('level')
258 j = j + 1
259 icol(j) = vol7d_level_d
260 CASE('ana')
261 j = j + 1
262 icol(j) = vol7d_ana_d
263 CASE('var')
264 j = j + 1
265 icol(j) = vol7d_var_d
266 CASE('network')
267 j = j + 1
268 icol(j) = vol7d_network_d
269 CASE('value')
270 j = j + 1
271 icol(j) = 7
272 CASE default
273 IF (PRESENT(category)) THEN
274 CALL l4f_category_log(category, l4f_error, &
275 'error in command-line parameters, column '// &
276 ccol(w_s(i):w_e(i))//' in '//trim(par_name)//' not valid.')
277 ENDIF
278 CALL raise_error()
279 END SELECT
280ENDDO
281nc = j
282DEALLOCATE(w_s, w_e)
283
284IF (check_all) THEN
285 IF (all(icol /= vol7d_time_d) .OR. all(icol /= vol7d_timerange_d) .OR. &
286 all(icol /= vol7d_level_d) .OR. all(icol /= vol7d_ana_d) .OR. &
287 all(icol /= vol7d_network_d)) THEN
288 IF (PRESENT(category)) THEN
289 CALL l4f_category_log(category, l4f_error, &
290 'error in command-line parameters, some columns missing in '// &
291 trim(par_name)//' .')
292 ENDIF
293 CALL raise_error()
294 ENDIF
295 IF (any(icol == 7)) THEN
296 IF (PRESENT(category)) THEN
297 CALL l4f_category_log(category,l4f_error,"column 'value' not valid in "// &
298 trim(par_name)//' .')
299 ENDIF
300 CALL raise_error()
301 ENDIF
302ENDIF
303
304END SUBROUTINE parse_v7d_column
305
306
307SUBROUTINE vol7d_serialize_set_callback(this, vol7d_ana_callback, &
308 vol7d_time_callback, vol7d_level_callback, &
309 vol7d_timerange_callback, vol7d_network_callback, &
310 vol7d_var_callback, vol7d_val_callback, vol7d_value_var_callback, &
311 vol7d_value_attr_callback)
312CLASS(vol7d_serialize),INTENT(inout) :: this
313PROCEDURE(default_vol7d_ana_header_callback),OPTIONAL :: vol7d_ana_callback
314PROCEDURE(default_vol7d_time_header_callback),OPTIONAL :: vol7d_time_callback
315PROCEDURE(default_vol7d_level_header_callback),OPTIONAL :: vol7d_level_callback
316PROCEDURE(default_vol7d_timerange_header_callback),OPTIONAL :: vol7d_timerange_callback
317PROCEDURE(default_vol7d_network_header_callback),OPTIONAL :: vol7d_network_callback
318PROCEDURE(default_vol7d_var_header_callback),OPTIONAL :: vol7d_var_callback
319PROCEDURE(default_vol7d_val_header_callback),OPTIONAL :: vol7d_val_callback
320PROCEDURE(default_vol7d_value_var_header_callback),OPTIONAL :: vol7d_value_var_callback
321PROCEDURE(default_vol7d_value_attr_header_callback),OPTIONAL :: vol7d_value_attr_callback
322
323IF (PRESENT(vol7d_ana_callback)) this%vol7d_ana_callback => vol7d_ana_callback
324IF (PRESENT(vol7d_time_callback)) this%vol7d_time_callback => vol7d_time_callback
325IF (PRESENT(vol7d_level_callback)) this%vol7d_level_callback => vol7d_level_callback
326IF (PRESENT(vol7d_timerange_callback)) this%vol7d_timerange_callback => vol7d_timerange_callback
327IF (PRESENT(vol7d_network_callback)) this%vol7d_network_callback => vol7d_network_callback
328IF (PRESENT(vol7d_var_callback)) this%vol7d_var_callback => vol7d_var_callback
329IF (PRESENT(vol7d_val_callback)) this%vol7d_val_callback => vol7d_val_callback
330IF (PRESENT(vol7d_value_var_callback)) this%vol7d_value_var_callback => vol7d_value_var_callback
331IF (PRESENT(vol7d_value_attr_callback)) this%vol7d_value_attr_callback => vol7d_value_attr_callback
332
333END SUBROUTINE vol7d_serialize_set_callback
334
335
336SUBROUTINE vol7d_serialize_iterline_set_callback(this, vol7d_ana_callback, &
337 vol7d_time_callback, vol7d_level_callback, &
338 vol7d_timerange_callback, vol7d_network_callback, &
339 vol7d_var_callback, vol7d_attr_callback, vol7d_valuer_var_callback, &
340 vol7d_valued_var_callback, vol7d_valuei_var_callback, vol7d_valueb_var_callback, &
341 vol7d_valuec_var_callback, &
342 vol7d_valuer_attr_callback, &
343 vol7d_valued_attr_callback, vol7d_valuei_attr_callback, vol7d_valueb_attr_callback, &
344 vol7d_valuec_attr_callback)
345CLASS(vol7d_serialize_iterline),INTENT(inout) :: this
346PROCEDURE(default_vol7d_ana_callback),OPTIONAL :: vol7d_ana_callback
347PROCEDURE(default_vol7d_time_callback),OPTIONAL :: vol7d_time_callback
348PROCEDURE(default_vol7d_level_callback),OPTIONAL :: vol7d_level_callback
349PROCEDURE(default_vol7d_timerange_callback),OPTIONAL :: vol7d_timerange_callback
350PROCEDURE(default_vol7d_network_callback),OPTIONAL :: vol7d_network_callback
351PROCEDURE(default_vol7d_var_callback),OPTIONAL :: vol7d_var_callback
352PROCEDURE(default_vol7d_attr_callback),OPTIONAL :: vol7d_attr_callback
353PROCEDURE(default_vol7d_valuer_var_callback),OPTIONAL :: vol7d_valuer_var_callback
354PROCEDURE(default_vol7d_valued_var_callback),OPTIONAL :: vol7d_valued_var_callback
355PROCEDURE(default_vol7d_valuei_var_callback),OPTIONAL :: vol7d_valuei_var_callback
356PROCEDURE(default_vol7d_valueb_var_callback),OPTIONAL :: vol7d_valueb_var_callback
357PROCEDURE(default_vol7d_valuec_var_callback),OPTIONAL :: vol7d_valuec_var_callback
358PROCEDURE(default_vol7d_valuer_attr_callback),OPTIONAL :: vol7d_valuer_attr_callback
359PROCEDURE(default_vol7d_valued_attr_callback),OPTIONAL :: vol7d_valued_attr_callback
360PROCEDURE(default_vol7d_valuei_attr_callback),OPTIONAL :: vol7d_valuei_attr_callback
361PROCEDURE(default_vol7d_valueb_attr_callback),OPTIONAL :: vol7d_valueb_attr_callback
362PROCEDURE(default_vol7d_valuec_attr_callback),OPTIONAL :: vol7d_valuec_attr_callback
363
364IF (PRESENT(vol7d_ana_callback)) this%vol7d_ana_callback => vol7d_ana_callback
365IF (PRESENT(vol7d_time_callback)) this%vol7d_time_callback => vol7d_time_callback
366IF (PRESENT(vol7d_level_callback)) this%vol7d_level_callback => vol7d_level_callback
367IF (PRESENT(vol7d_timerange_callback)) this%vol7d_timerange_callback => vol7d_timerange_callback
368IF (PRESENT(vol7d_network_callback)) this%vol7d_network_callback => vol7d_network_callback
369IF (PRESENT(vol7d_var_callback)) this%vol7d_var_callback => vol7d_var_callback
370IF (PRESENT(vol7d_attr_callback)) this%vol7d_attr_callback => vol7d_attr_callback
371IF (PRESENT(vol7d_valuer_var_callback)) this%vol7d_valuer_var_callback => vol7d_valuer_var_callback
372IF (PRESENT(vol7d_valued_var_callback)) this%vol7d_valued_var_callback => vol7d_valued_var_callback
373IF (PRESENT(vol7d_valuei_var_callback)) this%vol7d_valuei_var_callback => vol7d_valuei_var_callback
374IF (PRESENT(vol7d_valueb_var_callback)) this%vol7d_valueb_var_callback => vol7d_valueb_var_callback
375IF (PRESENT(vol7d_valuec_var_callback)) this%vol7d_valuec_var_callback => vol7d_valuec_var_callback
376IF (PRESENT(vol7d_valuer_attr_callback)) this%vol7d_valuer_attr_callback => vol7d_valuer_attr_callback
377IF (PRESENT(vol7d_valued_attr_callback)) this%vol7d_valued_attr_callback => vol7d_valued_attr_callback
378IF (PRESENT(vol7d_valuei_attr_callback)) this%vol7d_valuei_attr_callback => vol7d_valuei_attr_callback
379IF (PRESENT(vol7d_valueb_attr_callback)) this%vol7d_valueb_attr_callback => vol7d_valueb_attr_callback
380IF (PRESENT(vol7d_valuec_attr_callback)) this%vol7d_valuec_attr_callback => vol7d_valuec_attr_callback
381
382END SUBROUTINE vol7d_serialize_iterline_set_callback
383
384
385SUBROUTINE vol7d_serialize_setup(this, v7d)
386CLASS(vol7d_serialize),INTENT(inout) :: this
387TYPE(vol7d),INTENT(in),TARGET :: v7d
388
389INTEGER :: nv, nav, ndv, i, j, n
390INTEGER,POINTER :: w_s(:), w_e(:)
391TYPE(vol7d_var_mapper),ALLOCATABLE :: mapper_tmp(:)
392
393!!CALL vol7d_alloc_vol(v7d) ! be safe
394this%v7d => v7d
395
396! Eliminate together with checkvarvect if the next section works well!!!
397! Filter requested variables
398!IF (this%variable /= 'all') THEN
399! nv = word_split(this%variable, w_s, w_e, ',')
400! CALL checkvarvect(v7d%anavar)
401! CALL checkvarvect(v7d%anaattr)
402! CALL checkvarvect(v7d%anavarattr)
403! CALL checkvarvect(v7d%dativar)
404! CALL checkvarvect(v7d%datiattr)
405! CALL checkvarvect(v7d%dativarattr)
406! CALL vol7d_reform(v7d, miss=.TRUE.) ! sort?
407! DEALLOCATE(w_s, w_e)
408!ENDIF
409
410CALL var_mapper(this%mapper, v7d, this%anaonly, this%dataonly)
411
412! Filter and sort requested variables
413IF (this%variable /= 'all') THEN
414 nv = word_split(this%variable, w_s, w_e, ',')
415 ALLOCATE(mapper_tmp(nv))
416 j = 0
417 DO i = 1, nv
418 n = var_mapper_searchvar(this%mapper, v7d, &
419 vol7d_var_new(btable=this%variable(w_s(i):w_e(i))))
420 IF (n > 0) THEN
421 j = j + 1
422 mapper_tmp(j) = this%mapper(n)
423 ENDIF
424 ENDDO
425 DEALLOCATE(this%mapper) ! why must I do these dealloc/alloc with gfortran??
426 ALLOCATE(this%mapper(j)) ! -fcheck-bounds complains otherwise!!
427 this%mapper = mapper_tmp(1:j)
428 DEALLOCATE(w_s, w_e)
429ENDIF
430
431! If only ana volume, skip data-only dimensions
432IF (SIZE(v7d%time) == 0) THEN
433 WHERE (this%icolumn(:) == vol7d_time_d)
434 this%icolumn(:) = -1
435 END WHERE
436ENDIF
437IF (SIZE(v7d%level) == 0) THEN
438 WHERE (this%icolumn(:) == vol7d_level_d)
439 this%icolumn(:) = -1
440 END WHERE
441ENDIF
442IF (SIZE(v7d%timerange) == 0) THEN
443 WHERE (this%icolumn(:) == vol7d_timerange_d)
444 this%icolumn(:) = -1
445 END WHERE
446ENDIF
447this%anavol = SIZE(v7d%time) == 0 .AND. SIZE(v7d%level) == 0 .AND. &
448 SIZE(v7d%timerange) == 0
449
450nav = count(this%mapper(:)%cat == 1)
451ndv = count(this%mapper(:)%cat == 3)
452
453! For column reordering
454this%loopstart(:) = 1
455this%loopend(:) = 0
456WHERE (this%looporder(:) == vol7d_ana_d)
457 this%loopend(:) = SIZE(v7d%ana)
458END WHERE
459WHERE (this%looporder(:) == vol7d_time_d)
460 this%loopend(:) = SIZE(v7d%time)
461END WHERE
462WHERE (this%looporder(:) == vol7d_level_d)
463 this%loopend(:) = SIZE(v7d%level)
464END WHERE
465WHERE (this%looporder(:) == vol7d_timerange_d)
466 this%loopend(:) = SIZE(v7d%timerange)
467END WHERE
468WHERE (this%looporder(:) == vol7d_var_d)
469 this%loopend(:) = SIZE(this%mapper)
470END WHERE
471WHERE (this%looporder(:) == vol7d_network_d)
472 this%loopend(:) = SIZE(v7d%network)
473END WHERE
474
475! invert this%looporder
476this%loopinvorder(vol7d_ana_d) = firsttrue(this%looporder(:) == vol7d_ana_d)
477this%loopinvorder(vol7d_time_d) = firsttrue(this%looporder(:) == vol7d_time_d)
478this%loopinvorder(vol7d_level_d) = firsttrue(this%looporder(:) == vol7d_level_d)
479this%loopinvorder(vol7d_timerange_d) = firsttrue(this%looporder(:) == vol7d_timerange_d)
480this%loopinvorder(vol7d_var_d) = firsttrue(this%looporder(:) == vol7d_var_d)
481this%loopinvorder(vol7d_network_d) = firsttrue(this%looporder(:) == vol7d_network_d)
482! there should not be missing columns here except
483! this%loopinvorder(vol7d_var_d) thanks to the check in
484! parse_v7d_column
485IF (this%loopinvorder(vol7d_var_d) <= 0) THEN
486 this%ndvar = 5
487ELSE
488 this%ndvar = 6
489ENDIF
490
491CONTAINS
492
493SUBROUTINE checkvarvect(varvect)
494TYPE(vol7d_varvect),INTENT(inout) :: varvect
495
496CALL checkvar(varvect%r)
497CALL checkvar(varvect%d)
498CALL checkvar(varvect%i)
499CALL checkvar(varvect%b)
500CALL checkvar(varvect%c)
501
502END SUBROUTINE checkvarvect
503
504SUBROUTINE checkvar(var)
505TYPE(vol7d_var),POINTER :: var(:)
506
507INTEGER :: i, j
508
509IF (.NOT.ASSOCIATED(var)) RETURN
510
511v7dvarloop: DO i = 1, SIZE(var)
512 csvvarloop: DO j = 1, nv
513 IF (var(i)%btable == this%variable(w_s(j):w_e(j))) THEN
514 cycle v7dvarloop
515 ENDIF
516 ENDDO csvvarloop
517 var(i) = vol7d_var_miss ! var not found, nullify
518ENDDO v7dvarloop
519
520END SUBROUTINE checkvar
521
522END SUBROUTINE vol7d_serialize_setup
523
524
525FUNCTION vol7d_serialize_iterline_new(this) RESULT(iterator)
526CLASS(vol7d_serialize),INTENT(in),TARGET :: this
527TYPE(vol7d_serialize_iterline) :: iterator
528
529iterator%ser => this
530iterator%loopind(:) = this%loopstart(:)
531! these cannot be done in the class definition until F2008 pointer
532! initialization
533iterator%vol7d_ana_callback => default_vol7d_ana_callback
534iterator%vol7d_time_callback => default_vol7d_time_callback
535iterator%vol7d_level_callback => default_vol7d_level_callback
536iterator%vol7d_timerange_callback => default_vol7d_timerange_callback
537iterator%vol7d_network_callback => default_vol7d_network_callback
538iterator%vol7d_var_callback => default_vol7d_var_callback
539iterator%vol7d_attr_callback => default_vol7d_attr_callback
540iterator%vol7d_valuer_var_callback => default_vol7d_valuer_var_callback
541iterator%vol7d_valued_var_callback => default_vol7d_valued_var_callback
542iterator%vol7d_valuei_var_callback => default_vol7d_valuei_var_callback
543iterator%vol7d_valueb_var_callback => default_vol7d_valueb_var_callback
544iterator%vol7d_valuec_var_callback => default_vol7d_valuec_var_callback
545iterator%vol7d_valuer_attr_callback => default_vol7d_valuer_attr_callback
546iterator%vol7d_valued_attr_callback => default_vol7d_valued_attr_callback
547iterator%vol7d_valuei_attr_callback => default_vol7d_valuei_attr_callback
548iterator%vol7d_valueb_attr_callback => default_vol7d_valueb_attr_callback
549iterator%vol7d_valuec_attr_callback => default_vol7d_valuec_attr_callback
550
551END FUNCTION vol7d_serialize_iterline_new
552
553
554FUNCTION vol7d_serialize_iterline_next(this) RESULT(next)
555CLASS(vol7d_serialize_iterline),INTENT(inout) :: this
556LOGICAL :: next
557
558INTEGER :: i
559LOGICAL :: colmask(6)
560
561IF (.NOT.ASSOCIATED(this%ser)) THEN ! safety check
562 this%status = 3
563 next = .false.
564 RETURN
565ENDIF
566
567loop7d: DO WHILE(.true.)
568
569 IF (this%status == 0) THEN ! first iteration
570 this%status = 1
571! safety check for empty volumes
572 colmask = .true.
573 IF (this%ser%anavol) THEN
574! mask non ana columns
575 colmask(this%ser%loopinvorder(vol7d_time_d)) = .false.
576 colmask(this%ser%loopinvorder(vol7d_level_d)) = .false.
577 colmask(this%ser%loopinvorder(vol7d_timerange_d)) = .false.
578 ENDIF
579
580 IF (any( &
581 this%loopind(1:this%ser%ndvar) > this%ser%loopend(1:this%ser%ndvar) .AND. &
582 colmask(1:this%ser%ndvar))) THEN
583 next = .false.
584 this%status = 2
585 RETURN
586 ENDIF
587
588 ELSE ! following iterations
589! final part of the loop over columns
590 DO i = this%ser%ndvar, 1, -1
591 IF (this%loopind(i) < this%ser%loopend(i)) THEN ! increment loop index
592 this%loopind(i) = this%loopind(i) + 1
593 EXIT
594 ELSE ! end of loop for this index, reset and increment next index
595 this%loopind(i) = this%ser%loopstart(i)
596 ENDIF
597 ENDDO
598 IF (i == 0) THEN ! all counters have reached the end
599 next = .false.
600 this%status = 2
601 RETURN
602 ENDIF
603 ENDIF ! first iteration
604
605! set indices, use pointers?
606 this%i1 = this%loopind(this%ser%loopinvorder(vol7d_ana_d))
607 this%i2 = this%loopind(this%ser%loopinvorder(vol7d_time_d))
608 this%i3 = this%loopind(this%ser%loopinvorder(vol7d_level_d))
609 this%i4 = this%loopind(this%ser%loopinvorder(vol7d_timerange_d))
610 this%i6 = this%loopind(this%ser%loopinvorder(vol7d_network_d))
611
612 IF (this%ser%ndvar == 5) THEN ! all variables in one line
613 this%i5 = 0
614 this%analine = this%ser%anavol .OR. this%ser%anaonly
615! do not repeat ana variables for every data entry
616 IF (this%analine) THEN
617 IF (this%i2 /= 1 .OR. this%i3 /= 1 .OR. this%i4 /= 1) cycle
618 ENDIF
619 IF (.NOT.this%ser%keep_miss) THEN ! check whether the line has valid data
620 IF (var_mapper_miss(this%ser%mapper, this%ser%v7d, &
621 this%i1, this%i2, this%i3, this%i4, this%i6, this%analine)) cycle
622 ENDIF
623 ELSE ! one variable per line
624 this%i5 = this%loopind(this%ser%loopinvorder(vol7d_var_d))
625 this%analine = (this%ser%mapper(this%i5)%cat <= 2)
626! do not repeat ana variables for every data entry
627 IF (this%analine) THEN
628 IF (this%i2 /= 1 .OR. this%i3 /= 1 .OR. this%i4 /= 1) cycle
629 ENDIF
630 IF (.NOT.this%ser%keep_miss) THEN ! check whether the line has valid data
631 IF (var_mapper_miss(this%ser%mapper(this%i5:this%i5), this%ser%v7d, &
632 this%i1, this%i2, this%i3, this%i4, this%i6, this%analine)) cycle
633 ENDIF
634 ENDIF
635
636 next = .true.
637 RETURN
638
639END DO loop7d
640
641END FUNCTION vol7d_serialize_iterline_next
642
643
644FUNCTION vol7d_serialize_itercol_new_ser(this) RESULT(iterator)
645CLASS(vol7d_serialize),INTENT(in),TARGET :: this
646TYPE(vol7d_serialize_itercol) :: iterator
647
648iterator%ser => this
649IF (this%ndvar == 5) THEN ! all variables in one line
650 iterator%iend = SIZE(this%icolumn) + SIZE(this%mapper)
651ELSE ! one variable per line
652 iterator%iend = SIZE(this%icolumn)
653ENDIF
654
655END FUNCTION vol7d_serialize_itercol_new_ser
656
657
658FUNCTION vol7d_serialize_itercol_new_line(this) RESULT(iterator)
659CLASS(vol7d_serialize_iterline),INTENT(in),TARGET :: this
660TYPE(vol7d_serialize_itercol) :: iterator
661
662iterator%ser => this%ser
663iterator%line => this
664iterator%i = 0 ! 1?
665IF (this%i5 == 0) THEN ! all variables in one line
666 iterator%iend = SIZE(this%ser%icolumn) + SIZE(this%ser%mapper)
667ELSE ! one variable per line
668 iterator%iend = SIZE(this%ser%icolumn)
669ENDIF
670
671
672END FUNCTION vol7d_serialize_itercol_new_line
673
674
675FUNCTION vol7d_serialize_itercol_next(this) RESULT(next)
676CLASS(vol7d_serialize_itercol),INTENT(inout) :: this
677LOGICAL :: next
678
679INTEGER :: icol
680
681DO WHILE(this%i < this%iend)
682 this%i = this%i + 1
683! IF (this%line%i5 == 0) THEN ! all variables in one line
684 IF (this%i <= SIZE(this%ser%icolumn)) THEN
685 icol = this%ser%icolumn(this%i)
686 IF (icol > 0) THEN
687 next = .true.
688 RETURN
689! ELSE
690! skip to the next
691 ENDIF
692 ELSE ! we are in the variable part of a "all variables in one line" line
693 IF (ASSOCIATED(this%line)) this%line%i5 = this%line%i5 + 1
694 next = .true.
695 RETURN ! always return unconditioned
696 ENDIF
697ENDDO ! end of columns
698
699next = .false.
700
701END FUNCTION vol7d_serialize_itercol_next
702
703
704SUBROUTINE vol7d_serialize_itercol_call(this, genericptr)
705CLASS(vol7d_serialize_itercol),INTENT(inout) :: this
706TYPE(c_ptr),VALUE :: genericptr
707
708INTEGER :: icol, icolorder
709
710IF (ASSOCIATED(this%line)) THEN ! body line iterator
711
712 IF (this%i <= SIZE(this%ser%icolumn)) THEN
713 icol = this%ser%icolumn(this%i)
714 ELSE
715 icol = 7 ! value
716 ENDIF
717
718 IF (icol < 7) THEN ! descriptor column (was this%i <= 7)
719 icolorder = this%ser%loopinvorder(icol)
720! check whether column is in cache
721 IF (this%line%lastind(icolorder) == this%line%loopind(icolorder) &
722 .AND. this%ser%cachedesc) RETURN
723! check whether column is not requested because line is ana only
724 this%forcemiss = this%line%analine .AND. &
725 icol /= vol7d_ana_d .AND. icol /= vol7d_network_d
726! call callback
727 CALL call_desc_callback(this, genericptr)
728 IF (this%forcemiss) THEN
729! invalidate cache
730 this%line%lastind(icolorder) = 0
731 ELSE
732! update cache
733 this%line%lastind(icolorder) = this%line%loopind(icolorder)
734 ENDIF
735
736 ELSE ! it is a column with a value
737 CALL call_value_callback(this, genericptr)
738
739 ENDIF
740
741ELSE ! header line iterator
742 IF (this%i <= 7) THEN ! descriptor column
743 CALL call_header_desc_callback(this, genericptr)
744 ELSE ! it is a column with a value => a variable is used as a header
745 CALL call_header_value_callback(this, genericptr)
746 ENDIF
747ENDIF
748
749END SUBROUTINE vol7d_serialize_itercol_call
750
751
752SUBROUTINE call_header_desc_callback(this, genericptr)
753CLASS(vol7d_serialize_itercol),INTENT(in) :: this
754TYPE(c_ptr),VALUE :: genericptr
755
756SELECT CASE(this%ser%icolumn(this%i))
757
758CASE(vol7d_ana_d)
759 CALL this%ser%vol7d_ana_callback(genericptr)
760
761CASE(vol7d_time_d)
762 CALL this%ser%vol7d_time_callback(genericptr)
763
764CASE(vol7d_level_d)
765 CALL this%ser%vol7d_level_callback(genericptr)
766
767CASE(vol7d_timerange_d)
768 CALL this%ser%vol7d_timerange_callback(genericptr)
769
770CASE(vol7d_network_d)
771 CALL this%ser%vol7d_network_callback(genericptr)
772
773CASE(vol7d_var_d)
774 CALL this%ser%vol7d_var_callback(genericptr)
775
776CASE(7)
777 CALL this%ser%vol7d_val_callback(genericptr)
778
779END SELECT
780
781END SUBROUTINE call_header_desc_callback
782
783
784SUBROUTINE call_header_value_callback(this, genericptr)
785CLASS(vol7d_serialize_itercol),INTENT(in) :: this
786TYPE(c_ptr),VALUE :: genericptr
787
788INTEGER :: ind, varind, attrind
789
790! here the variable index this%line%i5 is not available, I use this%i-7 as a proxy
791ind = this%i - 7
792varind = this%ser%mapper(ind)%i5
793attrind = this%ser%mapper(ind)%i7
794
795SELECT CASE(this%ser%mapper(ind)%cat)
796CASE(1)
797 SELECT CASE(this%ser%mapper(ind)%typ)
798 CASE(1)
799 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%r(varind), 'ra', genericptr)
800 CASE(2)
801 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%d(varind), 'da', genericptr)
802 CASE(3)
803 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%i(varind), 'ia', genericptr)
804 CASE(4)
805 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%b(varind), 'ba', genericptr)
806 CASE(5)
807 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%c(varind), 'ca', genericptr)
808 END SELECT
809CASE(2)
810 SELECT CASE(this%ser%mapper(ind)%typ)
811 CASE(1)
812 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%r(varind), &
813 this%ser%v7d%anaattr%r(attrind), 'ra', genericptr)
814 CASE(2)
815 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%d(varind), &
816 this%ser%v7d%anaattr%d(attrind), 'da', genericptr)
817 CASE(3)
818 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%i(varind), &
819 this%ser%v7d%anaattr%i(attrind), 'ia', genericptr)
820 CASE(4)
821 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%b(varind), &
822 this%ser%v7d%anaattr%b(attrind), 'ba', genericptr)
823 CASE(5)
824 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%c(varind), &
825 this%ser%v7d%anaattr%c(attrind), 'ca', genericptr)
826 END SELECT
827CASE(3)
828 SELECT CASE(this%ser%mapper(ind)%typ)
829 CASE(1)
830 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%r(varind), 'rd', genericptr)
831 CASE(2)
832 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%d(varind), 'dd', genericptr)
833 CASE(3)
834 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%i(varind), 'id', genericptr)
835 CASE(4)
836 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%b(varind), 'bd', genericptr)
837 CASE(5)
838 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%c(varind), 'cd', genericptr)
839 END SELECT
840CASE(4)
841 SELECT CASE(this%ser%mapper(ind)%typ)
842 CASE(1)
843 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%r(varind), &
844 this%ser%v7d%datiattr%r(attrind), 'rd', genericptr)
845 CASE(2)
846 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%d(varind), &
847 this%ser%v7d%datiattr%d(attrind), 'dd', genericptr)
848 CASE(3)
849 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%i(varind), &
850 this%ser%v7d%datiattr%i(attrind), 'id', genericptr)
851 CASE(4)
852 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%b(varind), &
853 this%ser%v7d%datiattr%b(attrind), 'bd', genericptr)
854 CASE(5)
855 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%c(varind), &
856 this%ser%v7d%datiattr%c(attrind), 'cd', genericptr)
857 END SELECT
858END SELECT
859
860END SUBROUTINE call_header_value_callback
861
862
863SUBROUTINE default_vol7d_ana_header_callback(genericptr)
864TYPE(c_ptr),VALUE :: genericptr
865
866CHARACTER(len=64),POINTER :: col
867
868CALL c_f_pointer(genericptr, col)
869col = 'Longitude,Latitude'
870
871END SUBROUTINE default_vol7d_ana_header_callback
872
873SUBROUTINE default_vol7d_time_header_callback(genericptr)
874TYPE(c_ptr),VALUE :: genericptr
875
876CHARACTER(len=64),POINTER :: col
877
878CALL c_f_pointer(genericptr, col)
879col = 'Date'
880
881END SUBROUTINE default_vol7d_time_header_callback
882
883SUBROUTINE default_vol7d_level_header_callback(genericptr)
884TYPE(c_ptr),VALUE :: genericptr
885
886CHARACTER(len=64),POINTER :: col
887
888CALL c_f_pointer(genericptr, col)
889col = 'Level1,L1,Level2,L2'
890
891END SUBROUTINE default_vol7d_level_header_callback
892
893SUBROUTINE default_vol7d_timerange_header_callback(genericptr)
894TYPE(c_ptr),VALUE :: genericptr
895
896CHARACTER(len=64),POINTER :: col
897
898CALL c_f_pointer(genericptr, col)
899col = 'Time range,P1,P2'
900
901END SUBROUTINE default_vol7d_timerange_header_callback
902
903SUBROUTINE default_vol7d_network_header_callback(genericptr)
904TYPE(c_ptr),VALUE :: genericptr
905
906CHARACTER(len=64),POINTER :: col
907
908CALL c_f_pointer(genericptr, col)
909col = 'Report'
910
911END SUBROUTINE default_vol7d_network_header_callback
912
913SUBROUTINE default_vol7d_var_header_callback(genericptr)
914TYPE(c_ptr),VALUE :: genericptr
915
916CHARACTER(len=64),POINTER :: col
917
918CALL c_f_pointer(genericptr, col)
919col = 'Variable'
920
921END SUBROUTINE default_vol7d_var_header_callback
922
923SUBROUTINE default_vol7d_val_header_callback(genericptr)
924TYPE(c_ptr),VALUE :: genericptr
925
926CHARACTER(len=64),POINTER :: col
927
928CALL c_f_pointer(genericptr, col)
929col = 'Value'
930
931END SUBROUTINE default_vol7d_val_header_callback
932
933SUBROUTINE default_vol7d_value_var_header_callback(var, typ, genericptr)
934TYPE(vol7d_var),INTENT(in) :: var
935CHARACTER(len=2),INTENT(in) :: typ
936TYPE(c_ptr),VALUE :: genericptr
937
938CHARACTER(len=64),POINTER :: col
939
940CALL c_f_pointer(genericptr, col)
941col = var%btable
942
943END SUBROUTINE default_vol7d_value_var_header_callback
944
945SUBROUTINE default_vol7d_value_attr_header_callback(var, attr, typ, genericptr)
946TYPE(vol7d_var),INTENT(in) :: var
947TYPE(vol7d_var),INTENT(in) :: attr
948CHARACTER(len=2),INTENT(in) :: typ
949TYPE(c_ptr),VALUE :: genericptr
950
951CHARACTER(len=64),POINTER :: col
952
953CALL c_f_pointer(genericptr, col)
954col = trim(var%btable)//'.'//attr%btable
955
956END SUBROUTINE default_vol7d_value_attr_header_callback
957
958
959SUBROUTINE call_desc_callback(this, genericptr)
960CLASS(vol7d_serialize_itercol),INTENT(in) :: this
961TYPE(c_ptr),VALUE :: genericptr
962
963INTEGER :: icol, ind, varind, attrind
964
965icol = this%ser%icolumn(this%i)
966ind = this%line%loopind(this%ser%loopinvorder(icol))
967
968SELECT CASE(icol)
969
970CASE(vol7d_ana_d)
971 CALL this%line%vol7d_ana_callback(this%ser%v7d%ana(ind), genericptr)
972
973CASE(vol7d_time_d)
974 IF (this%forcemiss) THEN
975 CALL this%line%vol7d_time_callback(datetime_miss, genericptr)
976 ELSE
977 CALL this%line%vol7d_time_callback(this%ser%v7d%time(ind), genericptr)
978 ENDIF
979
980CASE(vol7d_level_d)
981 IF (this%forcemiss) THEN
982 CALL this%line%vol7d_level_callback(vol7d_level_miss, genericptr)
983 ELSE
984 CALL this%line%vol7d_level_callback(this%ser%v7d%level(ind), genericptr)
985 ENDIF
986
987CASE(vol7d_timerange_d)
988 IF (this%forcemiss) THEN
989 CALL this%line%vol7d_timerange_callback(vol7d_timerange_miss, genericptr)
990 ELSE
991 CALL this%line%vol7d_timerange_callback(this%ser%v7d%timerange(ind), genericptr)
992 ENDIF
993
994CASE(vol7d_network_d)
995 CALL this%line%vol7d_network_callback(this%ser%v7d%network(ind), genericptr)
996
997CASE(vol7d_var_d)
998 varind = this%ser%mapper(ind)%i5
999 attrind = this%ser%mapper(ind)%i7
1000 SELECT CASE(this%ser%mapper(ind)%cat)
1001 CASE(1)
1002 SELECT CASE(this%ser%mapper(ind)%typ)
1003 CASE(1)
1004 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%r(varind), genericptr)
1005 CASE(2)
1006 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%d(varind), genericptr)
1007 CASE(3)
1008 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%i(varind), genericptr)
1009 CASE(4)
1010 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%b(varind), genericptr)
1011 CASE(5)
1012 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%c(varind), genericptr)
1013 END SELECT
1014 CASE(2)
1015 SELECT CASE(this%ser%mapper(ind)%typ)
1016 CASE(1)
1017 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%r(varind), &
1018 this%ser%v7d%anaattr%r(attrind), genericptr)
1019 CASE(2)
1020 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%d(varind), &
1021 this%ser%v7d%anaattr%d(attrind), genericptr)
1022 CASE(3)
1023 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%i(varind), &
1024 this%ser%v7d%anaattr%i(attrind), genericptr)
1025 CASE(4)
1026 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%b(varind), &
1027 this%ser%v7d%anaattr%b(attrind), genericptr)
1028 CASE(5)
1029 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%c(varind), &
1030 this%ser%v7d%anaattr%c(attrind), genericptr)
1031 END SELECT
1032 CASE(3)
1033 SELECT CASE(this%ser%mapper(ind)%typ)
1034 CASE(1)
1035 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%r(varind), genericptr)
1036 CASE(2)
1037 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%d(varind), genericptr)
1038 CASE(3)
1039 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%i(varind), genericptr)
1040 CASE(4)
1041 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%b(varind), genericptr)
1042 CASE(5)
1043 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%c(varind), genericptr)
1044 END SELECT
1045 CASE(4)
1046 SELECT CASE(this%ser%mapper(ind)%typ)
1047 CASE(1)
1048 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%r(varind), &
1049 this%ser%v7d%datiattr%r(attrind), genericptr)
1050 CASE(2)
1051 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%d(varind), &
1052 this%ser%v7d%datiattr%d(attrind), genericptr)
1053 CASE(3)
1054 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%i(varind), &
1055 this%ser%v7d%datiattr%i(attrind), genericptr)
1056 CASE(4)
1057 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%b(varind), &
1058 this%ser%v7d%datiattr%b(attrind), genericptr)
1059 CASE(5)
1060 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%c(varind), &
1061 this%ser%v7d%datiattr%c(attrind), genericptr)
1062 END SELECT
1063 END SELECT
1064
1065END SELECT
1066
1067END SUBROUTINE call_desc_callback
1068
1069
1070SUBROUTINE default_vol7d_ana_callback(ana, genericptr)
1071TYPE(vol7d_ana), INTENT(in) :: ana
1072TYPE(c_ptr),VALUE :: genericptr
1073
1074CHARACTER(len=64),POINTER :: col
1075
1076CALL c_f_pointer(genericptr, col)
1077
1078col = trim(adjustl(to_char(getlon(ana%coord),miss="",form="(f10.5)")))//&
1079 ','//trim(adjustl(to_char(getlat(ana%coord),miss="",form="(f10.5)")))
1080
1081END SUBROUTINE default_vol7d_ana_callback
1082
1083
1084SUBROUTINE default_vol7d_time_callback(time, genericptr)
1085TYPE(datetime), INTENT(in) :: time
1086TYPE(c_ptr),VALUE :: genericptr
1087
1088CHARACTER(len=64),POINTER :: col
1089
1090CALL c_f_pointer(genericptr, col)
1091col = ''
1092IF (time /= datetime_miss) THEN
1093 CALL getval(time, isodate=col(1:19))
1094ENDIF
1095
1096END SUBROUTINE default_vol7d_time_callback
1097
1098
1099SUBROUTINE default_vol7d_level_callback(level, genericptr)
1100TYPE(vol7d_level), INTENT(in) :: level
1101TYPE(c_ptr),VALUE :: genericptr
1102
1103CHARACTER(len=64),POINTER :: col
1104
1105CALL c_f_pointer(genericptr, col)
1106col = t2c(level%level1, '')//','// &
1107 t2c(level%l1, '')//','// &
1108 t2c(level%level2, '')//','// &
1109 t2c(level%l2, '')
1110
1111END SUBROUTINE default_vol7d_level_callback
1112
1113
1114SUBROUTINE default_vol7d_timerange_callback(timerange, genericptr)
1115TYPE(vol7d_timerange), INTENT(in) :: timerange
1116TYPE(c_ptr),VALUE :: genericptr
1117
1118CHARACTER(len=64),POINTER :: col
1119
1120CALL c_f_pointer(genericptr, col)
1121col = t2c(timerange%timerange, '')//','// &
1122 t2c(timerange%p1, '')//','//t2c(timerange%p2, '')
1123
1124END SUBROUTINE default_vol7d_timerange_callback
1125
1126
1127SUBROUTINE default_vol7d_network_callback(network, genericptr)
1128TYPE(vol7d_network), INTENT(in) :: network
1129TYPE(c_ptr),VALUE :: genericptr
1130
1131CHARACTER(len=64),POINTER :: col
1132
1133CALL c_f_pointer(genericptr, col)
1134IF (c_e(network)) THEN
1135 col = network%name
1136ELSE
1137 col = ''
1138ENDIF
1139
1140END SUBROUTINE default_vol7d_network_callback
1141
1142
1143SUBROUTINE default_vol7d_var_callback(var, genericptr)
1144TYPE(vol7d_var), INTENT(in) :: var
1145TYPE(c_ptr),VALUE :: genericptr
1146
1147CHARACTER(len=64),POINTER :: col
1148
1149CALL c_f_pointer(genericptr, col)
1150IF (c_e(var)) THEN
1151 col = var%btable
1152ELSE
1153 col = ''
1154ENDIF
1155
1156END SUBROUTINE default_vol7d_var_callback
1157
1158
1159SUBROUTINE default_vol7d_attr_callback(var, attr, genericptr)
1160TYPE(vol7d_var), INTENT(in) :: var
1161TYPE(vol7d_var), INTENT(in) :: attr
1162TYPE(c_ptr),VALUE :: genericptr
1163
1164CHARACTER(len=64),POINTER :: col
1165
1166CALL c_f_pointer(genericptr, col)
1167IF (c_e(var) .AND. c_e(attr)) THEN
1168 col = trim(var%btable)//'.'//attr%btable
1169ELSE
1170 col = ''
1171ENDIF
1172
1173END SUBROUTINE default_vol7d_attr_callback
1174
1175
1176! create a var_mapper object from the v7d volume provided
1177SUBROUTINE var_mapper(mapper, v7d, anaonly, dataonly)
1178TYPE(vol7d_var_mapper),ALLOCATABLE :: mapper(:)
1179TYPE(vol7d),INTENT(in) :: v7d
1180LOGICAL,INTENT(in) :: anaonly
1181LOGICAL,INTENT(in) :: dataonly
1182
1183INTEGER :: n
1184
1185n = 0
1186
1187IF (.NOT.dataonly) THEN
1188 IF (ASSOCIATED(v7d%anavar%r)) n = n + SIZE(v7d%anavar%r)
1189 IF (ASSOCIATED(v7d%anavar%d)) n = n + SIZE(v7d%anavar%d)
1190 IF (ASSOCIATED(v7d%anavar%i)) n = n + SIZE(v7d%anavar%i)
1191 IF (ASSOCIATED(v7d%anavar%b)) n = n + SIZE(v7d%anavar%b)
1192 IF (ASSOCIATED(v7d%anavar%c)) n = n + SIZE(v7d%anavar%c)
1193
1194 IF (ASSOCIATED(v7d%anaattr%r) .AND. ASSOCIATED(v7d%anavarattr%r)) n = n + &
1195 SIZE(v7d%anaattr%r) * SIZE(v7d%anavarattr%r)
1196 IF (ASSOCIATED(v7d%anaattr%d) .AND. ASSOCIATED(v7d%anavarattr%d)) n = n + &
1197 SIZE(v7d%anaattr%d) * SIZE(v7d%anavarattr%d)
1198 IF (ASSOCIATED(v7d%anaattr%i) .AND. ASSOCIATED(v7d%anavarattr%i)) n = n + &
1199 SIZE(v7d%anaattr%i) * SIZE(v7d%anavarattr%i)
1200 IF (ASSOCIATED(v7d%anaattr%b) .AND. ASSOCIATED(v7d%anavarattr%b)) n = n + &
1201 SIZE(v7d%anaattr%b) * SIZE(v7d%anavarattr%b)
1202 IF (ASSOCIATED(v7d%anaattr%c) .AND. ASSOCIATED(v7d%anavarattr%c)) n = n + &
1203 SIZE(v7d%anaattr%c) * SIZE(v7d%anavarattr%c)
1204ENDIF
1205
1206IF (.NOT.anaonly) THEN
1207 IF (ASSOCIATED(v7d%dativar%r)) n = n + SIZE(v7d%dativar%r)
1208 IF (ASSOCIATED(v7d%dativar%d)) n = n + SIZE(v7d%dativar%d)
1209 IF (ASSOCIATED(v7d%dativar%i)) n = n + SIZE(v7d%dativar%i)
1210 IF (ASSOCIATED(v7d%dativar%b)) n = n + SIZE(v7d%dativar%b)
1211 IF (ASSOCIATED(v7d%dativar%c)) n = n + SIZE(v7d%dativar%c)
1212
1213 IF (ASSOCIATED(v7d%datiattr%r) .AND. ASSOCIATED(v7d%dativarattr%r)) n = n + &
1214 SIZE(v7d%datiattr%r) * SIZE(v7d%dativarattr%r)
1215 IF (ASSOCIATED(v7d%datiattr%d) .AND. ASSOCIATED(v7d%dativarattr%d)) n = n + &
1216 SIZE(v7d%datiattr%d) * SIZE(v7d%dativarattr%d)
1217 IF (ASSOCIATED(v7d%datiattr%i) .AND. ASSOCIATED(v7d%dativarattr%i)) n = n + &
1218 SIZE(v7d%datiattr%i) * SIZE(v7d%dativarattr%i)
1219 IF (ASSOCIATED(v7d%datiattr%b) .AND. ASSOCIATED(v7d%dativarattr%b)) n = n + &
1220 SIZE(v7d%datiattr%b) * SIZE(v7d%dativarattr%b)
1221 IF (ASSOCIATED(v7d%datiattr%c) .AND. ASSOCIATED(v7d%dativarattr%c)) n = n + &
1222 SIZE(v7d%datiattr%c) * SIZE(v7d%dativarattr%c)
1223ENDIF
1224
1225ALLOCATE(mapper(n))
1226
1227n = 0
1228
1229IF (.NOT.dataonly) THEN
1230 IF (ASSOCIATED(v7d%anavar%r)) THEN
1231 CALL set_mapper(1, 1, 1, SIZE(v7d%anavar%r))
1232 ENDIF
1233 IF (ASSOCIATED(v7d%anavar%d)) THEN
1234 CALL set_mapper(1, 2, 1, SIZE(v7d%anavar%d))
1235 ENDIF
1236 IF (ASSOCIATED(v7d%anavar%i)) THEN
1237 CALL set_mapper(1, 3, 1, SIZE(v7d%anavar%i))
1238 ENDIF
1239 IF (ASSOCIATED(v7d%anavar%b)) THEN
1240 CALL set_mapper(1, 4, 1, SIZE(v7d%anavar%b))
1241 ENDIF
1242 IF (ASSOCIATED(v7d%anavar%c)) THEN
1243 CALL set_mapper(1, 5, 1, SIZE(v7d%anavar%c))
1244 ENDIF
1245
1246 IF (ASSOCIATED(v7d%anaattr%r) .AND. ASSOCIATED(v7d%anavarattr%r)) THEN
1247 CALL set_mapper(2, 1, SIZE(v7d%anaattr%r), SIZE(v7d%anavarattr%r))
1248 ENDIF
1249 IF (ASSOCIATED(v7d%anaattr%d) .AND. ASSOCIATED(v7d%anavarattr%d)) THEN
1250 CALL set_mapper(2, 2, SIZE(v7d%anaattr%d), SIZE(v7d%anavarattr%d))
1251 ENDIF
1252 IF (ASSOCIATED(v7d%anaattr%i) .AND. ASSOCIATED(v7d%anavarattr%i)) THEN
1253 CALL set_mapper(2, 3, SIZE(v7d%anaattr%i), SIZE(v7d%anavarattr%i))
1254 ENDIF
1255 IF (ASSOCIATED(v7d%anaattr%b) .AND. ASSOCIATED(v7d%anavarattr%b)) THEN
1256 CALL set_mapper(2, 4, SIZE(v7d%anaattr%b), SIZE(v7d%anavarattr%b))
1257 ENDIF
1258 IF (ASSOCIATED(v7d%anaattr%c) .AND. ASSOCIATED(v7d%anavarattr%c)) THEN
1259 CALL set_mapper(2, 5, SIZE(v7d%anaattr%c), SIZE(v7d%anavarattr%c))
1260 ENDIF
1261ENDIF
1262
1263IF (.NOT.anaonly) THEN
1264 IF (ASSOCIATED(v7d%dativar%r)) THEN
1265 CALL set_mapper(3, 1, 1, SIZE(v7d%dativar%r))
1266 ENDIF
1267 IF (ASSOCIATED(v7d%dativar%d)) THEN
1268 CALL set_mapper(3, 2, 1, SIZE(v7d%dativar%d))
1269 ENDIF
1270 IF (ASSOCIATED(v7d%dativar%i)) THEN
1271 CALL set_mapper(3, 3, 1, SIZE(v7d%dativar%i))
1272 ENDIF
1273 IF (ASSOCIATED(v7d%dativar%b)) THEN
1274 CALL set_mapper(3, 4, 1, SIZE(v7d%dativar%b))
1275 ENDIF
1276 IF (ASSOCIATED(v7d%dativar%c)) THEN
1277 CALL set_mapper(3, 5, 1, SIZE(v7d%dativar%c))
1278 ENDIF
1279
1280 IF (ASSOCIATED(v7d%datiattr%r) .AND. ASSOCIATED(v7d%dativarattr%r)) THEN
1281 CALL set_mapper(4, 1, SIZE(v7d%datiattr%r), SIZE(v7d%dativarattr%r))
1282 ENDIF
1283 IF (ASSOCIATED(v7d%datiattr%d) .AND. ASSOCIATED(v7d%dativarattr%d)) THEN
1284 CALL set_mapper(4, 2, SIZE(v7d%datiattr%d), SIZE(v7d%dativarattr%d))
1285 ENDIF
1286 IF (ASSOCIATED(v7d%datiattr%i) .AND. ASSOCIATED(v7d%dativarattr%i)) THEN
1287 CALL set_mapper(4, 3, SIZE(v7d%datiattr%i), SIZE(v7d%dativarattr%i))
1288 ENDIF
1289 IF (ASSOCIATED(v7d%datiattr%b) .AND. ASSOCIATED(v7d%dativarattr%b)) THEN
1290 CALL set_mapper(4, 4, SIZE(v7d%datiattr%b), SIZE(v7d%dativarattr%b))
1291 ENDIF
1292 IF (ASSOCIATED(v7d%datiattr%c) .AND. ASSOCIATED(v7d%dativarattr%c)) THEN
1293 CALL set_mapper(4, 5, SIZE(v7d%datiattr%c), SIZE(v7d%dativarattr%c))
1294 ENDIF
1295ENDIF
1296
1297CONTAINS
1298
1299SUBROUTINE set_mapper(cat, typ, s1, s2)
1300INTEGER,INTENT(in) :: cat
1301INTEGER,INTENT(in) :: typ
1302INTEGER,INTENT(in) :: s1, s2
1303
1304INTEGER :: i, j, n1
1305
1306n1 = n + s1*s2
1307mapper(n+1:n1)%cat = cat
1308mapper(n+1:n1)%typ = typ
1309mapper(n+1:n1)%i5 = (/((i,i=1,s2),j=1,s1)/)
1310mapper(n+1:n1)%i7 = (/((j,i=1,s2),j=1,s1)/)
1311n = n1
1312
1313END SUBROUTINE set_mapper
1314
1315END SUBROUTINE var_mapper
1316
1317
1318! determine whether the volume mapped by mapper has missing values for
1319! every variable at the indicated position
1320FUNCTION var_mapper_miss(mapper, v7d, i1, i2, i3, i4, i6, analine) RESULT(miss)
1321TYPE(vol7d_var_mapper),INTENT(in) :: mapper(:)
1322TYPE(vol7d),INTENT(in) :: v7d
1323INTEGER,INTENT(in) :: i1, i2, i3, i4, i6
1324LOGICAL,INTENT(in) :: analine
1325LOGICAL :: miss
1326
1327INTEGER :: ind, varind, attrind
1328
1329miss = .true.
1330DO ind = 1, SIZE(mapper)
1331 varind = mapper(ind)%i5
1332 attrind = mapper(ind)%i7
1333
1334 SELECT CASE(mapper(ind)%cat)
1335 CASE(1)
1336 IF (analine) THEN
1337 SELECT CASE(mapper(ind)%typ)
1338 CASE(1)
1339 miss = miss .AND. .NOT.c_e(v7d%volanar(i1, varind, i6))
1340 CASE(2)
1341 miss = miss .AND. .NOT.c_e(v7d%volanad(i1, varind, i6))
1342 CASE(3)
1343 miss = miss .AND. .NOT.c_e(v7d%volanai(i1, varind, i6))
1344 CASE(4)
1345 miss = miss .AND. .NOT.c_e(v7d%volanab(i1, varind, i6))
1346 CASE(5)
1347 miss = miss .AND. .NOT.c_e(v7d%volanac(i1, varind, i6))
1348 END SELECT
1349 ENDIF
1350 CASE(2)
1351 IF (analine) THEN
1352 SELECT CASE(mapper(ind)%typ)
1353 CASE(1)
1354 miss = miss .AND. .NOT.c_e(v7d%volanaattrr(i1, varind, i6, attrind))
1355 CASE(2)
1356 miss = miss .AND. .NOT.c_e(v7d%volanaattrd(i1, varind, i6, attrind))
1357 CASE(3)
1358 miss = miss .AND. .NOT.c_e(v7d%volanaattri(i1, varind, i6, attrind))
1359 CASE(4)
1360 miss = miss .AND. .NOT.c_e(v7d%volanaattrb(i1, varind, i6, attrind))
1361 CASE(5)
1362 miss = miss .AND. .NOT.c_e(v7d%volanaattrc(i1, varind, i6, attrind))
1363 END SELECT
1364 ENDIF
1365 CASE(3)
1366 SELECT CASE(mapper(ind)%typ)
1367 CASE(1)
1368 miss = miss .AND. .NOT.c_e(v7d%voldatir(i1, i2, i3, i4, varind, i6))
1369 CASE(2)
1370 miss = miss .AND. .NOT.c_e(v7d%voldatid(i1, i2, i3, i4, varind, i6))
1371 CASE(3)
1372 miss = miss .AND. .NOT.c_e(v7d%voldatii(i1, i2, i3, i4, varind, i6))
1373 CASE(4)
1374 miss = miss .AND. .NOT.c_e(v7d%voldatib(i1, i2, i3, i4, varind, i6))
1375 CASE(5)
1376 miss = miss .AND. .NOT.c_e(v7d%voldatic(i1, i2, i3, i4, varind, i6))
1377 END SELECT
1378 CASE(4)
1379 SELECT CASE(mapper(ind)%typ)
1380 CASE(1)
1381 miss = miss .AND. .NOT.c_e(v7d%voldatiattrr(i1, i2, i3, i4, varind, i6, attrind))
1382 CASE(2)
1383 miss = miss .AND. .NOT.c_e(v7d%voldatiattrd(i1, i2, i3, i4, varind, i6, attrind))
1384 CASE(3)
1385 miss = miss .AND. .NOT.c_e(v7d%voldatiattri(i1, i2, i3, i4, varind, i6, attrind))
1386 CASE(4)
1387 miss = miss .AND. .NOT.c_e(v7d%voldatiattrb(i1, i2, i3, i4, varind, i6, attrind))
1388 CASE(5)
1389 miss = miss .AND. .NOT.c_e(v7d%voldatiattrc(i1, i2, i3, i4, varind, i6, attrind))
1390 END SELECT
1391 END SELECT
1392 IF (.NOT.miss) RETURN ! shortcut
1393ENDDO
1394
1395END FUNCTION var_mapper_miss
1396
1397
1398! search for a variable in the mapper object and return the
1399! corresponding index, or 0 if not found
1400FUNCTION var_mapper_searchvar(mapper, v7d, var) RESULT(ind)
1401TYPE(vol7d_var_mapper),INTENT(in) :: mapper(:)
1402TYPE(vol7d),INTENT(in) :: v7d
1403TYPE(vol7d_var),INTENT(in) :: var
1404
1405INTEGER :: ind
1406INTEGER :: varind
1407
1408DO ind = 1, SIZE(mapper)
1409 varind = mapper(ind)%i5
1410! attrind = mapper(ind)%i7
1411
1412 SELECT CASE(mapper(ind)%cat)
1413 CASE(1)
1414 SELECT CASE(mapper(ind)%typ)
1415 CASE(1)
1416 IF (v7d%anavar%r(varind) == var) RETURN
1417 CASE(2)
1418 IF (v7d%anavar%d(varind) == var) RETURN
1419 CASE(3)
1420 IF (v7d%anavar%i(varind) == var) RETURN
1421 CASE(4)
1422 IF (v7d%anavar%b(varind) == var) RETURN
1423 CASE(5)
1424 IF (v7d%anavar%c(varind) == var) RETURN
1425 END SELECT
1426 CASE(3)
1427 SELECT CASE(mapper(ind)%typ)
1428 CASE(1)
1429 IF (v7d%dativar%r(varind) == var) RETURN
1430 CASE(2)
1431 IF (v7d%dativar%d(varind) == var) RETURN
1432 CASE(3)
1433 IF (v7d%dativar%i(varind) == var) RETURN
1434 CASE(4)
1435 IF (v7d%dativar%b(varind) == var) RETURN
1436 CASE(5)
1437 IF (v7d%dativar%c(varind) == var) RETURN
1438 END SELECT
1439 END SELECT
1440END DO
1441
1442ind = 0 ! not found
1443
1444END FUNCTION var_mapper_searchvar
1445
1446
1447SUBROUTINE call_value_callback(this, genericptr)
1448CLASS(vol7d_serialize_itercol),INTENT(inout) :: this
1449TYPE(c_ptr),VALUE :: genericptr
1450
1451INTEGER :: ind, varind, attrind
1452
1453ind = this%line%i5
1454varind = this%ser%mapper(ind)%i5
1455attrind = this%ser%mapper(ind)%i7
1456
1457SELECT CASE(this%ser%mapper(ind)%cat)
1458CASE(1)
1459 SELECT CASE(this%ser%mapper(ind)%typ)
1460 CASE(1)
1461 CALL this%line%vol7d_valuer_var_callback(this%ser%v7d%volanar( &
1462 this%line%i1, varind, this%line%i6), &
1463 this%ser%v7d%anavar%r(varind), genericptr)
1464 CASE(2)
1465 CALL this%line%vol7d_valued_var_callback(this%ser%v7d%volanad( &
1466 this%line%i1, varind, this%line%i6), &
1467 this%ser%v7d%anavar%d(varind), genericptr)
1468 CASE(3)
1469 CALL this%line%vol7d_valuei_var_callback(this%ser%v7d%volanai( &
1470 this%line%i1, varind, this%line%i6), &
1471 this%ser%v7d%anavar%i(varind), genericptr)
1472 CASE(4)
1473 CALL this%line%vol7d_valueb_var_callback(this%ser%v7d%volanab( &
1474 this%line%i1, varind, this%line%i6), &
1475 this%ser%v7d%anavar%b(varind), genericptr)
1476 CASE(5)
1477 CALL this%line%vol7d_valuec_var_callback(this%ser%v7d%volanac( &
1478 this%line%i1, varind, this%line%i6), &
1479 this%ser%v7d%anavar%c(varind), genericptr)
1480 END SELECT
1481CASE(2)
1482 SELECT CASE(this%ser%mapper(ind)%typ)
1483 CASE(1)
1484 CALL this%line%vol7d_valuer_attr_callback(this%ser%v7d%volanaattrr( &
1485 this%line%i1, varind, this%line%i6, attrind), &
1486 this%ser%v7d%anavarattr%r(varind), this%ser%v7d%anaattr%r(attrind), genericptr)
1487 CASE(2)
1488 CALL this%line%vol7d_valued_attr_callback(this%ser%v7d%volanaattrd( &
1489 this%line%i1, varind, this%line%i6, attrind), &
1490 this%ser%v7d%anavarattr%d(varind), this%ser%v7d%anaattr%d(attrind), genericptr)
1491 CASE(3)
1492 CALL this%line%vol7d_valuei_attr_callback(this%ser%v7d%volanaattri( &
1493 this%line%i1, varind, this%line%i6, attrind), &
1494 this%ser%v7d%anavarattr%i(varind), this%ser%v7d%anaattr%i(attrind), genericptr)
1495 CASE(4)
1496 CALL this%line%vol7d_valueb_attr_callback(this%ser%v7d%volanaattrb( &
1497 this%line%i1, varind, this%line%i6, attrind), &
1498 this%ser%v7d%anavarattr%b(varind), this%ser%v7d%anaattr%b(attrind), genericptr)
1499 CASE(5)
1500 CALL this%line%vol7d_valuec_attr_callback(this%ser%v7d%volanaattrc( &
1501 this%line%i1, varind, this%line%i6, attrind), &
1502 this%ser%v7d%anavarattr%c(varind), this%ser%v7d%anaattr%c(attrind), genericptr)
1503 END SELECT
1504CASE(3)
1505 SELECT CASE(this%ser%mapper(ind)%typ)
1506 CASE(1)
1507 CALL this%line%vol7d_valuer_var_callback(this%ser%v7d%voldatir( &
1508 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6), &
1509 this%ser%v7d%dativar%r(varind), genericptr)
1510 CASE(2)
1511 CALL this%line%vol7d_valued_var_callback(this%ser%v7d%voldatid( &
1512 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6), &
1513 this%ser%v7d%dativar%d(varind), genericptr)
1514 CASE(3)
1515 CALL this%line%vol7d_valuei_var_callback(this%ser%v7d%voldatii( &
1516 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6), &
1517 this%ser%v7d%dativar%i(varind), genericptr)
1518 CASE(4)
1519 CALL this%line%vol7d_valueb_var_callback(this%ser%v7d%voldatib( &
1520 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6), &
1521 this%ser%v7d%dativar%b(varind), genericptr)
1522 CASE(5)
1523 CALL this%line%vol7d_valuec_var_callback(this%ser%v7d%voldatic( &
1524 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6), &
1525 this%ser%v7d%dativar%c(varind), genericptr)
1526 END SELECT
1527CASE(4)
1528 SELECT CASE(this%ser%mapper(ind)%typ)
1529 CASE(1)
1530 CALL this%line%vol7d_valuer_attr_callback(this%ser%v7d%voldatiattrr( &
1531 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6, attrind), &
1532 this%ser%v7d%dativarattr%r(varind), this%ser%v7d%datiattr%r(attrind), genericptr)
1533 CASE(2)
1534 CALL this%line%vol7d_valued_attr_callback(this%ser%v7d%voldatiattrd( &
1535 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6, attrind), &
1536 this%ser%v7d%dativarattr%d(varind), this%ser%v7d%datiattr%d(attrind), genericptr)
1537 CASE(3)
1538 CALL this%line%vol7d_valuei_attr_callback(this%ser%v7d%voldatiattri( &
1539 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6, attrind), &
1540 this%ser%v7d%dativarattr%i(varind), this%ser%v7d%datiattr%i(attrind), genericptr)
1541 CASE(4)
1542 CALL this%line%vol7d_valueb_attr_callback(this%ser%v7d%voldatiattrb( &
1543 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6, attrind), &
1544 this%ser%v7d%dativarattr%b(varind), this%ser%v7d%datiattr%b(attrind), genericptr)
1545 CASE(5)
1546 CALL this%line%vol7d_valuec_attr_callback(this%ser%v7d%voldatiattrc( &
1547 this%line%i1, this%line%i2, this%line%i3, this%line%i4, varind, this%line%i6, attrind), &
1548 this%ser%v7d%dativarattr%c(varind), this%ser%v7d%datiattr%c(attrind), genericptr)
1549 END SELECT
1550END SELECT
1551
1552END SUBROUTINE call_value_callback
1553
1554
1555SUBROUTINE default_vol7d_valuer_var_callback(valu, var, genericptr)
1556REAL,INTENT(in) :: valu
1557TYPE(vol7d_var),INTENT(in) :: var
1558TYPE(c_ptr),VALUE :: genericptr
1559
1560CHARACTER(len=64),POINTER :: col
1561
1562CALL c_f_pointer(genericptr, col)
1563IF (c_e(valu)) THEN
1564 col = t2c(valu)
1565ELSE
1566 col = ''
1567ENDIF
1568
1569END SUBROUTINE default_vol7d_valuer_var_callback
1570
1571
1572SUBROUTINE default_vol7d_valued_var_callback(valu, var, genericptr)
1573DOUBLE PRECISION,INTENT(in) :: valu
1574TYPE(vol7d_var),INTENT(in) :: var
1575TYPE(c_ptr),VALUE :: genericptr
1576
1577CHARACTER(len=64),POINTER :: col
1578
1579CALL c_f_pointer(genericptr, col)
1580IF (c_e(valu)) THEN
1581 col = t2c(valu)
1582ELSE
1583 col = ''
1584ENDIF
1585
1586END SUBROUTINE default_vol7d_valued_var_callback
1587
1588
1589SUBROUTINE default_vol7d_valuei_var_callback(valu, var, genericptr)
1590INTEGER,INTENT(in) :: valu
1591TYPE(vol7d_var),INTENT(in) :: var
1592TYPE(c_ptr),VALUE :: genericptr
1593
1594CHARACTER(len=64),POINTER :: col
1595
1596CALL c_f_pointer(genericptr, col)
1597IF (c_e(valu)) THEN
1598 IF (c_e(var%scalefactor) .AND. &
1599 .NOT.(var%scalefactor == 0 .AND. var%unit == 'NUMERIC')) THEN
1600 col = t2c(realdat(valu, var))
1601 ELSE
1602 col = t2c(valu)
1603 ENDIF
1604ELSE
1605 col = ''
1606ENDIF
1607
1608END SUBROUTINE default_vol7d_valuei_var_callback
1609
1610
1611SUBROUTINE default_vol7d_valueb_var_callback(valu, var, genericptr)
1612INTEGER(kind=int_b),INTENT(in) :: valu
1613TYPE(vol7d_var),INTENT(in) :: var
1614TYPE(c_ptr),VALUE :: genericptr
1615
1616CHARACTER(len=64),POINTER :: col
1617
1618IF (c_e(valu)) THEN
1619 CALL default_vol7d_valuei_var_callback(int(valu), var, genericptr)
1620ELSE
1621 CALL c_f_pointer(genericptr, col)
1622 col = ''
1623ENDIF
1624
1625END SUBROUTINE default_vol7d_valueb_var_callback
1626
1627
1628SUBROUTINE default_vol7d_valuec_var_callback(valu, var, genericptr)
1629CHARACTER(len=*),INTENT(in) :: valu
1630TYPE(vol7d_var),INTENT(in) :: var
1631TYPE(c_ptr),VALUE :: genericptr
1632
1633CHARACTER(len=64),POINTER :: col
1634
1635CALL c_f_pointer(genericptr, col)
1636IF (c_e(valu)) THEN
1637 IF (c_e(var%scalefactor) .AND. var%unit /= 'CCITTIA5' .AND. &
1638 .NOT.(var%scalefactor == 0 .AND. var%unit == 'NUMERIC')) THEN
1639 col = t2c(realdat(valu, var))
1640 ELSE
1641 col = trim(valu)
1642 ENDIF
1643ELSE
1644 col = ''
1645ENDIF
1646
1647END SUBROUTINE default_vol7d_valuec_var_callback
1648
1649
1650SUBROUTINE default_vol7d_valuer_attr_callback(valu, var, attr, genericptr)
1651REAL,INTENT(in) :: valu
1652TYPE(vol7d_var),INTENT(in) :: var
1653TYPE(vol7d_var),INTENT(in) :: attr
1654TYPE(c_ptr),VALUE :: genericptr
1655
1656CALL default_vol7d_valuer_var_callback(valu, attr, genericptr)
1657
1658END SUBROUTINE default_vol7d_valuer_attr_callback
1659
1660
1661SUBROUTINE default_vol7d_valued_attr_callback(valu, var, attr, genericptr)
1662DOUBLE PRECISION,INTENT(in) :: valu
1663TYPE(vol7d_var),INTENT(in) :: var
1664TYPE(vol7d_var),INTENT(in) :: attr
1665TYPE(c_ptr),VALUE :: genericptr
1666
1667CALL default_vol7d_valued_var_callback(valu, attr, genericptr)
1668
1669END SUBROUTINE default_vol7d_valued_attr_callback
1670
1671
1672SUBROUTINE default_vol7d_valuei_attr_callback(valu, var, attr, genericptr)
1673INTEGER,INTENT(in) :: valu
1674TYPE(vol7d_var),INTENT(in) :: var
1675TYPE(vol7d_var),INTENT(in) :: attr
1676TYPE(c_ptr),VALUE :: genericptr
1677
1678CHARACTER(len=64),POINTER :: col
1679
1680CALL c_f_pointer(genericptr, col)
1681IF (c_e(valu)) THEN
1682 IF (c_e(attr%scalefactor) .AND. &
1683 .NOT.(attr%scalefactor == 0 .AND. attr%unit == 'NUMERIC')) THEN
1684 col = t2c(realdat(valu, attr))
1685 ELSE
1686 col = t2c(valu)
1687 ENDIF
1688ELSE
1689 col = ''
1690ENDIF
1691
1692END SUBROUTINE default_vol7d_valuei_attr_callback
1693
1694
1695SUBROUTINE default_vol7d_valueb_attr_callback(valu, var, attr, genericptr)
1696INTEGER(kind=int_b),INTENT(in) :: valu
1697TYPE(vol7d_var),INTENT(in) :: var
1698TYPE(vol7d_var),INTENT(in) :: attr
1699TYPE(c_ptr),VALUE :: genericptr
1700
1701CHARACTER(len=64),POINTER :: col
1702
1703IF (c_e(valu)) THEN
1704 CALL default_vol7d_valuei_var_callback(int(valu), attr, genericptr)
1705ELSE
1706 CALL c_f_pointer(genericptr, col)
1707 col = ''
1708ENDIF
1709
1710END SUBROUTINE default_vol7d_valueb_attr_callback
1711
1712
1713SUBROUTINE default_vol7d_valuec_attr_callback(valu, var, attr, genericptr)
1714CHARACTER(len=*),INTENT(in) :: valu
1715TYPE(vol7d_var),INTENT(in) :: var
1716TYPE(vol7d_var),INTENT(in) :: attr
1717TYPE(c_ptr),VALUE :: genericptr
1718
1719CHARACTER(len=64),POINTER :: col
1720
1721CALL c_f_pointer(genericptr, col)
1722IF (c_e(valu)) THEN
1723 IF (c_e(attr%scalefactor) .AND. attr%unit /= 'CCITTIA5' .AND. &
1724 .NOT.(attr%scalefactor == 0 .AND. attr%unit == 'NUMERIC')) THEN
1725 col = t2c(realdat(valu, attr))
1726 ELSE
1727 col = trim(valu)
1728 ENDIF
1729ELSE
1730 col = ''
1731ENDIF
1732
1733END SUBROUTINE default_vol7d_valuec_attr_callback
1734
1735
1736END MODULE vol7d_serialize_class
Emit log message for a category with specific priority.
Add a new option of a specific type.
Scrittura su file.
real data conversion
Represent data in a pretty string.
This module defines usefull general purpose function and subroutine.
Utilities for managing files.
classe per la gestione del logging
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.
This class allows to parse the command-line options of a program in an object-oriented way,...
Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension...
Iterator object for iterating over "column" of a line in a vol7d serialization.
Iterator object for iterating over "lines" in a vol7d serialization.
Class for serializing a vol7d object.

Generated with Doxygen.