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
148FUNCTION vol7d_serialize_new()
RESULT(this)
149TYPE(vol7d_serialize) :: this
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
163END FUNCTION vol7d_serialize_new
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
180IF (
PRESENT(ext)) this%ext = ext
182IF (
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 &
211END SUBROUTINE vol7d_serialize_optionparser
220SUBROUTINE vol7d_serialize_parse(this, category)
222INTEGER,
INTENT(in),
OPTIONAL :: category
224CALL parse_v7d_column(this%column, this%icolumn,
'--'//trim(this%ext)//
'-column', &
226CALL parse_v7d_column(this%loop, this%looporder,
'--'//trim(this%ext)//
'-loop', &
229END SUBROUTINE vol7d_serialize_parse
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
244INTEGER,
POINTER :: w_s(:), w_e(:)
246nc = word_split(ccol, w_s, w_e,
',')
249DO 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)//
' .')
304END SUBROUTINE parse_v7d_column
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)
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
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
333END SUBROUTINE vol7d_serialize_set_callback
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)
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
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
382END SUBROUTINE vol7d_serialize_iterline_set_callback
385SUBROUTINE vol7d_serialize_setup(this, v7d)
387TYPE(
vol7d),
INTENT(in),
TARGET :: v7d
389INTEGER :: nv, nav, ndv, i, j, n
390INTEGER,
POINTER :: w_s(:), w_e(:)
391TYPE(vol7d_var_mapper),
ALLOCATABLE :: mapper_tmp(:)
410CALL var_mapper(this%mapper, v7d, this%anaonly, this%dataonly)
413IF (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)
432IF (
SIZE(v7d%time) == 0)
THEN
433 WHERE (this%icolumn(:) == vol7d_time_d)
437IF (
SIZE(v7d%level) == 0)
THEN
438 WHERE (this%icolumn(:) == vol7d_level_d)
442IF (
SIZE(v7d%timerange) == 0)
THEN
443 WHERE (this%icolumn(:) == vol7d_timerange_d)
447this%anavol =
SIZE(v7d%time) == 0 .AND.
SIZE(v7d%level) == 0 .AND. &
448 SIZE(v7d%timerange) == 0
450nav = count(this%mapper(:)%cat == 1)
451ndv = count(this%mapper(:)%cat == 3)
456WHERE (this%looporder(:) == vol7d_ana_d)
457 this%loopend(:) =
SIZE(v7d%ana)
459WHERE (this%looporder(:) == vol7d_time_d)
460 this%loopend(:) =
SIZE(v7d%time)
462WHERE (this%looporder(:) == vol7d_level_d)
463 this%loopend(:) =
SIZE(v7d%level)
465WHERE (this%looporder(:) == vol7d_timerange_d)
466 this%loopend(:) =
SIZE(v7d%timerange)
468WHERE (this%looporder(:) == vol7d_var_d)
469 this%loopend(:) =
SIZE(this%mapper)
471WHERE (this%looporder(:) == vol7d_network_d)
472 this%loopend(:) =
SIZE(v7d%network)
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)
485IF (this%loopinvorder(vol7d_var_d) <= 0)
THEN
493SUBROUTINE checkvarvect(varvect)
494TYPE(vol7d_varvect),
INTENT(inout) :: varvect
496CALL checkvar(varvect%r)
497CALL checkvar(varvect%d)
498CALL checkvar(varvect%i)
499CALL checkvar(varvect%b)
500CALL checkvar(varvect%c)
502END SUBROUTINE checkvarvect
504SUBROUTINE checkvar(var)
505TYPE(vol7d_var),
POINTER :: var(:)
509IF (.NOT.
ASSOCIATED(var))
RETURN
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
517 var(i) = vol7d_var_miss
520END SUBROUTINE checkvar
522END SUBROUTINE vol7d_serialize_setup
525FUNCTION vol7d_serialize_iterline_new(this)
RESULT(iterator)
530iterator%loopind(:) = this%loopstart(:)
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
551END FUNCTION vol7d_serialize_iterline_new
554FUNCTION vol7d_serialize_iterline_next(this)
RESULT(next)
561IF (.NOT.
ASSOCIATED(this%ser))
THEN
567loop7d:
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
641END FUNCTION vol7d_serialize_iterline_next
644FUNCTION vol7d_serialize_itercol_new_ser(this)
RESULT(iterator)
649IF (this%ndvar == 5)
THEN
650 iterator%iend =
SIZE(this%icolumn) +
SIZE(this%mapper)
652 iterator%iend =
SIZE(this%icolumn)
655END FUNCTION vol7d_serialize_itercol_new_ser
658FUNCTION vol7d_serialize_itercol_new_line(this)
RESULT(iterator)
662iterator%ser => this%ser
665IF (this%i5 == 0)
THEN
666 iterator%iend =
SIZE(this%ser%icolumn) +
SIZE(this%ser%mapper)
668 iterator%iend =
SIZE(this%ser%icolumn)
672END FUNCTION vol7d_serialize_itercol_new_line
675FUNCTION vol7d_serialize_itercol_next(this)
RESULT(next)
681DO 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
701END FUNCTION vol7d_serialize_itercol_next
704SUBROUTINE vol7d_serialize_itercol_call(this, genericptr)
706TYPE(c_ptr),
VALUE :: genericptr
708INTEGER :: icol, icolorder
710IF (
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)
749END SUBROUTINE vol7d_serialize_itercol_call
752SUBROUTINE call_header_desc_callback(this, genericptr)
754TYPE(c_ptr),
VALUE :: genericptr
756SELECT 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)
767CASE(vol7d_timerange_d)
768 CALL this%ser%vol7d_timerange_callback(genericptr)
771 CALL this%ser%vol7d_network_callback(genericptr)
774 CALL this%ser%vol7d_var_callback(genericptr)
777 CALL this%ser%vol7d_val_callback(genericptr)
781END SUBROUTINE call_header_desc_callback
784SUBROUTINE call_header_value_callback(this, genericptr)
786TYPE(c_ptr),
VALUE :: genericptr
788INTEGER :: ind, varind, attrind
792varind = this%ser%mapper(ind)%i5
793attrind = this%ser%mapper(ind)%i7
795SELECT 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)
860END SUBROUTINE call_header_value_callback
863SUBROUTINE default_vol7d_ana_header_callback(genericptr)
864TYPE(c_ptr),
VALUE :: genericptr
866CHARACTER(len=64),
POINTER :: col
868CALL c_f_pointer(genericptr, col)
869col =
'Longitude,Latitude'
871END SUBROUTINE default_vol7d_ana_header_callback
873SUBROUTINE default_vol7d_time_header_callback(genericptr)
874TYPE(c_ptr),
VALUE :: genericptr
876CHARACTER(len=64),
POINTER :: col
878CALL c_f_pointer(genericptr, col)
881END SUBROUTINE default_vol7d_time_header_callback
883SUBROUTINE default_vol7d_level_header_callback(genericptr)
884TYPE(c_ptr),
VALUE :: genericptr
886CHARACTER(len=64),
POINTER :: col
888CALL c_f_pointer(genericptr, col)
889col =
'Level1,L1,Level2,L2'
891END SUBROUTINE default_vol7d_level_header_callback
893SUBROUTINE default_vol7d_timerange_header_callback(genericptr)
894TYPE(c_ptr),
VALUE :: genericptr
896CHARACTER(len=64),
POINTER :: col
898CALL c_f_pointer(genericptr, col)
899col =
'Time range,P1,P2'
901END SUBROUTINE default_vol7d_timerange_header_callback
903SUBROUTINE default_vol7d_network_header_callback(genericptr)
904TYPE(c_ptr),
VALUE :: genericptr
906CHARACTER(len=64),
POINTER :: col
908CALL c_f_pointer(genericptr, col)
911END SUBROUTINE default_vol7d_network_header_callback
913SUBROUTINE default_vol7d_var_header_callback(genericptr)
914TYPE(c_ptr),
VALUE :: genericptr
916CHARACTER(len=64),
POINTER :: col
918CALL c_f_pointer(genericptr, col)
921END SUBROUTINE default_vol7d_var_header_callback
923SUBROUTINE default_vol7d_val_header_callback(genericptr)
924TYPE(c_ptr),
VALUE :: genericptr
926CHARACTER(len=64),
POINTER :: col
928CALL c_f_pointer(genericptr, col)
931END SUBROUTINE default_vol7d_val_header_callback
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
938CHARACTER(len=64),
POINTER :: col
940CALL c_f_pointer(genericptr, col)
943END SUBROUTINE default_vol7d_value_var_header_callback
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
951CHARACTER(len=64),
POINTER :: col
953CALL c_f_pointer(genericptr, col)
954col = trim(var%btable)//
'.'//attr%btable
956END SUBROUTINE default_vol7d_value_attr_header_callback
959SUBROUTINE call_desc_callback(this, genericptr)
961TYPE(c_ptr),
VALUE :: genericptr
963INTEGER :: icol, ind, varind, attrind
965icol = this%ser%icolumn(this%i)
966ind = 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)
987CASE(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)
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)
1067END SUBROUTINE call_desc_callback
1070SUBROUTINE default_vol7d_ana_callback(ana, genericptr)
1071TYPE(vol7d_ana),
INTENT(in) :: ana
1072TYPE(c_ptr),
VALUE :: genericptr
1074CHARACTER(len=64),
POINTER :: col
1076CALL c_f_pointer(genericptr, col)
1078col = trim(adjustl(
to_char(getlon(ana%coord),miss=
"",form=
"(f10.5)")))//&
1079 ','//trim(adjustl(
to_char(getlat(ana%coord),miss=
"",form=
"(f10.5)")))
1081END SUBROUTINE default_vol7d_ana_callback
1084SUBROUTINE default_vol7d_time_callback(time, genericptr)
1085TYPE(datetime),
INTENT(in) :: time
1086TYPE(c_ptr),
VALUE :: genericptr
1088CHARACTER(len=64),
POINTER :: col
1090CALL c_f_pointer(genericptr, col)
1092IF (time /= datetime_miss)
THEN
1093 CALL getval(time, isodate=col(1:19))
1096END SUBROUTINE default_vol7d_time_callback
1099SUBROUTINE default_vol7d_level_callback(level, genericptr)
1100TYPE(vol7d_level),
INTENT(in) :: level
1101TYPE(c_ptr),
VALUE :: genericptr
1103CHARACTER(len=64),
POINTER :: col
1105CALL c_f_pointer(genericptr, col)
1106col = t2c(level%level1,
'')//
','// &
1107 t2c(level%l1,
'')//
','// &
1108 t2c(level%level2,
'')//
','// &
1111END SUBROUTINE default_vol7d_level_callback
1114SUBROUTINE default_vol7d_timerange_callback(timerange, genericptr)
1115TYPE(vol7d_timerange),
INTENT(in) :: timerange
1116TYPE(c_ptr),
VALUE :: genericptr
1118CHARACTER(len=64),
POINTER :: col
1120CALL c_f_pointer(genericptr, col)
1121col = t2c(timerange%timerange,
'')//
','// &
1122 t2c(timerange%p1,
'')//
','//t2c(timerange%p2,
'')
1124END SUBROUTINE default_vol7d_timerange_callback
1127SUBROUTINE default_vol7d_network_callback(network, genericptr)
1128TYPE(vol7d_network),
INTENT(in) :: network
1129TYPE(c_ptr),
VALUE :: genericptr
1131CHARACTER(len=64),
POINTER :: col
1133CALL c_f_pointer(genericptr, col)
1134IF (c_e(network))
THEN
1140END SUBROUTINE default_vol7d_network_callback
1143SUBROUTINE default_vol7d_var_callback(var, genericptr)
1144TYPE(vol7d_var),
INTENT(in) :: var
1145TYPE(c_ptr),
VALUE :: genericptr
1147CHARACTER(len=64),
POINTER :: col
1149CALL c_f_pointer(genericptr, col)
1156END SUBROUTINE default_vol7d_var_callback
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
1164CHARACTER(len=64),
POINTER :: col
1166CALL c_f_pointer(genericptr, col)
1167IF (c_e(var) .AND. c_e(attr))
THEN
1168 col = trim(var%btable)//
'.'//attr%btable
1173END SUBROUTINE default_vol7d_attr_callback
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
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)
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)
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)
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)
1229IF (.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))
1263IF (.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))
1299SUBROUTINE set_mapper(cat, typ, s1, s2)
1300INTEGER,
INTENT(in) :: cat
1301INTEGER,
INTENT(in) :: typ
1302INTEGER,
INTENT(in) :: 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)/)
1313END SUBROUTINE set_mapper
1315END SUBROUTINE var_mapper
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
1327INTEGER :: ind, varind, attrind
1330DO 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
1395END FUNCTION var_mapper_miss
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
1408DO 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
1444END FUNCTION var_mapper_searchvar
1447SUBROUTINE call_value_callback(this, genericptr)
1449TYPE(c_ptr),
VALUE :: genericptr
1451INTEGER :: ind, varind, attrind
1454varind = this%ser%mapper(ind)%i5
1455attrind = this%ser%mapper(ind)%i7
1457SELECT 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)
1552END SUBROUTINE call_value_callback
1555SUBROUTINE default_vol7d_valuer_var_callback(valu, var, genericptr)
1556REAL,
INTENT(in) :: valu
1557TYPE(vol7d_var),
INTENT(in) :: var
1558TYPE(c_ptr),
VALUE :: genericptr
1560CHARACTER(len=64),
POINTER :: col
1562CALL c_f_pointer(genericptr, col)
1569END SUBROUTINE default_vol7d_valuer_var_callback
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
1577CHARACTER(len=64),
POINTER :: col
1579CALL c_f_pointer(genericptr, col)
1586END SUBROUTINE default_vol7d_valued_var_callback
1589SUBROUTINE default_vol7d_valuei_var_callback(valu, var, genericptr)
1590INTEGER,
INTENT(in) :: valu
1591TYPE(vol7d_var),
INTENT(in) :: var
1592TYPE(c_ptr),
VALUE :: genericptr
1594CHARACTER(len=64),
POINTER :: col
1596CALL c_f_pointer(genericptr, col)
1598 IF (c_e(var%scalefactor) .AND. &
1599 .NOT.(var%scalefactor == 0 .AND. var%unit ==
'NUMERIC'))
THEN
1608END SUBROUTINE default_vol7d_valuei_var_callback
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
1616CHARACTER(len=64),
POINTER :: col
1619 CALL default_vol7d_valuei_var_callback(int(valu), var, genericptr)
1621 CALL c_f_pointer(genericptr, col)
1625END SUBROUTINE default_vol7d_valueb_var_callback
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
1633CHARACTER(len=64),
POINTER :: col
1635CALL 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
1647END SUBROUTINE default_vol7d_valuec_var_callback
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
1656CALL default_vol7d_valuer_var_callback(valu, attr, genericptr)
1658END SUBROUTINE default_vol7d_valuer_attr_callback
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
1667CALL default_vol7d_valued_var_callback(valu, attr, genericptr)
1669END SUBROUTINE default_vol7d_valued_attr_callback
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
1678CHARACTER(len=64),
POINTER :: col
1680CALL 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))
1692END SUBROUTINE default_vol7d_valuei_attr_callback
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
1701CHARACTER(len=64),
POINTER :: col
1704 CALL default_vol7d_valuei_var_callback(int(valu), attr, genericptr)
1706 CALL c_f_pointer(genericptr, col)
1710END SUBROUTINE default_vol7d_valueb_attr_callback
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
1719CHARACTER(len=64),
POINTER :: col
1721CALL 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))
1733END SUBROUTINE default_vol7d_valuec_attr_callback