29 use,
INTRINSIC :: iso_c_binding
41 END TYPE vol7d_var_mapper
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.
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
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
88 CLASS(vol7d_serialize),
POINTER :: ser=>null()
91 INTEGER :: i1, i2, i3, i4, i5, i6
92 INTEGER :: lastind(6)=0
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
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
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.
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
148 FUNCTION vol7d_serialize_new()
RESULT(this)
149 TYPE(vol7d_serialize) :: this
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
163 END FUNCTION vol7d_serialize_new
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
180 IF (
PRESENT(ext)) this%ext = ext
182 IF (
PRESENT(opt))
THEN
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')
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 &
211 END SUBROUTINE vol7d_serialize_optionparser
220 SUBROUTINE vol7d_serialize_parse(this, category)
222 INTEGER,
INTENT(in),
OPTIONAL :: category
224 CALL parse_v7d_column(this%column, this%icolumn,
'--'//trim(this%ext)//
'-column', &
226 CALL parse_v7d_column(this%loop, this%looporder,
'--'//trim(this%ext)//
'-loop', &
229 END SUBROUTINE vol7d_serialize_parse
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
244 INTEGER,
POINTER :: w_s(:), w_e(:)
246 nc = word_split(ccol, w_s, w_e,
',')
249 DO i = 1, min(nc,
SIZE(icol))
250 SELECT CASE(ccol(w_s(i):w_e(i)))
253 icol(j) = vol7d_time_d
256 icol(j) = vol7d_timerange_d
259 icol(j) = vol7d_level_d
262 icol(j) = vol7d_ana_d
265 icol(j) = vol7d_var_d
268 icol(j) = vol7d_network_d
273 IF (
PRESENT(category))
THEN
275 'error in command-line parameters, column '// &
276 ccol(w_s(i):w_e(i))//
' in '//trim(par_name)//
' not valid.')
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
290 'error in command-line parameters, some columns missing in '// &
291 trim(par_name)//
' .')
295 IF (any(icol == 7))
THEN
296 IF (
PRESENT(category))
THEN
298 trim(par_name)//
' .')
304 END SUBROUTINE parse_v7d_column
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)
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
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
333 END SUBROUTINE vol7d_serialize_set_callback
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)
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
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
382 END SUBROUTINE vol7d_serialize_iterline_set_callback
385 SUBROUTINE vol7d_serialize_setup(this, v7d)
387 TYPE(
vol7d),
INTENT(in),
TARGET :: v7d
389 INTEGER :: nv, nav, ndv, i, j, n
390 INTEGER,
POINTER :: w_s(:), w_e(:)
391 TYPE(vol7d_var_mapper),
ALLOCATABLE :: mapper_tmp(:)
410 CALL var_mapper(this%mapper, v7d, this%anaonly, this%dataonly)
413 IF (this%variable /=
'all')
THEN
414 nv = word_split(this%variable, w_s, w_e,
',')
415 ALLOCATE(mapper_tmp(nv))
418 n = var_mapper_searchvar(this%mapper, v7d, &
419 vol7d_var_new(btable=this%variable(w_s(i):w_e(i))))
422 mapper_tmp(j) = this%mapper(n)
425 DEALLOCATE(this%mapper)
426 ALLOCATE(this%mapper(j))
427 this%mapper = mapper_tmp(1:j)
432 IF (
SIZE(v7d%time) == 0)
THEN
433 WHERE (this%icolumn(:) == vol7d_time_d)
437 IF (
SIZE(v7d%level) == 0)
THEN
438 WHERE (this%icolumn(:) == vol7d_level_d)
442 IF (
SIZE(v7d%timerange) == 0)
THEN
443 WHERE (this%icolumn(:) == vol7d_timerange_d)
447 this%anavol =
SIZE(v7d%time) == 0 .AND.
SIZE(v7d%level) == 0 .AND. &
448 SIZE(v7d%timerange) == 0
450 nav = count(this%mapper(:)%cat == 1)
451 ndv = count(this%mapper(:)%cat == 3)
454 this%loopstart(:) = 1
456 WHERE (this%looporder(:) == vol7d_ana_d)
457 this%loopend(:) =
SIZE(v7d%ana)
459 WHERE (this%looporder(:) == vol7d_time_d)
460 this%loopend(:) =
SIZE(v7d%time)
462 WHERE (this%looporder(:) == vol7d_level_d)
463 this%loopend(:) =
SIZE(v7d%level)
465 WHERE (this%looporder(:) == vol7d_timerange_d)
466 this%loopend(:) =
SIZE(v7d%timerange)
468 WHERE (this%looporder(:) == vol7d_var_d)
469 this%loopend(:) =
SIZE(this%mapper)
471 WHERE (this%looporder(:) == vol7d_network_d)
472 this%loopend(:) =
SIZE(v7d%network)
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)
485 IF (this%loopinvorder(vol7d_var_d) <= 0)
THEN
493 SUBROUTINE checkvarvect(varvect)
494 TYPE(vol7d_varvect),
INTENT(inout) :: varvect
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)
502 END SUBROUTINE checkvarvect
504 SUBROUTINE checkvar(var)
505 TYPE(vol7d_var),
POINTER :: var(:)
509 IF (.NOT.
ASSOCIATED(var))
RETURN
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
517 var(i) = vol7d_var_miss
520 END SUBROUTINE checkvar
522 END SUBROUTINE vol7d_serialize_setup
525 FUNCTION vol7d_serialize_iterline_new(this)
RESULT(iterator)
530 iterator%loopind(:) = this%loopstart(:)
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
551 END FUNCTION vol7d_serialize_iterline_new
554 FUNCTION vol7d_serialize_iterline_next(this)
RESULT(next)
559 LOGICAL :: colmask(6)
561 IF (.NOT.
ASSOCIATED(this%ser))
THEN
567 loop7d:
DO WHILE(.true.)
569 IF (this%status == 0)
THEN
573 IF (this%ser%anavol)
THEN
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.
581 this%loopind(1:this%ser%ndvar) > this%ser%loopend(1:this%ser%ndvar) .AND. &
582 colmask(1:this%ser%ndvar)))
THEN
590 DO i = this%ser%ndvar, 1, -1
591 IF (this%loopind(i) < this%ser%loopend(i))
THEN
592 this%loopind(i) = this%loopind(i) + 1
595 this%loopind(i) = this%ser%loopstart(i)
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))
612 IF (this%ser%ndvar == 5)
THEN
614 this%analine = this%ser%anavol .OR. this%ser%anaonly
616 IF (this%analine)
THEN
617 IF (this%i2 /= 1 .OR. this%i3 /= 1 .OR. this%i4 /= 1) cycle
619 IF (.NOT.this%ser%keep_miss)
THEN
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
624 this%i5 = this%loopind(this%ser%loopinvorder(vol7d_var_d))
625 this%analine = (this%ser%mapper(this%i5)%cat <= 2)
627 IF (this%analine)
THEN
628 IF (this%i2 /= 1 .OR. this%i3 /= 1 .OR. this%i4 /= 1) cycle
630 IF (.NOT.this%ser%keep_miss)
THEN
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
641 END FUNCTION vol7d_serialize_iterline_next
644 FUNCTION vol7d_serialize_itercol_new_ser(this)
RESULT(iterator)
649 IF (this%ndvar == 5)
THEN
650 iterator%iend =
SIZE(this%icolumn) +
SIZE(this%mapper)
652 iterator%iend =
SIZE(this%icolumn)
655 END FUNCTION vol7d_serialize_itercol_new_ser
658 FUNCTION vol7d_serialize_itercol_new_line(this)
RESULT(iterator)
662 iterator%ser => this%ser
663 iterator%line => this
665 IF (this%i5 == 0)
THEN
666 iterator%iend =
SIZE(this%ser%icolumn) +
SIZE(this%ser%mapper)
668 iterator%iend =
SIZE(this%ser%icolumn)
672 END FUNCTION vol7d_serialize_itercol_new_line
675 FUNCTION vol7d_serialize_itercol_next(this)
RESULT(next)
681 DO WHILE(this%i < this%iend)
684 IF (this%i <=
SIZE(this%ser%icolumn))
THEN
685 icol = this%ser%icolumn(this%i)
693 IF (
ASSOCIATED(this%line)) this%line%i5 = this%line%i5 + 1
701 END FUNCTION vol7d_serialize_itercol_next
704 SUBROUTINE vol7d_serialize_itercol_call(this, genericptr)
706 TYPE(c_ptr),
VALUE :: genericptr
708 INTEGER :: icol, icolorder
710 IF (
ASSOCIATED(this%line))
THEN
712 IF (this%i <=
SIZE(this%ser%icolumn))
THEN
713 icol = this%ser%icolumn(this%i)
719 icolorder = this%ser%loopinvorder(icol)
721 IF (this%line%lastind(icolorder) == this%line%loopind(icolorder) &
722 .AND. this%ser%cachedesc)
RETURN
724 this%forcemiss = this%line%analine .AND. &
725 icol /= vol7d_ana_d .AND. icol /= vol7d_network_d
727 CALL call_desc_callback(this, genericptr)
728 IF (this%forcemiss)
THEN
730 this%line%lastind(icolorder) = 0
733 this%line%lastind(icolorder) = this%line%loopind(icolorder)
737 CALL call_value_callback(this, genericptr)
742 IF (this%i <= 7)
THEN
743 CALL call_header_desc_callback(this, genericptr)
745 CALL call_header_value_callback(this, genericptr)
749 END SUBROUTINE vol7d_serialize_itercol_call
752 SUBROUTINE call_header_desc_callback(this, genericptr)
754 TYPE(c_ptr),
VALUE :: genericptr
756 SELECT CASE(this%ser%icolumn(this%i))
759 CALL this%ser%vol7d_ana_callback(genericptr)
762 CALL this%ser%vol7d_time_callback(genericptr)
765 CALL this%ser%vol7d_level_callback(genericptr)
767 CASE(vol7d_timerange_d)
768 CALL this%ser%vol7d_timerange_callback(genericptr)
770 CASE(vol7d_network_d)
771 CALL this%ser%vol7d_network_callback(genericptr)
774 CALL this%ser%vol7d_var_callback(genericptr)
777 CALL this%ser%vol7d_val_callback(genericptr)
781 END SUBROUTINE call_header_desc_callback
784 SUBROUTINE call_header_value_callback(this, genericptr)
786 TYPE(c_ptr),
VALUE :: genericptr
788 INTEGER :: ind, varind, attrind
792 varind = this%ser%mapper(ind)%i5
793 attrind = this%ser%mapper(ind)%i7
795 SELECT CASE(this%ser%mapper(ind)%cat)
797 SELECT CASE(this%ser%mapper(ind)%typ)
799 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%r(varind),
'ra', genericptr)
801 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%d(varind),
'da', genericptr)
803 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%i(varind),
'ia', genericptr)
805 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%b(varind),
'ba', genericptr)
807 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%anavar%c(varind),
'ca', genericptr)
810 SELECT CASE(this%ser%mapper(ind)%typ)
812 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%r(varind), &
813 this%ser%v7d%anaattr%r(attrind),
'ra', genericptr)
815 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%d(varind), &
816 this%ser%v7d%anaattr%d(attrind),
'da', genericptr)
818 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%i(varind), &
819 this%ser%v7d%anaattr%i(attrind),
'ia', genericptr)
821 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%b(varind), &
822 this%ser%v7d%anaattr%b(attrind),
'ba', genericptr)
824 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%anavarattr%c(varind), &
825 this%ser%v7d%anaattr%c(attrind),
'ca', genericptr)
828 SELECT CASE(this%ser%mapper(ind)%typ)
830 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%r(varind),
'rd', genericptr)
832 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%d(varind),
'dd', genericptr)
834 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%i(varind),
'id', genericptr)
836 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%b(varind),
'bd', genericptr)
838 CALL this%ser%vol7d_value_var_callback(this%ser%v7d%dativar%c(varind),
'cd', genericptr)
841 SELECT CASE(this%ser%mapper(ind)%typ)
843 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%r(varind), &
844 this%ser%v7d%datiattr%r(attrind),
'rd', genericptr)
846 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%d(varind), &
847 this%ser%v7d%datiattr%d(attrind),
'dd', genericptr)
849 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%i(varind), &
850 this%ser%v7d%datiattr%i(attrind),
'id', genericptr)
852 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%b(varind), &
853 this%ser%v7d%datiattr%b(attrind),
'bd', genericptr)
855 CALL this%ser%vol7d_value_attr_callback(this%ser%v7d%dativarattr%c(varind), &
856 this%ser%v7d%datiattr%c(attrind),
'cd', genericptr)
860 END SUBROUTINE call_header_value_callback
863 SUBROUTINE default_vol7d_ana_header_callback(genericptr)
864 TYPE(c_ptr),
VALUE :: genericptr
866 CHARACTER(len=64),
POINTER :: col
868 CALL c_f_pointer(genericptr, col)
869 col =
'Longitude,Latitude'
871 END SUBROUTINE default_vol7d_ana_header_callback
873 SUBROUTINE default_vol7d_time_header_callback(genericptr)
874 TYPE(c_ptr),
VALUE :: genericptr
876 CHARACTER(len=64),
POINTER :: col
878 CALL c_f_pointer(genericptr, col)
881 END SUBROUTINE default_vol7d_time_header_callback
883 SUBROUTINE default_vol7d_level_header_callback(genericptr)
884 TYPE(c_ptr),
VALUE :: genericptr
886 CHARACTER(len=64),
POINTER :: col
888 CALL c_f_pointer(genericptr, col)
889 col =
'Level1,L1,Level2,L2'
891 END SUBROUTINE default_vol7d_level_header_callback
893 SUBROUTINE default_vol7d_timerange_header_callback(genericptr)
894 TYPE(c_ptr),
VALUE :: genericptr
896 CHARACTER(len=64),
POINTER :: col
898 CALL c_f_pointer(genericptr, col)
899 col =
'Time range,P1,P2'
901 END SUBROUTINE default_vol7d_timerange_header_callback
903 SUBROUTINE default_vol7d_network_header_callback(genericptr)
904 TYPE(c_ptr),
VALUE :: genericptr
906 CHARACTER(len=64),
POINTER :: col
908 CALL c_f_pointer(genericptr, col)
911 END SUBROUTINE default_vol7d_network_header_callback
913 SUBROUTINE default_vol7d_var_header_callback(genericptr)
914 TYPE(c_ptr),
VALUE :: genericptr
916 CHARACTER(len=64),
POINTER :: col
918 CALL c_f_pointer(genericptr, col)
921 END SUBROUTINE default_vol7d_var_header_callback
923 SUBROUTINE default_vol7d_val_header_callback(genericptr)
924 TYPE(c_ptr),
VALUE :: genericptr
926 CHARACTER(len=64),
POINTER :: col
928 CALL c_f_pointer(genericptr, col)
931 END SUBROUTINE default_vol7d_val_header_callback
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
938 CHARACTER(len=64),
POINTER :: col
940 CALL c_f_pointer(genericptr, col)
943 END SUBROUTINE default_vol7d_value_var_header_callback
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
951 CHARACTER(len=64),
POINTER :: col
953 CALL c_f_pointer(genericptr, col)
954 col = trim(var%btable)//
'.'//attr%btable
956 END SUBROUTINE default_vol7d_value_attr_header_callback
959 SUBROUTINE call_desc_callback(this, genericptr)
961 TYPE(c_ptr),
VALUE :: genericptr
963 INTEGER :: icol, ind, varind, attrind
965 icol = this%ser%icolumn(this%i)
966 ind = this%line%loopind(this%ser%loopinvorder(icol))
971 CALL this%line%vol7d_ana_callback(this%ser%v7d%ana(ind), genericptr)
974 IF (this%forcemiss)
THEN
975 CALL this%line%vol7d_time_callback(datetime_miss, genericptr)
977 CALL this%line%vol7d_time_callback(this%ser%v7d%time(ind), genericptr)
981 IF (this%forcemiss)
THEN
982 CALL this%line%vol7d_level_callback(vol7d_level_miss, genericptr)
984 CALL this%line%vol7d_level_callback(this%ser%v7d%level(ind), genericptr)
987 CASE(vol7d_timerange_d)
988 IF (this%forcemiss)
THEN
989 CALL this%line%vol7d_timerange_callback(vol7d_timerange_miss, genericptr)
991 CALL this%line%vol7d_timerange_callback(this%ser%v7d%timerange(ind), genericptr)
994 CASE(vol7d_network_d)
995 CALL this%line%vol7d_network_callback(this%ser%v7d%network(ind), genericptr)
998 varind = this%ser%mapper(ind)%i5
999 attrind = this%ser%mapper(ind)%i7
1000 SELECT CASE(this%ser%mapper(ind)%cat)
1002 SELECT CASE(this%ser%mapper(ind)%typ)
1004 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%r(varind), genericptr)
1006 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%d(varind), genericptr)
1008 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%i(varind), genericptr)
1010 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%b(varind), genericptr)
1012 CALL this%line%vol7d_var_callback(this%ser%v7d%anavar%c(varind), genericptr)
1015 SELECT CASE(this%ser%mapper(ind)%typ)
1017 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%r(varind), &
1018 this%ser%v7d%anaattr%r(attrind), genericptr)
1020 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%d(varind), &
1021 this%ser%v7d%anaattr%d(attrind), genericptr)
1023 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%i(varind), &
1024 this%ser%v7d%anaattr%i(attrind), genericptr)
1026 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%b(varind), &
1027 this%ser%v7d%anaattr%b(attrind), genericptr)
1029 CALL this%line%vol7d_attr_callback(this%ser%v7d%anavarattr%c(varind), &
1030 this%ser%v7d%anaattr%c(attrind), genericptr)
1033 SELECT CASE(this%ser%mapper(ind)%typ)
1035 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%r(varind), genericptr)
1037 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%d(varind), genericptr)
1039 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%i(varind), genericptr)
1041 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%b(varind), genericptr)
1043 CALL this%line%vol7d_var_callback(this%ser%v7d%dativar%c(varind), genericptr)
1046 SELECT CASE(this%ser%mapper(ind)%typ)
1048 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%r(varind), &
1049 this%ser%v7d%datiattr%r(attrind), genericptr)
1051 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%d(varind), &
1052 this%ser%v7d%datiattr%d(attrind), genericptr)
1054 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%i(varind), &
1055 this%ser%v7d%datiattr%i(attrind), genericptr)
1057 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%b(varind), &
1058 this%ser%v7d%datiattr%b(attrind), genericptr)
1060 CALL this%line%vol7d_attr_callback(this%ser%v7d%dativarattr%c(varind), &
1061 this%ser%v7d%datiattr%c(attrind), genericptr)
1067 END SUBROUTINE call_desc_callback
1070 SUBROUTINE default_vol7d_ana_callback(ana, genericptr)
1071 TYPE(vol7d_ana),
INTENT(in) :: ana
1072 TYPE(c_ptr),
VALUE :: genericptr
1074 CHARACTER(len=64),
POINTER :: col
1076 CALL c_f_pointer(genericptr, col)
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)")))
1081 END SUBROUTINE default_vol7d_ana_callback
1084 SUBROUTINE default_vol7d_time_callback(time, genericptr)
1085 TYPE(datetime),
INTENT(in) :: time
1086 TYPE(c_ptr),
VALUE :: genericptr
1088 CHARACTER(len=64),
POINTER :: col
1090 CALL c_f_pointer(genericptr, col)
1092 IF (time /= datetime_miss)
THEN
1093 CALL getval(time, isodate=col(1:19))
1096 END SUBROUTINE default_vol7d_time_callback
1099 SUBROUTINE default_vol7d_level_callback(level, genericptr)
1100 TYPE(vol7d_level),
INTENT(in) :: level
1101 TYPE(c_ptr),
VALUE :: genericptr
1103 CHARACTER(len=64),
POINTER :: col
1105 CALL c_f_pointer(genericptr, col)
1106 col = t2c(level%level1,
'')//
','// &
1107 t2c(level%l1,
'')//
','// &
1108 t2c(level%level2,
'')//
','// &
1111 END SUBROUTINE default_vol7d_level_callback
1114 SUBROUTINE default_vol7d_timerange_callback(timerange, genericptr)
1115 TYPE(vol7d_timerange),
INTENT(in) :: timerange
1116 TYPE(c_ptr),
VALUE :: genericptr
1118 CHARACTER(len=64),
POINTER :: col
1120 CALL c_f_pointer(genericptr, col)
1121 col = t2c(timerange%timerange,
'')//
','// &
1122 t2c(timerange%p1,
'')//
','//t2c(timerange%p2,
'')
1124 END SUBROUTINE default_vol7d_timerange_callback
1127 SUBROUTINE default_vol7d_network_callback(network, genericptr)
1128 TYPE(vol7d_network),
INTENT(in) :: network
1129 TYPE(c_ptr),
VALUE :: genericptr
1131 CHARACTER(len=64),
POINTER :: col
1133 CALL c_f_pointer(genericptr, col)
1134 IF (
c_e(network))
THEN
1140 END SUBROUTINE default_vol7d_network_callback
1143 SUBROUTINE default_vol7d_var_callback(var, genericptr)
1144 TYPE(vol7d_var),
INTENT(in) :: var
1145 TYPE(c_ptr),
VALUE :: genericptr
1147 CHARACTER(len=64),
POINTER :: col
1149 CALL c_f_pointer(genericptr, col)
1156 END SUBROUTINE default_vol7d_var_callback
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
1164 CHARACTER(len=64),
POINTER :: col
1166 CALL c_f_pointer(genericptr, col)
1167 IF (
c_e(var) .AND.
c_e(attr))
THEN
1168 col = trim(var%btable)//
'.'//attr%btable
1173 END SUBROUTINE default_vol7d_attr_callback
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
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)
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)
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)
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)
1229 IF (.NOT.dataonly)
THEN
1230 IF (
ASSOCIATED(v7d%anavar%r))
THEN
1231 CALL set_mapper(1, 1, 1,
SIZE(v7d%anavar%r))
1233 IF (
ASSOCIATED(v7d%anavar%d))
THEN
1234 CALL set_mapper(1, 2, 1,
SIZE(v7d%anavar%d))
1236 IF (
ASSOCIATED(v7d%anavar%i))
THEN
1237 CALL set_mapper(1, 3, 1,
SIZE(v7d%anavar%i))
1239 IF (
ASSOCIATED(v7d%anavar%b))
THEN
1240 CALL set_mapper(1, 4, 1,
SIZE(v7d%anavar%b))
1242 IF (
ASSOCIATED(v7d%anavar%c))
THEN
1243 CALL set_mapper(1, 5, 1,
SIZE(v7d%anavar%c))
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))
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))
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))
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))
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))
1263 IF (.NOT.anaonly)
THEN
1264 IF (
ASSOCIATED(v7d%dativar%r))
THEN
1265 CALL set_mapper(3, 1, 1,
SIZE(v7d%dativar%r))
1267 IF (
ASSOCIATED(v7d%dativar%d))
THEN
1268 CALL set_mapper(3, 2, 1,
SIZE(v7d%dativar%d))
1270 IF (
ASSOCIATED(v7d%dativar%i))
THEN
1271 CALL set_mapper(3, 3, 1,
SIZE(v7d%dativar%i))
1273 IF (
ASSOCIATED(v7d%dativar%b))
THEN
1274 CALL set_mapper(3, 4, 1,
SIZE(v7d%dativar%b))
1276 IF (
ASSOCIATED(v7d%dativar%c))
THEN
1277 CALL set_mapper(3, 5, 1,
SIZE(v7d%dativar%c))
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))
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))
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))
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))
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))
1299 SUBROUTINE set_mapper(cat, typ, s1, s2)
1300 INTEGER,
INTENT(in) :: cat
1301 INTEGER,
INTENT(in) :: typ
1302 INTEGER,
INTENT(in) :: 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)/)
1313 END SUBROUTINE set_mapper
1315 END SUBROUTINE var_mapper
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
1327 INTEGER :: ind, varind, attrind
1330 DO ind = 1,
SIZE(mapper)
1331 varind = mapper(ind)%i5
1332 attrind = mapper(ind)%i7
1334 SELECT CASE(mapper(ind)%cat)
1337 SELECT CASE(mapper(ind)%typ)
1339 miss = miss .AND. .NOT.
c_e(v7d%volanar(i1, varind, i6))
1341 miss = miss .AND. .NOT.
c_e(v7d%volanad(i1, varind, i6))
1343 miss = miss .AND. .NOT.
c_e(v7d%volanai(i1, varind, i6))
1345 miss = miss .AND. .NOT.
c_e(v7d%volanab(i1, varind, i6))
1347 miss = miss .AND. .NOT.
c_e(v7d%volanac(i1, varind, i6))
1352 SELECT CASE(mapper(ind)%typ)
1354 miss = miss .AND. .NOT.
c_e(v7d%volanaattrr(i1, varind, i6, attrind))
1356 miss = miss .AND. .NOT.
c_e(v7d%volanaattrd(i1, varind, i6, attrind))
1358 miss = miss .AND. .NOT.
c_e(v7d%volanaattri(i1, varind, i6, attrind))
1360 miss = miss .AND. .NOT.
c_e(v7d%volanaattrb(i1, varind, i6, attrind))
1362 miss = miss .AND. .NOT.
c_e(v7d%volanaattrc(i1, varind, i6, attrind))
1366 SELECT CASE(mapper(ind)%typ)
1368 miss = miss .AND. .NOT.
c_e(v7d%voldatir(i1, i2, i3, i4, varind, i6))
1370 miss = miss .AND. .NOT.
c_e(v7d%voldatid(i1, i2, i3, i4, varind, i6))
1372 miss = miss .AND. .NOT.
c_e(v7d%voldatii(i1, i2, i3, i4, varind, i6))
1374 miss = miss .AND. .NOT.
c_e(v7d%voldatib(i1, i2, i3, i4, varind, i6))
1376 miss = miss .AND. .NOT.
c_e(v7d%voldatic(i1, i2, i3, i4, varind, i6))
1379 SELECT CASE(mapper(ind)%typ)
1381 miss = miss .AND. .NOT.
c_e(v7d%voldatiattrr(i1, i2, i3, i4, varind, i6, attrind))
1383 miss = miss .AND. .NOT.
c_e(v7d%voldatiattrd(i1, i2, i3, i4, varind, i6, attrind))
1385 miss = miss .AND. .NOT.
c_e(v7d%voldatiattri(i1, i2, i3, i4, varind, i6, attrind))
1387 miss = miss .AND. .NOT.
c_e(v7d%voldatiattrb(i1, i2, i3, i4, varind, i6, attrind))
1389 miss = miss .AND. .NOT.
c_e(v7d%voldatiattrc(i1, i2, i3, i4, varind, i6, attrind))
1392 IF (.NOT.miss)
RETURN
1395 END FUNCTION var_mapper_miss
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
1408 DO ind = 1,
SIZE(mapper)
1409 varind = mapper(ind)%i5
1412 SELECT CASE(mapper(ind)%cat)
1414 SELECT CASE(mapper(ind)%typ)
1416 IF (v7d%anavar%r(varind) == var)
RETURN
1418 IF (v7d%anavar%d(varind) == var)
RETURN
1420 IF (v7d%anavar%i(varind) == var)
RETURN
1422 IF (v7d%anavar%b(varind) == var)
RETURN
1424 IF (v7d%anavar%c(varind) == var)
RETURN
1427 SELECT CASE(mapper(ind)%typ)
1429 IF (v7d%dativar%r(varind) == var)
RETURN
1431 IF (v7d%dativar%d(varind) == var)
RETURN
1433 IF (v7d%dativar%i(varind) == var)
RETURN
1435 IF (v7d%dativar%b(varind) == var)
RETURN
1437 IF (v7d%dativar%c(varind) == var)
RETURN
1444 END FUNCTION var_mapper_searchvar
1447 SUBROUTINE call_value_callback(this, genericptr)
1449 TYPE(c_ptr),
VALUE :: genericptr
1451 INTEGER :: ind, varind, attrind
1454 varind = this%ser%mapper(ind)%i5
1455 attrind = this%ser%mapper(ind)%i7
1457 SELECT CASE(this%ser%mapper(ind)%cat)
1459 SELECT CASE(this%ser%mapper(ind)%typ)
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)
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)
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)
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)
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)
1482 SELECT CASE(this%ser%mapper(ind)%typ)
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)
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)
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)
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)
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)
1505 SELECT CASE(this%ser%mapper(ind)%typ)
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)
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)
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)
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)
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)
1528 SELECT CASE(this%ser%mapper(ind)%typ)
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)
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)
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)
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)
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)
1552 END SUBROUTINE call_value_callback
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
1560 CHARACTER(len=64),
POINTER :: col
1562 CALL c_f_pointer(genericptr, col)
1569 END SUBROUTINE default_vol7d_valuer_var_callback
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
1577 CHARACTER(len=64),
POINTER :: col
1579 CALL c_f_pointer(genericptr, col)
1586 END SUBROUTINE default_vol7d_valued_var_callback
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
1594 CHARACTER(len=64),
POINTER :: col
1596 CALL c_f_pointer(genericptr, col)
1598 IF (
c_e(var%scalefactor) .AND. &
1599 .NOT.(var%scalefactor == 0 .AND. var%unit ==
'NUMERIC'))
THEN
1608 END SUBROUTINE default_vol7d_valuei_var_callback
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
1616 CHARACTER(len=64),
POINTER :: col
1619 CALL default_vol7d_valuei_var_callback(int(valu), var, genericptr)
1621 CALL c_f_pointer(genericptr, col)
1625 END SUBROUTINE default_vol7d_valueb_var_callback
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
1633 CHARACTER(len=64),
POINTER :: col
1635 CALL c_f_pointer(genericptr, col)
1637 IF (
c_e(var%scalefactor) .AND. var%unit /=
'CCITTIA5' .AND. &
1638 .NOT.(var%scalefactor == 0 .AND. var%unit ==
'NUMERIC'))
THEN
1647 END SUBROUTINE default_vol7d_valuec_var_callback
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
1656 CALL default_vol7d_valuer_var_callback(valu, attr, genericptr)
1658 END SUBROUTINE default_vol7d_valuer_attr_callback
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
1667 CALL default_vol7d_valued_var_callback(valu, attr, genericptr)
1669 END SUBROUTINE default_vol7d_valued_attr_callback
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
1678 CHARACTER(len=64),
POINTER :: col
1680 CALL c_f_pointer(genericptr, col)
1682 IF (
c_e(attr%scalefactor) .AND. &
1683 .NOT.(attr%scalefactor == 0 .AND. attr%unit ==
'NUMERIC'))
THEN
1684 col = t2c(
realdat(valu, attr))
1692 END SUBROUTINE default_vol7d_valuei_attr_callback
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
1701 CHARACTER(len=64),
POINTER :: col
1704 CALL default_vol7d_valuei_var_callback(int(valu), attr, genericptr)
1706 CALL c_f_pointer(genericptr, col)
1710 END SUBROUTINE default_vol7d_valueb_attr_callback
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
1719 CHARACTER(len=64),
POINTER :: col
1721 CALL c_f_pointer(genericptr, col)
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))
1733 END SUBROUTINE default_vol7d_valuec_attr_callback
Emit log message for a category with specific priority.
Add a new option of a specific type.
Test for a missing volume.
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.
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.