libsim Versione 7.2.1
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
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
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
80END 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
138PRIVATE
139PUBLIC vol7d_serialize, vol7d_serialize_new, &
141
142CONTAINS
143
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
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
220SUBROUTINE vol7d_serialize_parse(this, category)
221CLASS(vol7d_serialize),INTENT(inout) :: this
222INTEGER,INTENT(in),OPTIONAL :: category
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.