libsim  Versione7.2.3
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 
29 use,INTRINSIC :: iso_c_binding
30 USE vol7d_class
34 USE log4fortran
35 IMPLICIT NONE
36 
37 TYPE vol7d_var_mapper
38  INTEGER :: cat
39  INTEGER :: typ
40  INTEGER :: i5, i7
41 END TYPE vol7d_var_mapper
42 
43 
46 TYPE vol7d_serialize
47  PRIVATE
48  CHARACTER(len=512),PUBLIC :: column='time,timerange,ana,level,network'
49  CHARACTER(len=512),PUBLIC :: loop='time,timerange,ana,level,network'
50  CHARACTER(len=512),PUBLIC :: variable='all'
51  CHARACTER(len=8),PUBLIC :: ext = 'ser'
52  LOGICAL,PUBLIC :: keep_miss=.false.
53  LOGICAL,PUBLIC :: no_rescale=.false.
54  LOGICAL,PUBLIC :: cachedesc=.false.
55  LOGICAL,PUBLIC :: anaonly=.false.
56  LOGICAL,PUBLIC :: dataonly=.false.
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
80 END TYPE vol7d_serialize
81 
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 
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 
138 PRIVATE
139 PUBLIC vol7d_serialize, vol7d_serialize_new, &
141 
142 CONTAINS
143 
148 FUNCTION vol7d_serialize_new() RESULT(this)
149 TYPE(vol7d_serialize) :: this
150 
151 ! these cannot be done in the class definition until F2008 pointer
152 ! initialization
153 this%vol7d_ana_callback => default_vol7d_ana_header_callback
154 this%vol7d_time_callback => default_vol7d_time_header_callback
155 this%vol7d_level_callback => default_vol7d_level_header_callback
156 this%vol7d_timerange_callback => default_vol7d_timerange_header_callback
157 this%vol7d_network_callback => default_vol7d_network_header_callback
158 this%vol7d_var_callback => default_vol7d_var_header_callback
159 this%vol7d_val_callback => default_vol7d_val_header_callback
160 this%vol7d_value_var_callback => default_vol7d_value_var_header_callback
161 this%vol7d_value_attr_callback => default_vol7d_value_attr_header_callback
162 
163 END FUNCTION vol7d_serialize_new
164 
165 
175 SUBROUTINE vol7d_serialize_optionparser(this, opt, ext)
176 CLASS(vol7d_serialize),INTENT(inout) :: this
177 TYPE(optionparser),INTENT(inout),OPTIONAL :: opt
178 CHARACTER(len=*),INTENT(in),OPTIONAL :: ext
179 
180 IF (PRESENT(ext)) this%ext = ext
181 
182 IF (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')
209 ENDIF
210 
211 END SUBROUTINE vol7d_serialize_optionparser
212 
213 
220 SUBROUTINE vol7d_serialize_parse(this, category)
221 CLASS(vol7d_serialize),INTENT(inout) :: this
222 INTEGER,INTENT(in),OPTIONAL :: category
223 
224 CALL parse_v7d_column(this%column, this%icolumn, '--'//trim(this%ext)//'-column', &
225  .false., category)
226 CALL parse_v7d_column(this%loop, this%looporder, '--'//trim(this%ext)//'-loop', &
227  .true., category)
228 
229 END 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)
236 SUBROUTINE parse_v7d_column(ccol, icol, par_name, check_all, category)
237 CHARACTER(len=*),INTENT(in) :: ccol
238 INTEGER,INTENT(out) :: icol(:)
239 CHARACTER(len=*),INTENT(in) :: par_name
240 LOGICAL,INTENT(in) :: check_all
241 INTEGER,INTENT(in),OPTIONAL :: category
242 
243 INTEGER :: i, j, nc
244 INTEGER,POINTER :: w_s(:), w_e(:)
245 
246 nc = word_split(ccol, w_s, w_e, ',')
247 j = 0
248 icol(:) = -1
249 DO 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
280 ENDDO
281 nc = j
282 DEALLOCATE(w_s, w_e)
283 
284 IF (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
302 ENDIF
303 
304 END SUBROUTINE parse_v7d_column
305 
306 
307 SUBROUTINE 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)
312 CLASS(vol7d_serialize),INTENT(inout) :: this
313 PROCEDURE(default_vol7d_ana_header_callback),OPTIONAL :: vol7d_ana_callback
314 PROCEDURE(default_vol7d_time_header_callback),OPTIONAL :: vol7d_time_callback
315 PROCEDURE(default_vol7d_level_header_callback),OPTIONAL :: vol7d_level_callback
316 PROCEDURE(default_vol7d_timerange_header_callback),OPTIONAL :: vol7d_timerange_callback
317 PROCEDURE(default_vol7d_network_header_callback),OPTIONAL :: vol7d_network_callback
318 PROCEDURE(default_vol7d_var_header_callback),OPTIONAL :: vol7d_var_callback
319 PROCEDURE(default_vol7d_val_header_callback),OPTIONAL :: vol7d_val_callback
320 PROCEDURE(default_vol7d_value_var_header_callback),OPTIONAL :: vol7d_value_var_callback
321 PROCEDURE(default_vol7d_value_attr_header_callback),OPTIONAL :: vol7d_value_attr_callback
322 
323 IF (PRESENT(vol7d_ana_callback)) this%vol7d_ana_callback => vol7d_ana_callback
324 IF (PRESENT(vol7d_time_callback)) this%vol7d_time_callback => vol7d_time_callback
325 IF (PRESENT(vol7d_level_callback)) this%vol7d_level_callback => vol7d_level_callback
326 IF (PRESENT(vol7d_timerange_callback)) this%vol7d_timerange_callback => vol7d_timerange_callback
327 IF (PRESENT(vol7d_network_callback)) this%vol7d_network_callback => vol7d_network_callback
328 IF (PRESENT(vol7d_var_callback)) this%vol7d_var_callback => vol7d_var_callback
329 IF (PRESENT(vol7d_val_callback)) this%vol7d_val_callback => vol7d_val_callback
330 IF (PRESENT(vol7d_value_var_callback)) this%vol7d_value_var_callback => vol7d_value_var_callback
331 IF (PRESENT(vol7d_value_attr_callback)) this%vol7d_value_attr_callback => vol7d_value_attr_callback
332 
333 END SUBROUTINE vol7d_serialize_set_callback
334 
335 
336 SUBROUTINE 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)
345 CLASS(vol7d_serialize_iterline),INTENT(inout) :: this
346 PROCEDURE(default_vol7d_ana_callback),OPTIONAL :: vol7d_ana_callback
347 PROCEDURE(default_vol7d_time_callback),OPTIONAL :: vol7d_time_callback
348 PROCEDURE(default_vol7d_level_callback),OPTIONAL :: vol7d_level_callback
349 PROCEDURE(default_vol7d_timerange_callback),OPTIONAL :: vol7d_timerange_callback
350 PROCEDURE(default_vol7d_network_callback),OPTIONAL :: vol7d_network_callback
351 PROCEDURE(default_vol7d_var_callback),OPTIONAL :: vol7d_var_callback
352 PROCEDURE(default_vol7d_attr_callback),OPTIONAL :: vol7d_attr_callback
353 PROCEDURE(default_vol7d_valuer_var_callback),OPTIONAL :: vol7d_valuer_var_callback
354 PROCEDURE(default_vol7d_valued_var_callback),OPTIONAL :: vol7d_valued_var_callback
355 PROCEDURE(default_vol7d_valuei_var_callback),OPTIONAL :: vol7d_valuei_var_callback
356 PROCEDURE(default_vol7d_valueb_var_callback),OPTIONAL :: vol7d_valueb_var_callback
357 PROCEDURE(default_vol7d_valuec_var_callback),OPTIONAL :: vol7d_valuec_var_callback
358 PROCEDURE(default_vol7d_valuer_attr_callback),OPTIONAL :: vol7d_valuer_attr_callback
359 PROCEDURE(default_vol7d_valued_attr_callback),OPTIONAL :: vol7d_valued_attr_callback
360 PROCEDURE(default_vol7d_valuei_attr_callback),OPTIONAL :: vol7d_valuei_attr_callback
361 PROCEDURE(default_vol7d_valueb_attr_callback),OPTIONAL :: vol7d_valueb_attr_callback
362 PROCEDURE(default_vol7d_valuec_attr_callback),OPTIONAL :: vol7d_valuec_attr_callback
363 
364 IF (PRESENT(vol7d_ana_callback)) this%vol7d_ana_callback => vol7d_ana_callback
365 IF (PRESENT(vol7d_time_callback)) this%vol7d_time_callback => vol7d_time_callback
366 IF (PRESENT(vol7d_level_callback)) this%vol7d_level_callback => vol7d_level_callback
367 IF (PRESENT(vol7d_timerange_callback)) this%vol7d_timerange_callback => vol7d_timerange_callback
368 IF (PRESENT(vol7d_network_callback)) this%vol7d_network_callback => vol7d_network_callback
369 IF (PRESENT(vol7d_var_callback)) this%vol7d_var_callback => vol7d_var_callback
370 IF (PRESENT(vol7d_attr_callback)) this%vol7d_attr_callback => vol7d_attr_callback
371 IF (PRESENT(vol7d_valuer_var_callback)) this%vol7d_valuer_var_callback => vol7d_valuer_var_callback
372 IF (PRESENT(vol7d_valued_var_callback)) this%vol7d_valued_var_callback => vol7d_valued_var_callback
373 IF (PRESENT(vol7d_valuei_var_callback)) this%vol7d_valuei_var_callback => vol7d_valuei_var_callback
374 IF (PRESENT(vol7d_valueb_var_callback)) this%vol7d_valueb_var_callback => vol7d_valueb_var_callback
375 IF (PRESENT(vol7d_valuec_var_callback)) this%vol7d_valuec_var_callback => vol7d_valuec_var_callback
376 IF (PRESENT(vol7d_valuer_attr_callback)) this%vol7d_valuer_attr_callback => vol7d_valuer_attr_callback
377 IF (PRESENT(vol7d_valued_attr_callback)) this%vol7d_valued_attr_callback => vol7d_valued_attr_callback
378 IF (PRESENT(vol7d_valuei_attr_callback)) this%vol7d_valuei_attr_callback => vol7d_valuei_attr_callback
379 IF (PRESENT(vol7d_valueb_attr_callback)) this%vol7d_valueb_attr_callback => vol7d_valueb_attr_callback
380 IF (PRESENT(vol7d_valuec_attr_callback)) this%vol7d_valuec_attr_callback => vol7d_valuec_attr_callback
381 
382 END SUBROUTINE vol7d_serialize_iterline_set_callback
383 
384 
385 SUBROUTINE vol7d_serialize_setup(this, v7d)
386 CLASS(vol7d_serialize),INTENT(inout) :: this
387 TYPE(vol7d),INTENT(in),TARGET :: v7d
388 
389 INTEGER :: nv, nav, ndv, i, j, n
390 INTEGER,POINTER :: w_s(:), w_e(:)
391 TYPE(vol7d_var_mapper),ALLOCATABLE :: mapper_tmp(:)
392 
393 !!CALL vol7d_alloc_vol(v7d) ! be safe
394 this%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 
410 CALL var_mapper(this%mapper, v7d, this%anaonly, this%dataonly)
411 
412 ! Filter and sort requested variables
413 IF (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)
429 ENDIF
430 
431 ! If only ana volume, skip data-only dimensions
432 IF (SIZE(v7d%time) == 0) THEN
433  WHERE (this%icolumn(:) == vol7d_time_d)
434  this%icolumn(:) = -1
435  END WHERE
436 ENDIF
437 IF (SIZE(v7d%level) == 0) THEN
438  WHERE (this%icolumn(:) == vol7d_level_d)
439  this%icolumn(:) = -1
440  END WHERE
441 ENDIF
442 IF (SIZE(v7d%timerange) == 0) THEN
443  WHERE (this%icolumn(:) == vol7d_timerange_d)
444  this%icolumn(:) = -1
445  END WHERE
446 ENDIF
447 this%anavol = SIZE(v7d%time) == 0 .AND. SIZE(v7d%level) == 0 .AND. &
448  SIZE(v7d%timerange) == 0
449 
450 nav = count(this%mapper(:)%cat == 1)
451 ndv = count(this%mapper(:)%cat == 3)
452 
453 ! For column reordering
454 this%loopstart(:) = 1
455 this%loopend(:) = 0
456 WHERE (this%looporder(:) == vol7d_ana_d)
457  this%loopend(:) = SIZE(v7d%ana)
458 END WHERE
459 WHERE (this%looporder(:) == vol7d_time_d)
460  this%loopend(:) = SIZE(v7d%time)
461 END WHERE
462 WHERE (this%looporder(:) == vol7d_level_d)
463  this%loopend(:) = SIZE(v7d%level)
464 END WHERE
465 WHERE (this%looporder(:) == vol7d_timerange_d)
466  this%loopend(:) = SIZE(v7d%timerange)
467 END WHERE
468 WHERE (this%looporder(:) == vol7d_var_d)
469  this%loopend(:) = SIZE(this%mapper)
470 END WHERE
471 WHERE (this%looporder(:) == vol7d_network_d)
472  this%loopend(:) = SIZE(v7d%network)
473 END WHERE
474 
475 ! invert this%looporder
476 this%loopinvorder(vol7d_ana_d) = firsttrue(this%looporder(:) == vol7d_ana_d)
477 this%loopinvorder(vol7d_time_d) = firsttrue(this%looporder(:) == vol7d_time_d)
478 this%loopinvorder(vol7d_level_d) = firsttrue(this%looporder(:) == vol7d_level_d)
479 this%loopinvorder(vol7d_timerange_d) = firsttrue(this%looporder(:) == vol7d_timerange_d)
480 this%loopinvorder(vol7d_var_d) = firsttrue(this%looporder(:) == vol7d_var_d)
481 this%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
485 IF (this%loopinvorder(vol7d_var_d) <= 0) THEN
486  this%ndvar = 5
487 ELSE
488  this%ndvar = 6
489 ENDIF
490 
491 CONTAINS
492 
493 SUBROUTINE checkvarvect(varvect)
494 TYPE(vol7d_varvect),INTENT(inout) :: varvect
495 
496 CALL checkvar(varvect%r)
497 CALL checkvar(varvect%d)
498 CALL checkvar(varvect%i)
499 CALL checkvar(varvect%b)
500 CALL checkvar(varvect%c)
501 
502 END SUBROUTINE checkvarvect
503 
504 SUBROUTINE checkvar(var)
505 TYPE(vol7d_var),POINTER :: var(:)
506 
507 INTEGER :: i, j
508 
509 IF (.NOT.ASSOCIATED(var)) RETURN
510 
511 v7dvarloop: 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
518 ENDDO v7dvarloop
519 
520 END SUBROUTINE checkvar
521 
522 END SUBROUTINE vol7d_serialize_setup
523 
524 
525 FUNCTION vol7d_serialize_iterline_new(this) RESULT(iterator)
526 CLASS(vol7d_serialize),INTENT(in),TARGET :: this
527 TYPE(vol7d_serialize_iterline) :: iterator
528 
529 iterator%ser => this
530 iterator%loopind(:) = this%loopstart(:)
531 ! these cannot be done in the class definition until F2008 pointer
532 ! initialization
533 iterator%vol7d_ana_callback => default_vol7d_ana_callback
534 iterator%vol7d_time_callback => default_vol7d_time_callback
535 iterator%vol7d_level_callback => default_vol7d_level_callback
536 iterator%vol7d_timerange_callback => default_vol7d_timerange_callback
537 iterator%vol7d_network_callback => default_vol7d_network_callback
538 iterator%vol7d_var_callback => default_vol7d_var_callback
539 iterator%vol7d_attr_callback => default_vol7d_attr_callback
540 iterator%vol7d_valuer_var_callback => default_vol7d_valuer_var_callback
541 iterator%vol7d_valued_var_callback => default_vol7d_valued_var_callback
542 iterator%vol7d_valuei_var_callback => default_vol7d_valuei_var_callback
543 iterator%vol7d_valueb_var_callback => default_vol7d_valueb_var_callback
544 iterator%vol7d_valuec_var_callback => default_vol7d_valuec_var_callback
545 iterator%vol7d_valuer_attr_callback => default_vol7d_valuer_attr_callback
546 iterator%vol7d_valued_attr_callback => default_vol7d_valued_attr_callback
547 iterator%vol7d_valuei_attr_callback => default_vol7d_valuei_attr_callback
548 iterator%vol7d_valueb_attr_callback => default_vol7d_valueb_attr_callback
549 iterator%vol7d_valuec_attr_callback => default_vol7d_valuec_attr_callback
550 
551 END FUNCTION vol7d_serialize_iterline_new
552 
553 
554 FUNCTION vol7d_serialize_iterline_next(this) RESULT(next)
555 CLASS(vol7d_serialize_iterline),INTENT(inout) :: this
556 LOGICAL :: next
557 
558 INTEGER :: i
559 LOGICAL :: colmask(6)
560 
561 IF (.NOT.ASSOCIATED(this%ser)) THEN ! safety check
562  this%status = 3
563  next = .false.
564  RETURN
565 ENDIF
566 
567 loop7d: 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 
639 END DO loop7d
640 
641 END FUNCTION vol7d_serialize_iterline_next
642 
643 
644 FUNCTION vol7d_serialize_itercol_new_ser(this) RESULT(iterator)
645 CLASS(vol7d_serialize),INTENT(in),TARGET :: this
646 TYPE(vol7d_serialize_itercol) :: iterator
647 
648 iterator%ser => this
649 IF (this%ndvar == 5) THEN ! all variables in one line
650  iterator%iend = SIZE(this%icolumn) + SIZE(this%mapper)
651 ELSE ! one variable per line
652  iterator%iend = SIZE(this%icolumn)
653 ENDIF
654 
655 END FUNCTION vol7d_serialize_itercol_new_ser
656 
657 
658 FUNCTION vol7d_serialize_itercol_new_line(this) RESULT(iterator)
659 CLASS(vol7d_serialize_iterline),INTENT(in),TARGET :: this
660 TYPE(vol7d_serialize_itercol) :: iterator
661 
662 iterator%ser => this%ser
663 iterator%line => this
664 iterator%i = 0 ! 1?
665 IF (this%i5 == 0) THEN ! all variables in one line
666  iterator%iend = SIZE(this%ser%icolumn) + SIZE(this%ser%mapper)
667 ELSE ! one variable per line
668  iterator%iend = SIZE(this%ser%icolumn)
669 ENDIF
670 
671 
672 END FUNCTION vol7d_serialize_itercol_new_line
673 
674 
675 FUNCTION vol7d_serialize_itercol_next(this) RESULT(next)
676 CLASS(vol7d_serialize_itercol),INTENT(inout) :: this
677 LOGICAL :: next
678 
679 INTEGER :: icol
680 
681 DO 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
697 ENDDO ! end of columns
698 
699 next = .false.
700 
701 END FUNCTION vol7d_serialize_itercol_next
702 
703 
704 SUBROUTINE vol7d_serialize_itercol_call(this, genericptr)
705 CLASS(vol7d_serialize_itercol),INTENT(inout) :: this
706 TYPE(c_ptr),VALUE :: genericptr
707 
708 INTEGER :: icol, icolorder
709 
710 IF (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 
741 ELSE ! 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
747 ENDIF
748 
749 END SUBROUTINE vol7d_serialize_itercol_call
750 
751 
752 SUBROUTINE call_header_desc_callback(this, genericptr)
753 CLASS(vol7d_serialize_itercol),INTENT(in) :: this
754 TYPE(c_ptr),VALUE :: genericptr
755 
756 SELECT CASE(this%ser%icolumn(this%i))
757 
758 CASE(vol7d_ana_d)
759  CALL this%ser%vol7d_ana_callback(genericptr)
760 
761 CASE(vol7d_time_d)
762  CALL this%ser%vol7d_time_callback(genericptr)
763 
764 CASE(vol7d_level_d)
765  CALL this%ser%vol7d_level_callback(genericptr)
766 
767 CASE(vol7d_timerange_d)
768  CALL this%ser%vol7d_timerange_callback(genericptr)
769 
770 CASE(vol7d_network_d)
771  CALL this%ser%vol7d_network_callback(genericptr)
772 
773 CASE(vol7d_var_d)
774  CALL this%ser%vol7d_var_callback(genericptr)
775 
776 CASE(7)
777  CALL this%ser%vol7d_val_callback(genericptr)
778 
779 END SELECT
780 
781 END SUBROUTINE call_header_desc_callback
782 
783 
784 SUBROUTINE call_header_value_callback(this, genericptr)
785 CLASS(vol7d_serialize_itercol),INTENT(in) :: this
786 TYPE(c_ptr),VALUE :: genericptr
787 
788 INTEGER :: ind, varind, attrind
789 
790 ! here the variable index this%line%i5 is not available, I use this%i-7 as a proxy
791 ind = this%i - 7
792 varind = this%ser%mapper(ind)%i5
793 attrind = this%ser%mapper(ind)%i7
794 
795 SELECT CASE(this%ser%mapper(ind)%cat)
796 CASE(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
809 CASE(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
827 CASE(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
840 CASE(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
858 END SELECT
859 
860 END SUBROUTINE call_header_value_callback
861 
862 
863 SUBROUTINE default_vol7d_ana_header_callback(genericptr)
864 TYPE(c_ptr),VALUE :: genericptr
865 
866 CHARACTER(len=64),POINTER :: col
867 
868 CALL c_f_pointer(genericptr, col)
869 col = 'Longitude,Latitude'
870 
871 END SUBROUTINE default_vol7d_ana_header_callback
872 
873 SUBROUTINE default_vol7d_time_header_callback(genericptr)
874 TYPE(c_ptr),VALUE :: genericptr
875 
876 CHARACTER(len=64),POINTER :: col
877 
878 CALL c_f_pointer(genericptr, col)
879 col = 'Date'
880 
881 END SUBROUTINE default_vol7d_time_header_callback
882 
883 SUBROUTINE default_vol7d_level_header_callback(genericptr)
884 TYPE(c_ptr),VALUE :: genericptr
885 
886 CHARACTER(len=64),POINTER :: col
887 
888 CALL c_f_pointer(genericptr, col)
889 col = 'Level1,L1,Level2,L2'
890 
891 END SUBROUTINE default_vol7d_level_header_callback
892 
893 SUBROUTINE default_vol7d_timerange_header_callback(genericptr)
894 TYPE(c_ptr),VALUE :: genericptr
895 
896 CHARACTER(len=64),POINTER :: col
897 
898 CALL c_f_pointer(genericptr, col)
899 col = 'Time range,P1,P2'
900 
901 END SUBROUTINE default_vol7d_timerange_header_callback
902 
903 SUBROUTINE default_vol7d_network_header_callback(genericptr)
904 TYPE(c_ptr),VALUE :: genericptr
905 
906 CHARACTER(len=64),POINTER :: col
907 
908 CALL c_f_pointer(genericptr, col)
909 col = 'Report'
910 
911 END SUBROUTINE default_vol7d_network_header_callback
912 
913 SUBROUTINE default_vol7d_var_header_callback(genericptr)
914 TYPE(c_ptr),VALUE :: genericptr
915 
916 CHARACTER(len=64),POINTER :: col
917 
918 CALL c_f_pointer(genericptr, col)
919 col = 'Variable'
920 
921 END SUBROUTINE default_vol7d_var_header_callback
922 
923 SUBROUTINE default_vol7d_val_header_callback(genericptr)
924 TYPE(c_ptr),VALUE :: genericptr
925 
926 CHARACTER(len=64),POINTER :: col
927 
928 CALL c_f_pointer(genericptr, col)
929 col = 'Value'
930 
931 END SUBROUTINE default_vol7d_val_header_callback
932 
933 SUBROUTINE default_vol7d_value_var_header_callback(var, typ, genericptr)
934 TYPE(vol7d_var),INTENT(in) :: var
935 CHARACTER(len=2),INTENT(in) :: typ
936 TYPE(c_ptr),VALUE :: genericptr
937 
938 CHARACTER(len=64),POINTER :: col
939 
940 CALL c_f_pointer(genericptr, col)
941 col = var%btable
942 
943 END SUBROUTINE default_vol7d_value_var_header_callback
944 
945 SUBROUTINE default_vol7d_value_attr_header_callback(var, attr, typ, genericptr)
946 TYPE(vol7d_var),INTENT(in) :: var
947 TYPE(vol7d_var),INTENT(in) :: attr
948 CHARACTER(len=2),INTENT(in) :: typ
949 TYPE(c_ptr),VALUE :: genericptr
950 
951 CHARACTER(len=64),POINTER :: col
952 
953 CALL c_f_pointer(genericptr, col)
954 col = trim(var%btable)//'.'//attr%btable
955 
956 END SUBROUTINE default_vol7d_value_attr_header_callback
957 
958 
959 SUBROUTINE call_desc_callback(this, genericptr)
960 CLASS(vol7d_serialize_itercol),INTENT(in) :: this
961 TYPE(c_ptr),VALUE :: genericptr
962 
963 INTEGER :: icol, ind, varind, attrind
964 
965 icol = this%ser%icolumn(this%i)
966 ind = this%line%loopind(this%ser%loopinvorder(icol))
967 
968 SELECT CASE(icol)
969 
970 CASE(vol7d_ana_d)
971  CALL this%line%vol7d_ana_callback(this%ser%v7d%ana(ind), genericptr)
972 
973 CASE(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 
980 CASE(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 
987 CASE(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 
994 CASE(vol7d_network_d)
995  CALL this%line%vol7d_network_callback(this%ser%v7d%network(ind), genericptr)
996 
997 CASE(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 
1065 END SELECT
1066 
1067 END SUBROUTINE call_desc_callback
1068 
1069 
1070 SUBROUTINE default_vol7d_ana_callback(ana, genericptr)
1071 TYPE(vol7d_ana), INTENT(in) :: ana
1072 TYPE(c_ptr),VALUE :: genericptr
1073 
1074 CHARACTER(len=64),POINTER :: col
1075 
1076 CALL c_f_pointer(genericptr, col)
1077 
1078 col = trim(adjustl(to_char(getlon(ana%coord),miss="",form="(f10.5)")))//&
1079  ','//trim(adjustl(to_char(getlat(ana%coord),miss="",form="(f10.5)")))
1080 
1081 END SUBROUTINE default_vol7d_ana_callback
1082 
1083 
1084 SUBROUTINE default_vol7d_time_callback(time, genericptr)
1085 TYPE(datetime), INTENT(in) :: time
1086 TYPE(c_ptr),VALUE :: genericptr
1087 
1088 CHARACTER(len=64),POINTER :: col
1089 
1090 CALL c_f_pointer(genericptr, col)
1091 col = ''
1092 IF (time /= datetime_miss) THEN
1093  CALL getval(time, isodate=col(1:19))
1094 ENDIF
1095 
1096 END SUBROUTINE default_vol7d_time_callback
1097 
1098 
1099 SUBROUTINE default_vol7d_level_callback(level, genericptr)
1100 TYPE(vol7d_level), INTENT(in) :: level
1101 TYPE(c_ptr),VALUE :: genericptr
1102 
1103 CHARACTER(len=64),POINTER :: col
1104 
1105 CALL c_f_pointer(genericptr, col)
1106 col = t2c(level%level1, '')//','// &
1107  t2c(level%l1, '')//','// &
1108  t2c(level%level2, '')//','// &
1109  t2c(level%l2, '')
1110 
1111 END SUBROUTINE default_vol7d_level_callback
1112 
1113 
1114 SUBROUTINE default_vol7d_timerange_callback(timerange, genericptr)
1115 TYPE(vol7d_timerange), INTENT(in) :: timerange
1116 TYPE(c_ptr),VALUE :: genericptr
1117 
1118 CHARACTER(len=64),POINTER :: col
1119 
1120 CALL c_f_pointer(genericptr, col)
1121 col = t2c(timerange%timerange, '')//','// &
1122  t2c(timerange%p1, '')//','//t2c(timerange%p2, '')
1123 
1124 END SUBROUTINE default_vol7d_timerange_callback
1125 
1126 
1127 SUBROUTINE default_vol7d_network_callback(network, genericptr)
1128 TYPE(vol7d_network), INTENT(in) :: network
1129 TYPE(c_ptr),VALUE :: genericptr
1130 
1131 CHARACTER(len=64),POINTER :: col
1132 
1133 CALL c_f_pointer(genericptr, col)
1134 IF (c_e(network)) THEN
1135  col = network%name
1136 ELSE
1137  col = ''
1138 ENDIF
1139 
1140 END SUBROUTINE default_vol7d_network_callback
1141 
1142 
1143 SUBROUTINE default_vol7d_var_callback(var, genericptr)
1144 TYPE(vol7d_var), INTENT(in) :: var
1145 TYPE(c_ptr),VALUE :: genericptr
1146 
1147 CHARACTER(len=64),POINTER :: col
1148 
1149 CALL c_f_pointer(genericptr, col)
1150 IF (c_e(var)) THEN
1151  col = var%btable
1152 ELSE
1153  col = ''
1154 ENDIF
1155 
1156 END SUBROUTINE default_vol7d_var_callback
1157 
1158 
1159 SUBROUTINE default_vol7d_attr_callback(var, attr, genericptr)
1160 TYPE(vol7d_var), INTENT(in) :: var
1161 TYPE(vol7d_var), INTENT(in) :: attr
1162 TYPE(c_ptr),VALUE :: genericptr
1163 
1164 CHARACTER(len=64),POINTER :: col
1165 
1166 CALL c_f_pointer(genericptr, col)
1167 IF (c_e(var) .AND. c_e(attr)) THEN
1168  col = trim(var%btable)//'.'//attr%btable
1169 ELSE
1170  col = ''
1171 ENDIF
1172 
1173 END SUBROUTINE default_vol7d_attr_callback
1174 
1175 
1176 ! create a var_mapper object from the v7d volume provided
1177 SUBROUTINE var_mapper(mapper, v7d, anaonly, dataonly)
1178 TYPE(vol7d_var_mapper),ALLOCATABLE :: mapper(:)
1179 TYPE(vol7d),INTENT(in) :: v7d
1180 LOGICAL,INTENT(in) :: anaonly
1181 LOGICAL,INTENT(in) :: dataonly
1182 
1183 INTEGER :: n
1184 
1185 n = 0
1186 
1187 IF (.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)
1204 ENDIF
1205 
1206 IF (.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)
1223 ENDIF
1224 
1225 ALLOCATE(mapper(n))
1226 
1227 n = 0
1228 
1229 IF (.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
1261 ENDIF
1262 
1263 IF (.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
1295 ENDIF
1296 
1297 CONTAINS
1298 
1299 SUBROUTINE set_mapper(cat, typ, s1, s2)
1300 INTEGER,INTENT(in) :: cat
1301 INTEGER,INTENT(in) :: typ
1302 INTEGER,INTENT(in) :: s1, s2
1303 
1304 INTEGER :: i, j, n1
1305 
1306 n1 = n + s1*s2
1307 mapper(n+1:n1)%cat = cat
1308 mapper(n+1:n1)%typ = typ
1309 mapper(n+1:n1)%i5 = (/((i,i=1,s2),j=1,s1)/)
1310 mapper(n+1:n1)%i7 = (/((j,i=1,s2),j=1,s1)/)
1311 n = n1
1312 
1313 END SUBROUTINE set_mapper
1314 
1315 END SUBROUTINE var_mapper
1316 
1317 
1318 ! determine whether the volume mapped by mapper has missing values for
1319 ! every variable at the indicated position
1320 FUNCTION var_mapper_miss(mapper, v7d, i1, i2, i3, i4, i6, analine) RESULT(miss)
1321 TYPE(vol7d_var_mapper),INTENT(in) :: mapper(:)
1322 TYPE(vol7d),INTENT(in) :: v7d
1323 INTEGER,INTENT(in) :: i1, i2, i3, i4, i6
1324 LOGICAL,INTENT(in) :: analine
1325 LOGICAL :: miss
1326 
1327 INTEGER :: ind, varind, attrind
1328 
1329 miss = .true.
1330 DO 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
1393 ENDDO
1394 
1395 END 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
1400 FUNCTION var_mapper_searchvar(mapper, v7d, var) RESULT(ind)
1401 TYPE(vol7d_var_mapper),INTENT(in) :: mapper(:)
1402 TYPE(vol7d),INTENT(in) :: v7d
1403 TYPE(vol7d_var),INTENT(in) :: var
1404 
1405 INTEGER :: ind
1406 INTEGER :: varind
1407 
1408 DO 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
1440 END DO
1441 
1442 ind = 0 ! not found
1443 
1444 END FUNCTION var_mapper_searchvar
1445 
1446 
1447 SUBROUTINE call_value_callback(this, genericptr)
1448 CLASS(vol7d_serialize_itercol),INTENT(inout) :: this
1449 TYPE(c_ptr),VALUE :: genericptr
1450 
1451 INTEGER :: ind, varind, attrind
1452 
1453 ind = this%line%i5
1454 varind = this%ser%mapper(ind)%i5
1455 attrind = this%ser%mapper(ind)%i7
1456 
1457 SELECT CASE(this%ser%mapper(ind)%cat)
1458 CASE(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
1481 CASE(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
1504 CASE(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
1527 CASE(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
1550 END SELECT
1551 
1552 END SUBROUTINE call_value_callback
1553 
1554 
1555 SUBROUTINE default_vol7d_valuer_var_callback(valu, var, genericptr)
1556 REAL,INTENT(in) :: valu
1557 TYPE(vol7d_var),INTENT(in) :: var
1558 TYPE(c_ptr),VALUE :: genericptr
1559 
1560 CHARACTER(len=64),POINTER :: col
1561 
1562 CALL c_f_pointer(genericptr, col)
1563 IF (c_e(valu)) THEN
1564  col = t2c(valu)
1565 ELSE
1566  col = ''
1567 ENDIF
1568 
1569 END SUBROUTINE default_vol7d_valuer_var_callback
1570 
1571 
1572 SUBROUTINE default_vol7d_valued_var_callback(valu, var, genericptr)
1573 DOUBLE PRECISION,INTENT(in) :: valu
1574 TYPE(vol7d_var),INTENT(in) :: var
1575 TYPE(c_ptr),VALUE :: genericptr
1576 
1577 CHARACTER(len=64),POINTER :: col
1578 
1579 CALL c_f_pointer(genericptr, col)
1580 IF (c_e(valu)) THEN
1581  col = t2c(valu)
1582 ELSE
1583  col = ''
1584 ENDIF
1585 
1586 END SUBROUTINE default_vol7d_valued_var_callback
1587 
1588 
1589 SUBROUTINE default_vol7d_valuei_var_callback(valu, var, genericptr)
1590 INTEGER,INTENT(in) :: valu
1591 TYPE(vol7d_var),INTENT(in) :: var
1592 TYPE(c_ptr),VALUE :: genericptr
1593 
1594 CHARACTER(len=64),POINTER :: col
1595 
1596 CALL c_f_pointer(genericptr, col)
1597 IF (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
1604 ELSE
1605  col = ''
1606 ENDIF
1607 
1608 END SUBROUTINE default_vol7d_valuei_var_callback
1609 
1610 
1611 SUBROUTINE default_vol7d_valueb_var_callback(valu, var, genericptr)
1612 INTEGER(kind=int_b),INTENT(in) :: valu
1613 TYPE(vol7d_var),INTENT(in) :: var
1614 TYPE(c_ptr),VALUE :: genericptr
1615 
1616 CHARACTER(len=64),POINTER :: col
1617 
1618 IF (c_e(valu)) THEN
1619  CALL default_vol7d_valuei_var_callback(int(valu), var, genericptr)
1620 ELSE
1621  CALL c_f_pointer(genericptr, col)
1622  col = ''
1623 ENDIF
1624 
1625 END SUBROUTINE default_vol7d_valueb_var_callback
1626 
1627 
1628 SUBROUTINE default_vol7d_valuec_var_callback(valu, var, genericptr)
1629 CHARACTER(len=*),INTENT(in) :: valu
1630 TYPE(vol7d_var),INTENT(in) :: var
1631 TYPE(c_ptr),VALUE :: genericptr
1632 
1633 CHARACTER(len=64),POINTER :: col
1634 
1635 CALL c_f_pointer(genericptr, col)
1636 IF (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
1643 ELSE
1644  col = ''
1645 ENDIF
1646 
1647 END SUBROUTINE default_vol7d_valuec_var_callback
1648 
1649 
1650 SUBROUTINE default_vol7d_valuer_attr_callback(valu, var, attr, genericptr)
1651 REAL,INTENT(in) :: valu
1652 TYPE(vol7d_var),INTENT(in) :: var
1653 TYPE(vol7d_var),INTENT(in) :: attr
1654 TYPE(c_ptr),VALUE :: genericptr
1655 
1656 CALL default_vol7d_valuer_var_callback(valu, attr, genericptr)
1657 
1658 END SUBROUTINE default_vol7d_valuer_attr_callback
1659 
1660 
1661 SUBROUTINE default_vol7d_valued_attr_callback(valu, var, attr, genericptr)
1662 DOUBLE PRECISION,INTENT(in) :: valu
1663 TYPE(vol7d_var),INTENT(in) :: var
1664 TYPE(vol7d_var),INTENT(in) :: attr
1665 TYPE(c_ptr),VALUE :: genericptr
1666 
1667 CALL default_vol7d_valued_var_callback(valu, attr, genericptr)
1668 
1669 END SUBROUTINE default_vol7d_valued_attr_callback
1670 
1671 
1672 SUBROUTINE default_vol7d_valuei_attr_callback(valu, var, attr, genericptr)
1673 INTEGER,INTENT(in) :: valu
1674 TYPE(vol7d_var),INTENT(in) :: var
1675 TYPE(vol7d_var),INTENT(in) :: attr
1676 TYPE(c_ptr),VALUE :: genericptr
1677 
1678 CHARACTER(len=64),POINTER :: col
1679 
1680 CALL c_f_pointer(genericptr, col)
1681 IF (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
1688 ELSE
1689  col = ''
1690 ENDIF
1691 
1692 END SUBROUTINE default_vol7d_valuei_attr_callback
1693 
1694 
1695 SUBROUTINE default_vol7d_valueb_attr_callback(valu, var, attr, genericptr)
1696 INTEGER(kind=int_b),INTENT(in) :: valu
1697 TYPE(vol7d_var),INTENT(in) :: var
1698 TYPE(vol7d_var),INTENT(in) :: attr
1699 TYPE(c_ptr),VALUE :: genericptr
1700 
1701 CHARACTER(len=64),POINTER :: col
1702 
1703 IF (c_e(valu)) THEN
1704  CALL default_vol7d_valuei_var_callback(int(valu), attr, genericptr)
1705 ELSE
1706  CALL c_f_pointer(genericptr, col)
1707  col = ''
1708 ENDIF
1709 
1710 END SUBROUTINE default_vol7d_valueb_attr_callback
1711 
1712 
1713 SUBROUTINE default_vol7d_valuec_attr_callback(valu, var, attr, genericptr)
1714 CHARACTER(len=*),INTENT(in) :: valu
1715 TYPE(vol7d_var),INTENT(in) :: var
1716 TYPE(vol7d_var),INTENT(in) :: attr
1717 TYPE(c_ptr),VALUE :: genericptr
1718 
1719 CHARACTER(len=64),POINTER :: col
1720 
1721 CALL c_f_pointer(genericptr, col)
1722 IF (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
1729 ELSE
1730  col = ''
1731 ENDIF
1732 
1733 END SUBROUTINE default_vol7d_valuec_attr_callback
1734 
1735 
1736 END MODULE vol7d_serialize_class
Extension of vol7d_class for serializing the contents of a volume.
Module for parsing command-line optons.
Represent data in a pretty string.
Scrittura su file.
Utilities for managing files.
Test for a missing volume.
Classe per la gestione di un volume completo di dati osservati.
Iterator object for iterating over "column" of a line in a vol7d serialization.
This module defines usefull general purpose function and subroutine.
Class for serializing a vol7d object.
classe per la gestione del logging
real data conversion
Emit log message for a category with specific priority.
Iterator object for iterating over "lines" in a vol7d serialization.
Add a new option of a specific type.

Generated with Doxygen.