libsim  Versione 7.1.9
dballe_class.F03
1 ! Copyright (C) 2013 ARPA-SIM <urpsim@smr.arpa.emr.it>
2 ! authors:
3 ! Paolo Patruno <ppatruno@arpa.emr.it>
4 ! Davide Cesari <dcesari@arpa.emr.it>
5 
6 ! This program is free software; you can redistribute it and/or
7 ! modify it under the terms of the GNU General Public License as
8 ! published by the Free Software Foundation; either version 2 of
9 ! the License, or (at your option) any later version.
10 
11 ! This program is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15 
16 ! You should have received a copy of the GNU General Public License
17 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
18 
19 #include "config.h"
20 
43 MODULE dballe_class
44 
46 use log4fortran
47 use err_handling
55 use list_abstract
56 use vol7d_class, only: vol7d_cdatalen
57 use dballef
58 IMPLICIT NONE
59 
60 private
61 
62 character (len=255),parameter:: subcategory="dballe_class"
63 
65 type,public :: dbaconnection
66  integer :: dbhandle=imiss
67  integer :: handle_err=imiss
68  integer :: category=0
69  contains
70 # ifdef F2003_FULL_FEATURES
71  final :: dbaconnection_delete
72 # else
73  procedure :: delete => dbaconnection_delete
74 # endif
75 end type dbaconnection
76 
78 interface dbaconnection
79  procedure dbaconnection_init
80 end interface
81 
83 type,public :: dbasession
84  integer :: sehandle=imiss
85  logical :: file=.false.
86  character(len=40) :: template='generic'
87  character(len=255) :: filename=cmiss
88  character(len=40) :: mode=cmiss
89  character(len=40) :: format=cmiss
90  logical :: simplified=.true.
91  logical :: memdb=.false.
92  logical :: loadfile=.false.
93  type(dbaconnection) :: memconnection
94  integer :: category=0
95  integer :: count=imiss
96  contains
97 # ifdef F2003_FULL_FEATURES
98  final :: dbasession_delete
99 # else
100  procedure :: delete => dbasession_delete
101 # endif
102  procedure :: unsetall => dbasession_unsetall
103  procedure :: remove_all => dbasession_remove_all
104  procedure :: set => dbasession_set
105  procedure :: setcontextana => dbasession_setcontextana
106  procedure :: dimenticami => dbasession_dimenticami
119  procedure :: prendilo => dbasession_prendilo
120  procedure :: var_related => dbasession_var_related
121  procedure :: critica => dbasession_critica
122  procedure :: scusa => dbasession_scusa
123  procedure :: messages_open_input => dbasession_messages_open_input
124  procedure :: messages_open_output => dbasession_messages_open_output
125  procedure :: messages_read_next => dbasession_messages_read_next
126  procedure :: messages_write_next => dbasession_messages_write_next
127  procedure :: close_message => dbasession_close_message
128  procedure :: unsetb => dbasession_unsetb
129  procedure :: filerewind => dbasession_filerewind
130  procedure :: ingest_ana => dbasession_ingest_ana
131  procedure :: ingest_anav => dbasession_ingest_anav
132  procedure :: ingest_anal => dbasession_ingest_anal
133  procedure :: ingest_metaanddata => dbasession_ingest_metaanddata
134  procedure :: ingest_metaanddatal => dbasession_ingest_metaanddatal
135  procedure :: ingest_metaanddatav => dbasession_ingest_metaanddatav
136  procedure :: ingest_metaanddatai => dbasession_ingest_metaanddatai
137  procedure :: ingest_metaanddataiv => dbasession_ingest_metaanddataiv
138  procedure :: ingest_metaanddatail => dbasession_ingest_metaanddatail
139  procedure :: ingest_metaanddatab => dbasession_ingest_metaanddatab
140  procedure :: ingest_metaanddatabv => dbasession_ingest_metaanddatabv
141  procedure :: ingest_metaanddatabl => dbasession_ingest_metaanddatabl
142  procedure :: ingest_metaanddatad => dbasession_ingest_metaanddatad
143  procedure :: ingest_metaanddatadv => dbasession_ingest_metaanddatadv
144  procedure :: ingest_metaanddatadl => dbasession_ingest_metaanddatadl
145  procedure :: ingest_metaanddatar => dbasession_ingest_metaanddatar
146  procedure :: ingest_metaanddatarv => dbasession_ingest_metaanddatarv
147  procedure :: ingest_metaanddatarl => dbasession_ingest_metaanddatarl
148  procedure :: ingest_metaanddatac => dbasession_ingest_metaanddatac
149  procedure :: ingest_metaanddatacv => dbasession_ingest_metaanddatacv
150  procedure :: ingest_metaanddatacl => dbasession_ingest_metaanddatacl
151  procedure :: dissolve_metadata => dbasession_dissolve_metadata
152  procedure :: dissolveattr => dbasession_dissolveattr_metadata
153  generic :: dissolve => dissolve_metadata ,dimenticami
154  generic :: ingesta => ingest_ana, ingest_anav,ingest_anal
155  generic :: ingest => ingest_metaanddata,ingest_metaanddatav,ingest_metaanddatal,&
156  !ingest_metaanddatai,ingest_metaanddatab,ingest_metaanddatad,ingest_metaanddatar,ingest_metaanddatac,& !ambiguos
157  ingest_metaanddataiv,ingest_metaanddatabv,ingest_metaanddatadv,ingest_metaanddatarv,ingest_metaanddatacv,&
158  ingest_metaanddatail,ingest_metaanddatarl,ingest_metaanddatadl,ingest_metaanddatabl,ingest_metaanddatacl
162 end type dbasession
163 
165 interface dbasession
166  procedure dbasession_init
167 end interface
168 
170 type,public,extends(vol7d_level) :: dbalevel
171  contains
172 
173 # ifdef F2003_FULL_FEATURES
174 ! final :: dbalevel_delete
175 # else
176 ! procedure :: delete => dbalevel_delete !< todo
177 # endif
178  procedure :: display => dbalevel_display
179  procedure :: dbaset => dbalevel_set
180  procedure :: dbaenq => dbalevel_enq
181  procedure,nopass :: dbacontextana => dbalevel_contextana
183 end type dbalevel
184 
186 interface dbalevel
187  procedure dbalevel_init
188 end interface
189 
191 type,public,extends(vol7d_timerange) :: dbatimerange
192  contains
193 # ifdef F2003_FULL_FEATURES
194 ! final :: dbatimerange_delete
195 # else
196 ! procedure :: delete => dbatimerange_delete
197 # endif
198  procedure :: display => dbatimerange_display
199  procedure :: dbaset => dbatimerange_set
200  procedure :: dbaenq => dbatimerange_enq
201  procedure,nopass :: dbacontextana => dbatimerange_contextana
203 end type dbatimerange
204 
206 interface dbatimerange
207  procedure dbatimerange_init
208 end interface
209 
211 type,public,extends(geo_coord) :: dbacoord
212 
213 !!$ REAL(kind=fp_geo) :: lon !< longitudine
214 !!$ REAL(kind=fp_geo) :: lat !< latitudine
215 !!$ INTEGER(kind=int_l) :: ilon !< integer longitude (nint(lon*1.d5)
216 !!$ INTEGER(kind=int_l) :: ilat !< integer latitude (nint(lat*1.d5)
217 
218  contains
219 # ifdef F2003_FULL_FEATURES
220 ! final :: dbacoord_delete
221 # else
222 ! procedure :: delete => dbacoord_delete
223 # endif
224  procedure :: display => dbacoord_display
225 
226 end type dbacoord
227 
229 interface dbacoord
230  procedure dbacoord_init
231 end interface
232 
234 type,public,extends(vol7d_ana) :: dbaana
235 
236  contains
237 # ifdef F2003_FULL_FEATURES
238 ! final :: dbaana_delete
239 # else
240 ! procedure :: delete => dbaana_delete
241 # endif
242  procedure :: display => dbaana_display
243  procedure :: dbaset => dbaana_set
244  procedure :: dbaenq => dbaana_enq
245  procedure :: extrude => dbaana_extrude
246 end type dbaana
247 
249 interface dbaana
250  procedure dbaana_init
251 end interface
252 
254 type, public, extends(list) :: dbaanalist
255  contains
256  procedure :: current => currentdbaana
257  procedure :: display => displaydbaana
258 end type dbaanalist
259 
261 type,public,extends(vol7d_network) :: dbanetwork
262 
263  !Every type of report has an associated priority that controls which
264  !data are first returned when there is more than one in the same
265  !physical space. It can be changed by editing
266  !/etc/dballe/repinfo.csv
267  integer :: priority
268 
269  contains
270 # ifdef F2003_FULL_FEATURES
271 ! final :: dbanetwork_delete
272 # else
273 ! procedure :: delete => dbanetwork_delete
274 # endif
275  procedure :: display => dbanetwork_display
276  procedure :: dbaset => dbanetwork_set
277  procedure :: dbaenq => dbanetwork_enq
278 
279 end type dbanetwork
280 
282 interface dbanetwork
283  procedure dbanetwork_init
284 end interface
285 
286 
288 type,public,extends(datetime) :: dbadatetime
289 
290  contains
291 # ifdef F2003_FULL_FEATURES
292 ! final :: dbanetwork_delete
293 # else
294 ! procedure :: delete => dbanetwork_delete
295 # endif
296  procedure :: display => dbadatetime_display
297  procedure :: dbaset => dbadatetime_set
298  procedure :: dbaenq => dbadatetime_enq
299  procedure,nopass :: dbacontextana => dbadatetime_contextana
300 end type dbadatetime
301 
303 interface dbadatetime
304  procedure dbadatetime_init
305 end interface
306 
307 
309 type,public,abstract :: dbadata
310  character(len=9) :: btable
311 contains
312  procedure(dbadata_set),deferred :: dbaset
313  procedure :: dbadata_geti
314  procedure :: dbadata_getr
315  procedure :: dbadata_getd
316  procedure :: dbadata_getb
317  procedure :: dbadata_getc
318  generic :: get => dbadata_geti,dbadata_getr,dbadata_getd,dbadata_getb,dbadata_getc
319  procedure :: dbadata_c_e_i
320  procedure :: dbadata_c_e_r
321  procedure :: dbadata_c_e_d
322  procedure :: dbadata_c_e_b
323  procedure :: dbadata_c_e_c
324  procedure :: c_e => dbadata_c_e
325  procedure(dbadata_display),deferred :: display
326  procedure :: equal => dbadata_equal
327  generic :: operator (==) => equal
328 end type dbadata
329 
331 abstract interface
332 subroutine dbadata_set(data,session)
333 import
334 class(dbadata), intent(in) :: data
335 type(dbasession), intent(in) :: session
336 end subroutine dbadata_set
337 
339 subroutine dbadata_display(data)
340 import
341 class(dbadata), intent(in) :: data
342 end subroutine dbadata_display
343 
344 end interface
345 
347 type,public, extends(dbadata) :: dbadatai
348  integer :: value
349 contains
350  procedure :: dbadata_geti => dbadatai_geti
351  procedure :: dbaset => dbadatai_set
352  procedure :: display => dbadatai_display
353 end type dbadatai
354 
356 interface dbadatai
357  procedure :: dbadatai_init
358 end interface dbadatai
359 
361 type,public, extends(dbadata) :: dbadatar
362  real :: value
363 contains
364  procedure :: dbadata_getr => dbadatar_getr
365  procedure :: dbaset => dbadatar_set
366  procedure :: display => dbadatar_display
367 end type dbadatar
368 
370 interface dbadatar
371  procedure :: dbadatar_init
372 end interface dbadatar
373 
374 
376 type,public, extends(dbadata) :: dbadatad
377  doubleprecision :: value
378 contains
379  procedure :: dbadata_getd => dbadatad_getd
380  procedure :: dbaset => dbadatad_set
381  procedure :: display => dbadatad_display
382 end type dbadatad
383 
385 interface dbadatad
386  procedure :: dbadatad_init
387 end interface dbadatad
388 
389 
391 type,public, extends(dbadata) :: dbadatab
392  integer(kind=int_b) :: value
393 contains
394  procedure :: dbadata_getb => dbadatab_getb
395  procedure :: dbaset => dbadatab_set
396  procedure :: display => dbadatab_display
397 end type dbadatab
398 
400 interface dbadatab
401  procedure :: dbadatab_init
402 end interface dbadatab
403 
404 
406 type,public, extends(dbadata) :: dbadatac
407 ! character(:) :: value
408 ! character(255) :: value
409 character(vol7d_cdatalen) :: value
410 
411 contains
412  procedure :: dbadata_getc => dbadatac_getc
413  procedure :: dbaset => dbadatac_set
414  procedure :: display => dbadatac_display
415 end type dbadatac
416 
418 interface dbadatac
419  procedure :: dbadatac_init
420 end interface dbadatac
421 
423 type,public :: dbametadata
424  type(dbalevel) :: level
425  type(dbatimerange) :: timerange
426  type(dbaana) :: ana
427  type(dbanetwork) :: network
428  type(dbadatetime) :: datetime
429  contains
430 # ifdef F2003_FULL_FEATURES
431 ! final :: dbametadata_delete
432 # else
433 ! procedure :: delete => dbametadata_delete
434 # endif
435  procedure :: dbaset => dbametadata_set
436  procedure :: dbaenq => dbametadata_enq
437  procedure :: dbacontextana => dbametadata_contextana
438  procedure :: display => dbametadata_display
439  procedure :: equal => dbametadata_equal
440  generic :: operator (==) => equal
441 end type dbametadata
442 
444 interface dbametadata
445  procedure dbametadata_init
446 end interface
447 
449 type, public :: dbadc
450  class(dbadata),allocatable :: dat
451  contains
452  procedure :: display => dbadc_display
453  procedure :: dbaset => dbadc_set
454  procedure :: extrude => dbadc_extrude
455 end type dbadc
456 
457 
459 type, public :: dbadcv
460  type(dbadc),allocatable :: dcv(:)
461  contains
462  procedure :: display => dbadcv_display
463  procedure :: dbaset => dbadcv_set
464  procedure :: extrude => dbadcv_extrude
465  procedure :: equal => dbadcv_equal_dbadata
466  generic :: operator (==) => equal
467 end type dbadcv
468 
470 type, public ,extends(dbadc):: dbadataattr
471  type(dbadcv) :: attrv
472  contains
473  procedure :: display => dbadataattr_display
474  procedure :: extrude => dbadataattr_extrude
475 end type dbadataattr
476 
478 type, public :: dbadataattrv
479  class(dbadataattr),allocatable :: dataattr(:)
480  contains
481  procedure :: display => dbadataattrv_display
482  procedure :: extrude => dbadataattrv_extrude
483 end type dbadataattrv
484 
486 type, public :: dbametaanddata
487  type(dbametadata) :: metadata
488  type(dbadataattrv) ::dataattrv
489  contains
490  procedure :: display => dbametaanddata_display
491  procedure :: extrude => dbametaanddata_extrude
493 
495 type, public :: dbametaanddatav
496  type(dbametadata) :: metadata
497  type(dbadcv) ::datav
498  contains
499  procedure :: display => dbametaanddatav_display
500  procedure :: extrude => dbametaanddatav_extrude
501 end type dbametaanddatav
502 
504 type, public, extends(list) :: dbametaanddatalist
505  contains
506  procedure :: current => currentdbametaanddata
507  procedure :: display => displaydbametaanddata
508  procedure :: extrude => dbametaanddatal_extrude
510 
512 type, public,extends(dbadatai) :: dbametaanddatai
513  type(dbametadata) :: metadata
514  contains
515  procedure :: display => dbametaanddatai_display
516  procedure :: extrude => dbametaanddatai_extrude
518 
520 type, public, extends(list) :: dbametaanddatailist
521  contains
522  procedure :: current => currentdbametaanddatai
523  procedure :: display => displaydbametaanddatai
524  procedure :: toarray => toarray_dbametaanddatai
525 end type dbametaanddatailist
526 
528 type, public,extends(dbadatab) :: dbametaanddatab
529  type(dbametadata) :: metadata
530  contains
531  procedure :: display => dbametaanddatab_display
532  procedure :: extrude => dbametaanddatab_extrude
534 
536 type, public, extends(list) :: dbametaanddatablist
537  contains
538  procedure :: current => currentdbametaanddatab
539  procedure :: display => displaydbametaanddatab
540  procedure :: toarray => toarray_dbametaanddatab
542 
544 type, public,extends(dbadatad) :: dbametaanddatad
545  type(dbametadata) :: metadata
546  contains
547  procedure :: display => dbametaanddatad_display
548  procedure :: extrude => dbametaanddatad_extrude
549 end type dbametaanddatad
550 
552 type, public, extends(list) :: dbametaanddatadlist
553  contains
554  procedure :: current => currentdbametaanddatad
555  procedure :: display => displaydbametaanddatad
556  procedure :: toarray => toarray_dbametaanddatad
557 end type dbametaanddatadlist
558 
560 type, public,extends(dbadatar) :: dbametaanddatar
561  type(dbametadata) :: metadata
562  contains
563  procedure :: display => dbametaanddatar_display
564  procedure :: extrude => dbametaanddatar_extrude
565 end type dbametaanddatar
566 
568 type, public, extends(list) :: dbametaanddatarlist
569  contains
570  procedure :: current => currentdbametaanddatar
571  procedure :: display => displaydbametaanddatar
572  procedure :: toarray => toarray_dbametaanddatar
574 
576 type, public,extends(dbadatac) :: dbametaanddatac
577  type(dbametadata) :: metadata
578  contains
579  procedure :: display => dbametaanddatac_display
580  procedure :: extrude => dbametaanddatac_extrude
581 end type dbametaanddatac
582 
584 type, public, extends(list) :: dbametaanddataclist
585  contains
586  procedure :: current => currentdbametaanddatac
587  procedure :: display => displaydbametaanddatac
588  procedure :: toarray => toarray_dbametaanddatac
590 
592 type, public :: dbafilter
593  type(dbaana) :: ana
594  character(len=6) :: var
595  type(dbadatetime) :: datetime
596  type(dbalevel) :: level
597  type(dbatimerange) :: timerange
598  type(dbanetwork) :: network
599 
600  type(dbacoord) :: coordmin,coordmax
601  type(dbadatetime) :: datetimemin,datetimemax
602  integer :: limit
603  character(len=255) :: ana_filter, data_filter, attr_filter, varlist, starvarlist, anavarlist, anastarvarlist
604  character(len=40) :: query
605  integer :: priority,priomin,priomax
606  logical :: contextana
607  logical :: anaonly
608  logical :: dataonly
609  type(dbadcv) :: vars,starvars
610  type(dbadcv) :: anavars,anastarvars
611  contains
612  procedure :: display => dbafilter_display
613  procedure :: dbaset => dbafilter_set
614  procedure :: equalmetadata => dbafilter_equal_dbametadata
617  generic :: operator (==) => equalmetadata
618 end type dbafilter
619 
621 interface dbafilter
622  procedure dbafilter_init
623 end interface
624 
625 contains
626 
628 subroutine displaydbametaanddata(this)
629 class(dbametaanddatalist),intent(inout) :: this
630 type(dbametaanddata) :: element
631 
632 call this%rewind()
633 do while(this%element())
634  print *,"index:",this%currentindex()," value:"
635  element=this%current()
636  call element%display()
637  call this%next()
638 end do
639 end subroutine displaydbametaanddata
640 
642 type(dbametaanddata) function currentdbametaanddata(this)
643 class(dbametaanddataList),intent(inout) :: this
644 class(*), pointer :: v
645 
646 v => this%currentpoli()
647 select type(v)
648 type is (dbametaanddata)
649  currentdbametaanddata = v
650 end select
651 end function currentdbametaanddata
652 
653 
655 elemental logical function dbadata_equal(this,that)
656 
657 class(dbadata), intent(in) :: this
658 class(dbadata), intent(in) :: that
659 
660 if ( this%btable == that%btable ) then
661  dbadata_equal = .true.
662 else
663  dbadata_equal = .false.
664 end if
665 
666 end function dbadata_equal
667 
668 
670 subroutine dbadata_geti(data,value)
671 class(dbadata), intent(in) :: data
672 integer, intent(out) :: value
673 value=imiss
674 
675 select type(data)
676 type is (dbadatai)
677  value = data%value
678 end select
679 
680 end subroutine dbadata_geti
681 
682 
684 logical function dbadata_c_e_i(data)
685 class(dbadata), intent(in) :: data
686 
687 dbadata_c_e_i=.false.
688 
689 select type(data)
690 type is (dbadatai)
691  dbadata_c_e_i = c_e(data%value)
692 end select
693 
694 end function dbadata_c_e_i
695 
697 subroutine dbadata_getr(data,value)
698 class(dbadata), intent(in) :: data
699 real, intent(out) :: value
700 value=rmiss
701 
702 select type(data)
703 type is (dbadatar)
704  value = data%value
705 end select
706 
707 end subroutine dbadata_getr
708 
710 logical function dbadata_c_e_r(data)
711 class(dbadata), intent(in) :: data
712 
713 dbadata_c_e_r=.false.
714 
715 select type(data)
716 type is (dbadatar)
717  dbadata_c_e_r = c_e(data%value)
718 end select
719 
720 end function dbadata_c_e_r
721 
723 subroutine dbadata_getd(data,value)
724 class(dbadata), intent(in) :: data
725 doubleprecision, intent(out) :: value
726 value=dmiss
727 
728 select type(data)
729 type is (dbadatad)
730  value = data%value
731 end select
732 
733 end subroutine dbadata_getd
734 
736 logical function dbadata_c_e_d(data)
737 class(dbadata), intent(in) :: data
738 
739 dbadata_c_e_d=.false.
740 
741 select type(data)
742 type is (dbadatad)
743  dbadata_c_e_d = c_e(data%value)
744 end select
745 
746 end function dbadata_c_e_d
747 
748 
750 subroutine dbadata_getb(data,value)
751 class(dbadata), intent(in) :: data
752 INTEGER(kind=int_b), intent(out) :: value
753 value=bmiss
754 
755 select type(data)
756 type is (dbadatab)
757  value = data%value
758 end select
759 
760 end subroutine dbadata_getb
761 
763 logical function dbadata_c_e_b(data)
764 class(dbadata), intent(in) :: data
765 
766 dbadata_c_e_b=.false.
767 
768 select type(data)
769 type is (dbadatab)
770  dbadata_c_e_b = c_e(data%value)
771 end select
772 
773 end function dbadata_c_e_b
774 
776 subroutine dbadata_getc(data,value)
777 class(dbadata), intent(in) :: data
778 character(len=*), intent(out) :: value
779 value=cmiss
780 
781 select type(data)
782 type is (dbadatac)
783  value = data%value
784 end select
785 
786 end subroutine dbadata_getc
787 
788 
790 logical function dbadata_c_e_c(data)
791 class(dbadata), intent(in) :: data
792 
793 dbadata_c_e_c=.false.
794 
795 select type(data)
796 type is (dbadatac)
797  dbadata_c_e_c = c_e(data%value)
798 end select
799 
800 end function dbadata_c_e_c
801 
802 
804 logical function dbadata_c_e(data)
805 class(dbadata), intent(in) :: data
806 
807 dbadata_c_e=data%dbadata_c_e_i() .or. data%dbadata_c_e_r() .or. data%dbadata_c_e_d() &
808  .or. data%dbadata_c_e_b() .or. data%dbadata_c_e_c()
809 
810 end function dbadata_c_e
811 
812 
814 subroutine dbalevel_display(level)
815 class(dbalevel), intent(in) :: level
816 call display (level%vol7d_level)
817 end subroutine dbalevel_display
818 
821 type(dbalevel) function dbalevel_init(level1, l1, level2, l2)
822 
823 INTEGER,INTENT(IN),OPTIONAL :: level1
824 INTEGER,INTENT(IN),OPTIONAL :: l1
825 INTEGER,INTENT(IN),OPTIONAL :: level2
826 INTEGER,INTENT(IN),OPTIONAL :: l2
827 
828 call init (dbalevel_init%vol7d_level,level1, l1, level2, l2)
829 end function dbalevel_init
830 
832 subroutine dbalevel_set(level,session)
833 class(dbalevel), intent(in) :: level
834 type(dbasession), intent(in) :: session
835 integer :: ier
836 
837 !if (c_e(session%sehandle)) then
838 ier = idba_setlevel(session%sehandle,&
839  level%level1, level%l1, level%level2, level%l2)
840 
841 !todo this is a work around
842 if (.not. c_e(level%vol7d_level)) then
843  call session%setcontextana
844 end if
845 
846 end subroutine dbalevel_set
847 
849 subroutine dbalevel_enq(level,session)
850 class(dbalevel), intent(out) :: level
851 type(dbasession), intent(in) :: session
852 integer :: ier
853 
854 ier = idba_enqlevel(session%sehandle,&
855  level%level1, level%l1, level%level2, level%l2)
856 
857 end subroutine dbalevel_enq
858 
860 type(dbalevel) function dbalevel_contextana()
861 
862 dbalevel_contextana=dbalevel()
863 
864 end function dbalevel_contextana
865 
866 
868 subroutine dbaana_display(ana)
869 class(dbaana), intent(in) :: ana
870 call display (ana%vol7d_ana)
871 end subroutine dbaana_display
872 
873 
876 type(dbacoord) function dbacoord_init(lon, lat, ilon, ilat)
877 REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
878 REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
879 INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
880 INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
881 
882 CALL init(dbacoord_init%geo_coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
883 
884 end function dbacoord_init
885 
887 subroutine dbacoord_display(coord)
888 class(dbacoord), intent(in) :: coord
889 call display (coord%geo_coord)
890 end subroutine dbacoord_display
891 
894 type(dbaana) function dbaana_init(coord,ident,lon, lat, ilon, ilat)
895 CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
896 TYPE(dbacoord),INTENT(IN),optional :: coord
897 REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
898 REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
899 INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
900 INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
901 
902 if (present(coord))then
903  CALL init(dbaana_init%vol7d_ana, ilon=getilon(coord%geo_coord), ilat=getilat(coord%geo_coord), ident=ident)
904 else
905  CALL init(dbaana_init%vol7d_ana, lon=lon, lat=lat, ilon=ilon, ilat=ilat, ident=ident)
906 end if
907 
908 end function dbaana_init
909 
911 subroutine dbaana_set(ana,session)
912 class(dbaana), intent(in) :: ana
913 type(dbasession), intent(in) :: session
914 integer :: ier
915 
916 !if (c_e(session%sehandle)) then
917 ier = idba_set(session%sehandle,"lat",getilat(ana%vol7d_ana%coord))
918 ier = idba_set(session%sehandle,"lon",getilon(ana%vol7d_ana%coord))
919 if (c_e(ana%vol7d_ana%ident)) then
920  ier = idba_set(session%sehandle,"ident",ana%vol7d_ana%ident)
921  ier = idba_set(session%sehandle,"mobile",1)
922 else
923  ier = idba_set(session%sehandle,"ident",cmiss)
924  ier = idba_set(session%sehandle,"mobile",imiss)
925 end if
926 
927 end subroutine dbaana_set
928 
930 subroutine dbaana_enq(ana,session)
931 class(dbaana), intent(out) :: ana
932 type(dbasession), intent(in) :: session
933 integer :: ier,ilat,ilon
934 
935 !if (c_e(session%sehandle)) then
936 ier = idba_enq(session%sehandle,"lat",ilat)
937 ier = idba_enq(session%sehandle,"lon",ilon)
938 
939 call init(ana%vol7d_ana%coord,ilon=ilon,ilat=ilat)
940 ier = idba_enq(session%sehandle,"ident",ana%vol7d_ana%ident)
941 
942 end subroutine dbaana_enq
943 
944 
946 subroutine dbaana_extrude(ana,session)
947 class(dbaana), intent(in) :: ana
948 type(dbasession), intent(in) :: session
949 
950 call session%unsetall()
951 !write ana
952 call session%set(ana=ana)
953 call session%prendilo()
954 
955 !to close message on file
956 call session%close_message()
957 
958 end subroutine dbaana_extrude
959 
960 
962 subroutine displaydbaana(this)
963 class(dbaanalist),intent(inout) :: this
964 type(dbaana) :: element
965 
966 call this%rewind()
967 do while(this%element())
968  print *,"index:",this%currentindex()," value:"
969  element=this%current()
970  call element%display()
971  call this%next()
972 end do
973 end subroutine displaydbaana
974 
976 type(dbaana) function currentdbaana(this)
977 class(dbaanalist) :: this
978 class(*), pointer :: v
979 
980 v => this%currentpoli()
981 select type(v)
982 type is (dbaana)
983  currentdbaana = v
984 end select
985 end function currentdbaana
986 
987 
989 subroutine dbadc_set(dc,session)
990 class(dbadc), intent(in) :: dc
991 type(dbasession), intent(in) :: session
992 
993 call dc%dat%dbaset(session)
994 
995 end subroutine dbadc_set
996 
998 subroutine dbadc_display(dc)
999 class(dbadc), intent(in) :: dc
1000 
1001 call dc%dat%display()
1002 
1003 end subroutine dbadc_display
1004 
1006 subroutine dbadcv_set(dcv,session)
1007 class(dbadcv), intent(in) :: dcv
1008 type(dbasession), intent(in) :: session
1009 integer :: i
1010 
1011 do i=1, size(dcv%dcv)
1012  call dcv%dcv(i)%dbaset(session)
1013 enddo
1014 
1015 end subroutine dbadcv_set
1016 
1017 
1018 
1020 subroutine dbadcv_extrude(dcv,session,noattr,filter,template)
1021 class(dbadcv), intent(in) :: dcv
1022 type(dbasession), intent(in) :: session
1023 logical, intent(in),optional :: noattr
1024 type(dbafilter),intent(in),optional :: filter
1025 character(len=*),intent(in),optional :: template
1026 integer :: i
1027 
1028 do i=1, size(dcv%dcv)
1029  call dcv%dcv(i)%extrude(session,noattr,filter,template=template)
1030 enddo
1031 
1032 end subroutine dbadcv_extrude
1033 
1035 subroutine dbadc_extrude(data,session,noattr,filter,attronly,template)
1036 class(dbadc), intent(in) :: data
1037 type(dbasession), intent(in) :: session
1038 logical, intent(in),optional :: noattr
1039 type(dbafilter),intent(in),optional :: filter
1040 logical, intent(in),optional :: attronly
1041 character(len=*),intent(in),optional :: template
1042 
1043 call data%extrude(session,noattr,filter,attronly,template)
1044 
1045 end subroutine dbadc_extrude
1046 
1047 
1049 subroutine dbadcv_display(dcv)
1050 class(dbadcv), intent(in) :: dcv
1051 integer :: i
1052 
1053 if (allocated(dcv%dcv)) then
1054  do i=1, size(dcv%dcv)
1055  call dcv%dcv(i)%display()
1056  end do
1057 end if
1058 end subroutine dbadcv_display
1059 
1060 !!$subroutine dbadat_extrude(dat,session)
1061 !!$class(dbadat), intent(in) :: dat
1062 !!$type(dbasession), intent(in) :: session
1063 !!$
1064 !!$!write data in dsn
1065 !!$call dat%dbaset(session)
1066 !!$call session%prendilo()
1067 !!$
1068 !!$end subroutine dbadat_extrude
1069 !!$
1070 !!$subroutine dbadatav_extrude(datav,session)
1071 !!$class(dbadatav), intent(in) :: datav
1072 !!$type(dbasession), intent(in) :: session
1073 !!$integer :: i
1074 !!$!write data in dsn
1075 !!$do i =1,size(datav%dat)
1076 !!$ call datav%dat(i)%dbaset(session)
1077 !!$end do
1078 !!$call session%prendilo()
1079 !!$
1080 !!$end subroutine dbadatav_extrude
1082 
1084 subroutine dbasession_unsetb(session)
1085 class(dbasession), intent(in) :: session
1086 integer :: ier
1087 
1088 !if (session%file)then
1089 ier=idba_unsetb(session%sehandle)
1090 !end if
1091 end subroutine dbasession_unsetb
1092 
1094 subroutine dbasession_close_message(session,template)
1095 class(dbasession), intent(in) :: session
1096 character(len=*),intent(in),optional :: template
1097 integer :: ier
1098 character(len=40) :: ltemplate
1099 
1100 
1101 ltemplate=session%template
1102 if (present(template)) ltemplate=template
1103 
1104 !!$print*,"--------------- dbasession ---------------------------------"
1105 !!$print *,'file',session%file
1106 !!$print *,'filename',trim(session%filename)
1107 !!$print *,'mode',session%mode
1108 !!$print *,'format',session%format
1109 !!$print *,'simplified',session%simplified
1110 !!$print *,'memdb',session%memdb
1111 !!$print *,'loadfile',session%loadfile
1112 !!$print *,'template',ltemplate
1113 !!$print*,"------------------------------------------------"
1114 
1115 if (session%file)then
1116 
1117  if (session%memdb) then
1118 
1119  return
1120  !call session%messages_write_next(template=ltemplate)
1121 
1122  else
1123 
1124  if (c_e(ltemplate)) then
1125  ier=idba_set(session%sehandle,"query","message "//trim(ltemplate))
1126  else
1127  ier=idba_set(session%sehandle,"query","message")
1128  end if
1129 
1130  call session%unsetb()
1131  call session%prendilo()
1132 
1133  end if
1134 end if
1135 end subroutine dbasession_close_message
1136 
1137 
1139 subroutine dbasession_messages_open_input(session,filename,mode,format,simplified)
1140 class(dbasession), intent(in) :: session
1141 character (len=*), intent(in) :: filename
1142 character (len=*), intent(in),optional :: mode
1143 character (len=*), intent(in),optional :: format
1144 logical, intent(in),optional :: simplified
1145 
1146 integer :: ier
1147 character (len=40) :: lmode, lformat
1148 logical :: lsimplified
1149 
1150 lmode="r"
1151 if (present(mode)) lmode=mode
1152 
1153 lformat="BUFR"
1154 if (present(format)) lformat=format
1155 
1156 lsimplified=.true.
1157 if (present(simplified)) lsimplified=simplified
1158 
1159 ier = idba_messages_open_input(session%sehandle, filename, lmode, lformat, lsimplified)
1160 
1161 end subroutine dbasession_messages_open_input
1162 
1163 
1165 subroutine dbasession_messages_open_output(session,filename,mode,format)
1166 class(dbasession), intent(in) :: session
1167 character (len=*), intent(in) :: filename
1168 character (len=*), intent(in),optional :: mode
1169 character (len=*), intent(in),optional :: format
1171 integer :: ier
1172 character (len=40) :: lmode, lformat
1173 
1174 lmode="w"
1175 if (present(mode)) lmode=mode
1176 
1177 lformat="BUFR"
1178 if (present(format)) lformat=format
1179 
1180 ier = idba_messages_open_output(session%sehandle, filename, lmode, lformat)
1181 
1182 end subroutine dbasession_messages_open_output
1184 
1186 logical function dbasession_messages_read_next(session)
1187 class(dbasession), intent(in) :: session
1188 
1189 integer :: ier
1190 
1191 ier = idba_messages_read_next(session%sehandle, dbasession_messages_read_next)
1193 end function dbasession_messages_read_next
1194 
1196 subroutine dbasession_messages_write_next(session,template)
1197 class(dbasession), intent(in) :: session
1198 character(len=*), optional :: template
1199 character(len=40) :: ltemplate
1201 integer :: ier
1202 
1203 !TODO how to set autodetect?
1204 !ltemplate="generic" !! "wmo" = wmo - WMO style templates (autodetect) ?
1205 
1206 ltemplate=session%template
1207 if (present(template)) ltemplate=template
1208 
1209 ier = idba_messages_write_next(session%sehandle,ltemplate)
1210 
1211 end subroutine dbasession_messages_write_next
1212 
1213 
1215 subroutine dbasession_dissolve_metadata(session,metadata)
1216 class(dbasession), intent(in) :: session
1217 type(dbametadata), intent(in) :: metadata(:)
1218 
1219 integer :: i
1220 
1221 do i =1, size (metadata)
1222 
1223  call metadata(i)%dbaset(session)
1224  call session%dissolve()
1225 
1226 end do
1227 
1228 end subroutine dbasession_dissolve_metadata
1230 
1231 
1233 subroutine dbasession_dissolveattr_metadata(session,metadata)
1234 class(dbasession), intent(in) :: session
1235 type(dbametadata), intent(in),optional :: metadata(:)
1236 
1237 character(len=9) :: btable
1238 integer :: i,ii,count,ier
1239 
1240 if (present (metadata)) then
1241  do i =1, size (metadata)
1242 
1243  ! here if metadata have some field missig they will be set to missing so it will be unset in dballe (I hope)
1244  call metadata(i)%dbaset(session)
1245  ier = idba_voglioquesto(session%sehandle, count)
1246 
1247  if (.not. c_e(count)) cycle
1248  do ii =1,count
1249  ier = idba_dammelo(session%sehandle, btable)
1250  !call session%var_related(btable) !not needed after dammelo
1251  call session%scusa()
1252  end do
1253 
1254  end do
1255 else
1256 
1257  ier = idba_voglioquesto(session%sehandle, count)
1258 
1259  if (c_e(count)) then
1260  do i =1,count
1261  ier = idba_dammelo(session%sehandle, btable)
1262  !call session%var_related(btable) !not needed after dammelo
1263  call session%scusa()
1264  end do
1265  end if
1266 end if
1267 end subroutine dbasession_dissolveattr_metadata
1268 
1269 
1271 subroutine dbadataattr_extrude(data,session,noattr,filter,attronly,template)
1272 class(dbadataattr), intent(in) :: data
1273 type(dbasession), intent(in) :: session
1274 logical, intent(in),optional :: noattr
1275 type(dbafilter),intent(in),optional :: filter
1276 logical, intent(in),optional :: attronly
1277 character(len=*),intent(in),optional :: template
1278 integer :: i,ierr,count,code
1279 logical :: critica
1280 character(len=9) :: btable
1281 
1282 
1283 if (session%file .and. optio_log(attronly))then
1284  call l4f_category_log(session%category,l4f_error,"attronly writing on file not supported")
1285  CALL raise_fatal_error()
1286 end if
1287 
1288 if (present(filter))then
1289  if (filter%contextana) then
1290  if (.not. filter%anavars == data%dbadc%dat) return
1291  else
1292  if (.not. filter%vars == data%dbadc%dat) return
1293  end if
1294 endif
1295 
1296 !write data in dsn
1297 
1298 !print *,"extrude dati:"
1299 !call data%dbadc%display()
1300 
1301 ! missing on file do nothing
1302 if (.not. data%dbadc%dat%c_e() .and. session%file) return
1303 
1304 call data%dbadc%dbaset(session)
1305 
1306 code = idba_error_code() !! 13 for Value is outside the range
1307 
1308 if (optio_log(attronly).or. .not. data%dbadc%dat%c_e() .or. code ==13 ) then
1309 
1310  !! those hare required?
1311  ierr = idba_set(session%sehandle,"var",data%dbadc%dat%btable)
1312  !!
1313 
1314  ierr = idba_voglioquesto(session%sehandle, count)
1315 
1316  ! with missing data to extrude and missing data in DB we have nothing to delete
1317  ! with attronly and missing data in DB we have nothing to do
1318  ierr=idba_unsetb(session%sehandle)
1319  if (count ==0) return
1320 
1321  if (c_e(count)) then
1322  if (optio_log(attronly))then
1323  ierr=idba_dammelo(session%sehandle, btable)
1324  !ierr=idba_enqi(session%sehandle, "context_id", id)
1325  else
1326  !remove data from db if data is missing
1327  ierr=idba_dimenticami(session%sehandle)
1328  endif
1329  endif
1330 else
1331  call session%prendilo()
1332  ierr=idba_unsetb(session%sehandle)
1333 end if
1334 
1335 if (optio_log(noattr)) return
1336 
1337 !write attributes in dsn
1338 if (allocated(data%attrv%dcv)) then
1339  if (size(data%attrv%dcv) > 0 )then
1340  critica = .false.
1341  do i = 1, size(data%attrv%dcv)
1342  if (present(filter))then
1343  if (filter%contextana) then
1344  if (.not. filter%anastarvars == data%attrv%dcv(i)%dat) cycle
1345  else
1346  if (.not. filter%starvars == data%attrv%dcv(i)%dat) cycle
1347  end if
1348  endif
1349 
1350  if (data%attrv%dcv(i)%dat%c_e()) then
1351  !print *,"extrude attributi:"
1352  !call data%attrv%dcv(i)%dat%display()
1353  call data%attrv%dcv(i)%dat%dbaset(session)
1354  critica=.true.
1355  else if(optio_log(attronly)) then
1356  !ierr=idba_seti(session%sehandle, "*context_id", id)
1357  !call session%var_related(data%dbadc%dat%btable) ! If I have made a prendilo I do not need this
1358  !call data%attrv%dcv(i)%dat%dbaset(session)
1359  ierr = idba_set(session%sehandle,"*var",data%attrv%dcv(i)%dat%btable)
1360  !print *,"scusa attributi:"
1361  !call data%attrv%dcv(i)%dat%display()
1362  call session%scusa()
1363  endif
1364  end do
1365  if (critica) then
1366  !ierr=idba_seti(session%sehandle, "*context_id", id)
1367  !call session%var_related(data%dbadc%dat%btable) ! If I have made a prendilo I do not need this
1368  call session%critica()
1369  end if
1370 
1371  end if
1372 end if
1373 
1374 
1375 !to close message on file
1376 !call session%close_message()
1377 
1378 end subroutine dbadataattr_extrude
1379 
1381 subroutine dbadataattr_display(dc)
1382 class(dbadataattr), intent(in) :: dc
1383 
1384 print*,"Data:"
1385 call dc%dbadc%display()
1386 print*,"Attributes:"
1387 call dc%attrv%display()
1388 
1389 end subroutine dbadataattr_display
1391 
1393 subroutine dbadataattrv_extrude(dataattr,session,noattr,filter,attronly,template)
1394 class(dbadataattrv), intent(in) :: dataattr
1395 type(dbasession), intent(in) :: session
1396 logical, intent(in),optional :: noattr
1397 type(dbafilter),intent(in),optional :: filter
1398 logical, intent(in),optional :: attronly
1399 character(len=*),intent(in),optional :: template
1400 
1401 integer :: i
1402 
1403 if(.not. allocated(dataattr%dataattr)) return
1404 do i=1, size(dataattr%dataattr)
1405  call dataattr%dataattr(i)%extrude(session,noattr,filter,attronly,template)
1406 enddo
1407 
1408 !to close message on file
1409 !call session%prendilo()
1410 !call session%close_message()
1411 
1412 end subroutine dbadataattrv_extrude
1413 
1415 subroutine dbadataattrv_display(dataattr)
1416 class(dbadataattrv), intent(in) :: dataattr
1417 integer :: i
1418 
1419 do i=1, size(dataattr%dataattr)
1420  call dataattr%dataattr(i)%display()
1421 end do
1422 
1423 end subroutine dbadataattrv_display
1424 
1426 subroutine dbadatai_geti(data,value)
1427 class(dbadatai), intent(in) :: data
1428 integer, intent(out) :: value
1429 value=data%value
1430 end subroutine dbadatai_geti
1431 
1433 subroutine dbadatar_getr(data,value)
1434 class(dbadatar), intent(in) :: data
1435 real, intent(out) :: value
1436 value=data%value
1437 end subroutine dbadatar_getr
1438 
1440 subroutine dbadatad_getd(data,value)
1441 class(dbadatad), intent(in) :: data
1442 doubleprecision, intent(out) :: value
1443 value=data%value
1444 end subroutine dbadatad_getd
1445 
1447 subroutine dbadatab_getb(data,value)
1448 class(dbadatab), intent(in) :: data
1449 integer(kind=int_b), intent(out) :: value
1450 value=data%value
1451 end subroutine dbadatab_getb
1452 
1454 subroutine dbadatac_getc(data,value)
1455 class(dbadatac), intent(in) :: data
1456 character(len=*), intent(out) :: value
1457 value=data%value
1458 end subroutine dbadatac_getc
1459 
1460 
1463 type(dbadatai) elemental function dbadatai_init(btable,value)
1464 
1465 character(len=*),INTENT(IN),OPTIONAL :: btable
1466 INTEGER,INTENT(IN),OPTIONAL :: value
1467 
1468 if (present(btable)) then
1469  dbadatai_init%btable=btable
1470 else
1471  dbadatai_init%btable=cmiss
1472 end if
1473 
1474 if (present(value)) then
1475  dbadatai_init%value=value
1476 else
1477  dbadatai_init%value=imiss
1478 end if
1479 
1480 end function dbadatai_init
1481 
1484 type(dbadatar) elemental function dbadatar_init(btable,value)
1485 
1486 character(len=*),INTENT(IN),OPTIONAL :: btable
1487 real,INTENT(IN),OPTIONAL :: value
1488 
1489 if (present(btable)) then
1490  dbadatar_init%btable=btable
1491 else
1492  dbadatar_init%btable=cmiss
1493 end if
1494 
1495 if (present(value)) then
1496  dbadatar_init%value=value
1497 else
1498  dbadatar_init%value=rmiss
1499 end if
1500 
1501 end function dbadatar_init
1502 
1505 type(dbadatad) elemental function dbadatad_init(btable,value)
1506 
1507 character(len=*),INTENT(IN),OPTIONAL :: btable
1508 double precision,INTENT(IN),OPTIONAL :: value
1509 
1510 if (present(btable)) then
1511  dbadatad_init%btable=btable
1512 else
1513  dbadatad_init%btable=cmiss
1514 end if
1515 
1516 if (present(value)) then
1517  dbadatad_init%value=value
1518 else
1519  dbadatad_init%value=dmiss
1520 end if
1521 
1522 end function dbadatad_init
1523 
1524 
1527 type(dbadatab) elemental function dbadatab_init(btable,value)
1528 
1529 character(len=*),INTENT(IN),OPTIONAL :: btable
1530 INTEGER(kind=int_b) ,INTENT(IN),OPTIONAL :: value
1531 
1532 if (present(btable)) then
1533  dbadatab_init%btable=btable
1534 else
1535  dbadatab_init%btable=cmiss
1536 end if
1537 
1538 if (present(value)) then
1539  dbadatab_init%value=value
1540 else
1541  dbadatab_init%value=bmiss
1542 end if
1543 
1544 end function dbadatab_init
1545 
1548 type(dbadatac) elemental function dbadatac_init(btable,value)
1549 
1550 character(len=*),INTENT(IN),OPTIONAL :: btable
1551 character(len=*),INTENT(IN),OPTIONAL :: value
1552 
1553 if (present(btable)) then
1554  dbadatac_init%btable=btable
1555 else
1556  dbadatac_init%btable=cmiss
1557 end if
1558 
1559 if (present(value)) then
1560  dbadatac_init%value=value
1561 else
1562  dbadatac_init%value=cmiss
1563 end if
1564 
1565 end function dbadatac_init
1566 
1567 
1569 subroutine dbadatai_set(data,session)
1570 class(dbadatai), intent(in) :: data
1571 type(dbasession), intent(in) :: session
1572 integer :: ier
1573 if (.not. c_e(data%btable)) return
1574 ier = idba_set(session%sehandle,data%btable,data%value)
1575 end subroutine dbadatai_set
1576 
1578 subroutine dbadatai_display(data)
1579 class(dbadatai), intent(in) :: data
1580 print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
1581 end subroutine dbadatai_display
1582 
1584 subroutine dbadatar_set(data,session)
1585 class(dbadatar), intent(in) :: data
1586 type(dbasession), intent(in) :: session
1587 integer :: ier
1588 if (.not. c_e(data%btable)) return
1589 ier = idba_set(session%sehandle,data%btable,data%value)
1590 end subroutine dbadatar_set
1591 
1593 subroutine dbadatar_display(data)
1594 class(dbadatar), intent(in) :: data
1595 print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
1596 end subroutine dbadatar_display
1597 
1598 
1600 subroutine dbadatad_set(data,session)
1601 class(dbadatad), intent(in) :: data
1602 type(dbasession), intent(in) :: session
1603 integer :: ier
1604 if (.not. c_e(data%btable)) return
1605 ier = idba_set(session%sehandle,data%btable,data%value)
1606 end subroutine dbadatad_set
1607 
1609 subroutine dbadatad_display(data)
1610 class(dbadatad), intent(in) :: data
1611 print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
1612 end subroutine dbadatad_display
1613 
1615 subroutine dbadatab_set(data,session)
1616 class(dbadatab), intent(in) :: data
1617 type(dbasession), intent(in) :: session
1618 integer :: ier
1619 if (.not. c_e(data%btable)) return
1620 ier = idba_set(session%sehandle,data%btable,data%value)
1621 end subroutine dbadatab_set
1622 
1624 subroutine dbadatab_display(data)
1625 class(dbadatab), intent(in) :: data
1626 print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
1627 end subroutine dbadatab_display
1628 
1630 subroutine dbadatac_set(data,session)
1631 class(dbadatac), intent(in) :: data
1632 type(dbasession), intent(in) :: session
1633 integer :: ier
1634 if (.not. c_e(data%btable)) return
1635 ier = idba_set(session%sehandle,data%btable,data%value)
1636 end subroutine dbadatac_set
1637 
1639 subroutine dbadatac_display(data)
1640 class(dbadatac), intent(in) :: data
1641 print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
1642 end subroutine dbadatac_display
1643 
1644 
1645 !!$function dbalevel_spiega(level,handle)
1646 !!$class(dbalevel), intent(in) :: level
1647 !!$integer, intent(in) :: handle
1648 !!$character (len=255) :: dbalevel_spiega
1649 !!$integer :: ier
1650 !!$
1651 !!$ier = idba_spiegal(handle,level%level1,level%l1,level%level2,level%l2,dbalevel_spiega)
1652 !!$if (ier /= 0) dbalevel_spiega = cmiss
1653 !!$
1654 !!$end function dbalevel_spiega
1655 
1656 
1658 subroutine dbatimerange_display(timerange)
1659 class(dbatimerange), intent(in) :: timerange
1660 call display (timerange%vol7d_timerange)
1661 end subroutine dbatimerange_display
1662 
1664 subroutine dbatimerange_set(timerange,session)
1665 class(dbatimerange), intent(in) :: timerange
1666 type(dbasession), intent(in) :: session
1667 integer :: ier
1668 
1669 ier = idba_settimerange(session%sehandle,&
1670  timerange%timerange, timerange%p1, timerange%p2)
1671 
1672 !todo this is a work around
1673 if (.not. c_e(timerange%vol7d_timerange)) then
1674  call session%setcontextana
1675 end if
1676 
1677 end subroutine dbatimerange_set
1680 subroutine dbatimerange_enq(timerange,session)
1681 class(dbatimerange), intent(out) :: timerange
1682 type(dbasession), intent(in) :: session
1683 integer :: ier
1684 
1685 ier = idba_enqtimerange(session%sehandle,&
1686  timerange%timerange, timerange%p1, timerange%p2)
1687 
1688 end subroutine dbatimerange_enq
1689 
1692 type(dbatimerange) function dbatimerange_init(timerange, p1, p2)
1693 INTEGER,INTENT(IN),OPTIONAL :: timerange
1694 INTEGER,INTENT(IN),OPTIONAL :: p1
1695 INTEGER,INTENT(IN),OPTIONAL :: p2
1696 
1697 call init (dbatimerange_init%vol7d_timerange,timerange, p1, p2)
1698 end function dbatimerange_init
1701 type(dbatimerange) function dbatimerange_contextana()
1702 
1703 dbatimerange_contextana=dbatimerange()
1704 
1705 end function dbatimerange_contextana
1706 
1707 
1709 subroutine dbanetwork_display(network)
1710 class(dbanetwork), intent(in) :: network
1711 call display (network%vol7d_network)
1712 print *,"Priority=",network%priority
1713 end subroutine dbanetwork_display
1714 
1716 subroutine dbanetwork_set(network,session)
1717 class(dbanetwork), intent(in) :: network
1718 type(dbasession), intent(in) :: session
1719 integer :: ier
1720 
1721 ier = idba_set(session%sehandle,"rep_memo", network%name)
1722 
1723 end subroutine dbanetwork_set
1724 
1726 subroutine dbanetwork_enq(network,session)
1727 class(dbanetwork), intent(out) :: network
1728 type(dbasession), intent(in) :: session
1729 integer :: ier
1730 
1731 ier = idba_enq(session%sehandle,"rep_memo", network%name)
1732 ier = idba_enq(session%sehandle,"priority", network%priority)
1733 
1734 end subroutine dbanetwork_enq
1735 
1738 type(dbanetwork) function dbanetwork_init(name)
1739 CHARACTER(len=*),INTENT(in),OPTIONAL :: name
1740 
1741 call init (dbanetwork_init%vol7d_network,name)
1742 dbanetwork_init%priority=imiss
1743 end function dbanetwork_init
1744 
1745 
1747 subroutine dbadatetime_display(datetime)
1748 class(dbadatetime), intent(in) :: datetime
1749 call display (datetime%datetime)
1750 end subroutine dbadatetime_display
1751 
1753 subroutine dbadatetime_set(datetime,session)
1754 class(dbadatetime), intent(in) :: datetime
1755 type(dbasession), intent(in) :: session
1756 integer :: ier,year,month,day,hour,minute,sec,msec
1757 
1758 CALL getval(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1759 
1760 if (c_e(msec)) then
1761  sec=nint(float(msec)/1000.)
1762 else
1763  sec=imiss
1764 end if
1765 
1766 ier = idba_setdate(session%sehandle,year,month,day,hour,minute,sec)
1767 
1768 !todo this is a work around
1769 if (.not. c_e(datetime%datetime)) then
1770  call session%setcontextana
1771 end if
1773 end subroutine dbadatetime_set
1774 
1776 subroutine dbadatetime_enq(datetime,session)
1777 class(dbadatetime), intent(out) :: datetime
1778 type(dbasession), intent(in) :: session
1779 
1780 integer :: ier,year,month,day,hour,minute,sec,msec
1781 
1782 ier = idba_enqdate(session%sehandle,year,month,day,hour,minute,sec)
1783 
1784 if (c_e(sec)) then
1785  msec=sec*1000
1786 else
1787  msec=imiss
1788 end if
1789 
1790 !! TODO
1791 !! this is a workaround ! year == 1000 should never exist
1792 if (year==1000) then
1793  datetime%datetime=datetime_new()
1794 else
1795  CALL init(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1796 end if
1797 
1798 end subroutine dbadatetime_enq
1799 
1802 type(dbadatetime) function dbadatetime_init(dt)
1803 type(datetime),INTENT(in),OPTIONAL :: dt
1804 
1805 if (present(dt)) then
1806  dbadatetime_init%datetime=dt
1807 else
1808  dbadatetime_init%datetime=datetime_new()
1809 end if
1810 
1811 end function dbadatetime_init
1812 
1814 type(dbadatetime) function dbadatetime_contextana()
1815 
1816 dbadatetime_contextana%datetime=datetime_new()
1817 
1818 end function dbadatetime_contextana
1819 
1820 
1823 type(dbametadata) function dbametadata_init(level,timerange,ana,network,datetime)
1825 type(dbalevel), intent(in), optional :: level
1826 type(dbatimerange), intent(in), optional :: timerange
1827 type(dbaana), intent(in), optional :: ana
1828 type(dbanetwork), intent(in), optional :: network
1829 type(dbadatetime), intent(in), optional :: datetime
1830 
1831 if (present(level)) then
1832  dbametadata_init%level=level
1833 else
1834  dbametadata_init%level=dbalevel()
1835 end if
1836 
1837 if (present(timerange)) then
1838  dbametadata_init%timerange=timerange
1839 else
1840  dbametadata_init%timerange=dbatimerange()
1841 end if
1842 
1843 if (present(ana)) then
1844  dbametadata_init%ana=ana
1845 else
1846  dbametadata_init%ana=dbaana()
1847 end if
1848 
1849 if (present(network)) then
1850  dbametadata_init%network=network
1851 else
1852  dbametadata_init%network=dbanetwork()
1853 end if
1854 
1855 if (present(datetime)) then
1856  dbametadata_init%datetime=datetime
1857 else
1858  dbametadata_init%datetime=dbadatetime()
1859 end if
1860 
1861 end function dbametadata_init
1862 
1864 subroutine dbametadata_display(metadata)
1865 class(dbametadata), intent(in) :: metadata
1866 call metadata%level%display()
1867 call metadata%timerange%display()
1868 call metadata%ana%display()
1869 call metadata%network%display()
1870 call metadata%datetime%display()
1871 
1872 end subroutine dbametadata_display
1873 
1875 subroutine dbametadata_set(metadata,session)
1876 class(dbametadata), intent(in) :: metadata
1877 type(dbasession), intent(in) :: session
1878 
1879 !print *,"extrude metadata:"
1880 !call metadata%display()
1881 
1882 call metadata%ana%dbaset(session)
1883 call metadata%network%dbaset(session)
1884 
1885 if (c_e(metadata%datetime%datetime) .or. &
1886  c_e(metadata%level%vol7d_level) .or. &
1887  c_e(metadata%timerange%vol7d_timerange)) then
1888 
1889  call metadata%datetime%dbaset(session)
1890  call metadata%level%dbaset(session)
1891  call metadata%timerange%dbaset(session)
1892 
1893 else
1894  call session%setcontextana()
1895 end if
1896 
1897 end subroutine dbametadata_set
1898 
1900 subroutine dbametadata_enq(metadata,session)
1901 class(dbametadata), intent(out) :: metadata
1902 type(dbasession), intent(in) :: session
1904 call metadata%ana%dbaenq(session)
1905 call metadata%network%dbaenq(session)
1906 call metadata%datetime%dbaenq(session)
1907 call metadata%level%dbaenq(session)
1908 call metadata%timerange%dbaenq(session)
1909 
1910 end subroutine dbametadata_enq
1911 
1912 
1914 logical function dbafilter_equal_dbametadata(this,that)
1915 
1916 class(dbafilter), intent(in) :: this
1917 class(dbametadata), intent(in) :: that
1918 
1919 dbafilter_equal_dbametadata = .false.
1921 !! TODO utilizzare dataonly ? direi di no
1922 
1923 if (this%contextana .and. c_e(that%timerange%vol7d_timerange)) return
1924 if (this%contextana .and. c_e(that%datetime%datetime)) return
1925 if (this%contextana .and. c_e(that%level%vol7d_level)) return
1926 
1927 if (c_e(this%level%vol7d_level) .and. .not. this%level%vol7d_level == that%level%vol7d_level ) return
1928 if (c_e(this%timerange%vol7d_timerange) .and. .not. this%timerange%vol7d_timerange == that%timerange%vol7d_timerange ) return
1929 if (c_e(this%datetime%datetime) .and. .not. this%datetime%datetime == that%datetime%datetime ) return
1930 if (c_e(this%network%vol7d_network) .and. .not. this%network%vol7d_network == that%network%vol7d_network ) return
1931 if (c_e(this%ana%vol7d_ana) .and. .not. this%ana%vol7d_ana == that%ana%vol7d_ana ) return
1933 if ( c_e(this%datetimemin%datetime) .and. c_e(that%datetime%datetime) .and. &
1934  this%datetimemin%datetime > that%datetime%datetime ) return
1935 if ( c_e(this%datetimemax%datetime) .and. c_e(that%datetime%datetime) .and. &
1936  this%datetimemax%datetime < that%datetime%datetime ) return
1937 
1938 if (c_e(this%coordmin%geo_coord)) then
1939  if (geo_coord_ll(that%ana%vol7d_ana%coord, this%coordmin%geo_coord)) return
1940 end if
1942 if (c_e(this%coordmax%geo_coord)) then
1943  if (geo_coord_ur(that%ana%vol7d_ana%coord, this%coordmax%geo_coord)) return
1944 end if
1945 
1946 dbafilter_equal_dbametadata = .true.
1948 end function dbafilter_equal_dbametadata
1949 
1950 
1951 !!$!> equal operator for dbafilter and dbadata
1952 !!$! todo qui vuene utilizzata vars ma potrebbe essere attrs: bisogna distinguere
1953 !!$elemental logical function dbafilter_equal_dbadata(this,that)
1954 !!$
1955 !!$class(dbafilter), intent(in) :: this !< first element
1956 !!$class(dbadata), intent(in) :: that !< second element
1957 !!$
1958 !!$integer :: i
1959 !!$
1960 !!$!non compila:
1961 !!$!dbafilter_equal_dbadata = any(this%vars%dcv(:)%dat == that)
1962 !!$
1963 !!$if (allocated(this%vars%dcv)) then
1964 !!$ do i=1, size(this%vars%dcv(:))
1965 !!$ dbafilter_equal_dbadata = this%vars%dcv(i)%dat == that
1966 !!$ if (dbafilter_equal_dbadata) continue
1967 !!$ end do
1968 !!$else
1969 !!$ dbafilter_equal_dbadata=.false.
1970 !!$end if
1971 !!$
1972 !!$end function dbafilter_equal_dbadata
1973 
1974 
1977 elemental logical function dbadcv_equal_dbadata(this,that)
1978 
1979 class(dbadcv), intent(in) :: this
1980 class(dbadata), intent(in) :: that
1981 
1982 integer :: i
1983 
1984 !non compila:
1985 !dbafilter_equal_dbadata = any(this%vars%dcv(:)%dat == that)
1986 
1987 if (allocated(this%dcv)) then
1988  dbadcv_equal_dbadata=.false.
1989  do i=1, size(this%dcv)
1990  dbadcv_equal_dbadata = this%dcv(i)%dat == that
1991  if (dbadcv_equal_dbadata) exit
1992  end do
1993 else
1994  dbadcv_equal_dbadata=.true.
1995 end if
1997 end function dbadcv_equal_dbadata
1998 
1999 
2001 elemental logical function dbametadata_equal(this,that)
2002 
2003 class(dbametadata), intent(in) :: this
2004 class(dbametadata), intent(in) :: that
2005 
2006 if ( &
2007  this%level%vol7d_level == that%level%vol7d_level .and. &
2008  this%timerange%vol7d_timerange == that%timerange%vol7d_timerange .and. &
2009  this%datetime%datetime == that%datetime%datetime .and. &
2010  this%network%vol7d_network == that%network%vol7d_network .and. &
2011  this%ana%vol7d_ana == that%ana%vol7d_ana &
2012  ) then
2013  dbametadata_equal = .true.
2014 else
2015  dbametadata_equal = .false.
2016 end if
2018 end function dbametadata_equal
2019 
2020 
2024 type(dbafilter) function dbafilter_init(filter,ana,var,datetime,level,timerange,network,&
2025  datetimemin,datetimemax,coordmin,coordmax,limit,&
2026  ana_filter, data_filter, attr_filter, varlist, starvarlist, anavarlist, anastarvarlist ,&
2027  priority, priomin, priomax, contextana,&
2028  vars, starvars, anavars, anastarvars, query,anaonly,dataonly)
2029 
2030 type(dbafilter),intent(in),optional :: filter
2031 type(dbaana),intent(in),optional :: ana
2032 character(len=*),intent(in),optional :: var
2033 type(dbadatetime),intent(in),optional :: datetime
2034 type(dbalevel),intent(in),optional :: level
2035 type(dbatimerange),intent(in),optional :: timerange
2036 type(dbanetwork),intent(in),optional :: network
2037 type(dbacoord),intent(in),optional :: coordmin
2038 type(dbacoord),intent(in),optional :: coordmax
2039 type(dbadatetime),intent(in),optional :: datetimemin
2040 type(dbadatetime),intent(in),optional :: datetimemax
2041 integer,intent(in),optional :: limit
2042 character(len=*),intent(in),optional :: ana_filter
2043 character(len=*),intent(in),optional :: data_filter
2044 character(len=*),intent(in),optional :: attr_filter
2045 character(len=*),intent(in),optional :: varlist
2046 character(len=*),intent(in),optional :: starvarlist
2047 character(len=*),intent(in),optional :: anavarlist
2048 character(len=*),intent(in),optional :: anastarvarlist
2049 integer,intent(in),optional :: priority
2050 integer,intent(in),optional :: priomin
2051 integer,intent(in),optional :: priomax
2052 logical,intent(in),optional :: contextana
2053 class(dbadcv),intent(in),optional :: vars ! vector of vars wanted on output
2054 class(dbadcv),intent(in),optional :: starvars ! vector of vars for attribute wanted on output
2055 class(dbadcv),intent(in),optional :: anavars ! vector of ana vars wanted on output
2056 class(dbadcv),intent(in),optional :: anastarvars ! vector of vars for attribute of ana wanted on output
2057 character(len=*),intent(in),optional :: query
2058 logical,intent(in),optional :: anaonly
2059 logical,intent(in),optional :: dataonly
2060 
2061 integer :: i
2062 logical :: nopreserve
2063 
2064 nopreserve=.true.
2065 if (present(filter)) then
2066  dbafilter_init=filter
2067 
2068 !!$ if (allocated(filter%vars%dcv)) then
2069 !!$ if (allocated(dbafilter_init%vars%dcv)) deallocate(dbafilter_init%vars%dcv)
2070 !!$ allocate(dbafilter_init%vars%dcv(size(filter%vars%dcv)))
2071 !!$ do i =1,size(filter%vars%dcv)
2072 !!$ allocate(dbafilter_init%vars%dcv(i)%dat,source=filter%vars%dcv(i)%dat)
2073 !!$ end do
2074 !!$ end if
2075 !!$
2076 !!$ if (allocated(filter%starvars%dcv)) then
2077 !!$ if (allocated(dbafilter_init%starvars%dcv)) deallocate(dbafilter_init%starvars%dcv)
2078 !!$ allocate(dbafilter_init%starvars%dcv(size(filter%starvars%dcv)))
2079 !!$ do i =1,size(filter%starvars%dcv)
2080 !!$ allocate(dbafilter_init%starvars%dcv(i)%dat,source=filter%starvars%dcv(i)%dat)
2081 !!$ end do
2082 !!$ end if
2083 !!$
2084 !!$ if (allocated(filter%anavars%dcv)) then
2085 !!$ if (allocated(dbafilter_init%anavars%dcv)) deallocate(dbafilter_init%anavars%dcv)
2086 !!$ allocate(dbafilter_init%anavars%dcv(size(filter%anavars%dcv)))
2087 !!$ do i =1,size(filter%anavars%dcv)
2088 !!$ call filter%anavars%dcv(i)%dat%display()
2089 !!$ allocate(dbafilter_init%anavars%dcv(i)%dat,source=filter%anavars%dcv(i)%dat)
2090 !!$ end do
2091 !!$ end if
2092 !!$
2093 !!$ if (allocated(filter%anastarvars%dcv)) then
2094 !!$ if (allocated(dbafilter_init%anastarvars%dcv)) deallocate(dbafilter_init%anastarvars%dcv)
2095 !!$ allocate(dbafilter_init%anastarvars%dcv(size(filter%anastarvars%dcv)))
2096 !!$ do i =1,size(filter%anastarvars%dcv)
2097 !!$ allocate(dbafilter_init%anastarvars%dcv(i)%dat,source=filter%anastarvars%dcv(i)%dat)
2098 !!$ end do
2099 !!$ end if
2100 
2101  nopreserve=.false.
2102 end if
2103 
2104 if (present(ana)) then
2105  dbafilter_init%ana=ana
2106 else if (nopreserve) then
2107  dbafilter_init%ana=dbaana()
2108 end if
2109 
2110 if (present(var)) then
2111  dbafilter_init%var=var
2112 else if (nopreserve) then
2113  dbafilter_init%var=cmiss
2114 end if
2115 
2116 if (present(datetime)) then
2117  dbafilter_init%datetime=datetime
2118 else if (nopreserve) then
2119  dbafilter_init%datetime=dbadatetime()
2120 end if
2121 
2122 if (present(level)) then
2123  dbafilter_init%level=level
2124 else if (nopreserve) then
2125  dbafilter_init%level=dbalevel()
2126 end if
2127 
2128 if (present(timerange)) then
2129  dbafilter_init%timerange=timerange
2130 else if (nopreserve) then
2131  dbafilter_init%timerange=dbatimerange()
2132 end if
2133 
2134 if (present(network)) then
2135  dbafilter_init%network=network
2136 else if (nopreserve) then
2137  dbafilter_init%network=dbanetwork()
2138 end if
2139 
2140 if (present(datetimemin)) then
2141  dbafilter_init%datetimemin=datetimemin
2142 else if (nopreserve) then
2143  dbafilter_init%datetimemin=dbadatetime()
2144 end if
2145 
2146 if (present(datetimemax)) then
2147  dbafilter_init%datetimemax=datetimemax
2148 else if (nopreserve) then
2149  dbafilter_init%datetimemax=dbadatetime()
2150 end if
2151 
2152 if (present(coordmin)) then
2153  dbafilter_init%coordmin=coordmin
2154 else if (nopreserve) then
2155  dbafilter_init%coordmin=dbacoord()
2156 end if
2157 
2158 if (present(coordmax)) then
2159  dbafilter_init%coordmax=coordmax
2160 else if (nopreserve) then
2161  dbafilter_init%coordmax=dbacoord()
2162 end if
2163 
2164 if (present(limit)) then
2165  dbafilter_init%limit=limit
2166 else if (nopreserve) then
2167  dbafilter_init%limit=imiss
2168 end if
2169 
2170 if (present(ana_filter)) then
2171  dbafilter_init%ana_filter=ana_filter
2172 else if (nopreserve) then
2173  dbafilter_init%ana_filter=cmiss
2174 end if
2175 
2176 if (present(data_filter)) then
2177  dbafilter_init%data_filter=data_filter
2178 else if (nopreserve) then
2179  dbafilter_init%data_filter=cmiss
2180 end if
2181 
2182 if (present(attr_filter)) then
2183  dbafilter_init%attr_filter=attr_filter
2184 else if (nopreserve) then
2185  dbafilter_init%attr_filter=cmiss
2186 end if
2187 
2188 if (present(varlist)) then
2189  dbafilter_init%varlist=varlist
2190 else if (nopreserve) then
2191  dbafilter_init%varlist=cmiss
2192 end if
2193 
2194 if (present(starvarlist)) then
2195  dbafilter_init%starvarlist=starvarlist
2196 else if (nopreserve) then
2197  dbafilter_init%starvarlist=cmiss
2198 end if
2199 
2200 if (present(anavarlist)) then
2201  dbafilter_init%anavarlist=anavarlist
2202 else if (nopreserve) then
2203  dbafilter_init%anavarlist=cmiss
2204 end if
2205 
2206 if (present(anastarvarlist)) then
2207  dbafilter_init%anastarvarlist=anastarvarlist
2208 else if (nopreserve) then
2209  dbafilter_init%anastarvarlist=cmiss
2210 end if
2211 
2212 if (present(vars)) then
2213  if (allocated(vars%dcv)) then
2214  allocate(dbafilter_init%vars%dcv(size(vars%dcv)))
2215  do i =1,size(vars%dcv)
2216  allocate(dbafilter_init%vars%dcv(i)%dat,source=vars%dcv(i)%dat)
2217  end do
2219  dbafilter_init%varlist=""
2220  do i=1,size(vars%dcv)
2221  dbafilter_init%varlist=trim(dbafilter_init%varlist)//vars%dcv(i)%dat%btable
2222  if (i /= size(vars%dcv)) dbafilter_init%varlist=trim(dbafilter_init%varlist)//","
2223  end do
2224  endif
2225 end if
2226 
2227 if (present(starvars)) then
2228  if (allocated(starvars%dcv)) then
2229  allocate(dbafilter_init%starvars%dcv(size(starvars%dcv)))
2230  do i =1,size(starvars%dcv)
2231  allocate(dbafilter_init%starvars%dcv(i)%dat,source=starvars%dcv(i)%dat)
2232  end do
2233 
2234  dbafilter_init%starvarlist=""
2235  do i=1,size(starvars%dcv)
2236  dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//starvars%dcv(i)%dat%btable
2237  if (i /= size(starvars%dcv)) dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//","
2238  end do
2239  end if
2240 end if
2241 
2242 
2243 if (present(anavars)) then
2244  if (allocated(anavars%dcv)) then
2245  allocate(dbafilter_init%anavars%dcv(size(anavars%dcv)))
2246  do i =1,size(anavars%dcv)
2247  allocate(dbafilter_init%anavars%dcv(i)%dat,source=anavars%dcv(i)%dat)
2248  end do
2249 
2250  dbafilter_init%anavarlist=""
2251  do i=1,size(anavars%dcv)
2252  dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//anavars%dcv(i)%dat%btable
2253  if (i /= size(anavars%dcv)) dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//","
2254  end do
2255  endif
2256 end if
2257 
2258 if (present(anastarvars)) then
2259  if (allocated(anastarvars%dcv)) then
2260  allocate(dbafilter_init%anastarvars%dcv(size(anastarvars%dcv)))
2261  do i =1,size(anastarvars%dcv)
2262  allocate(dbafilter_init%anastarvars%dcv(i)%dat,source=anastarvars%dcv(i)%dat)
2263  end do
2264 
2265  dbafilter_init%anastarvarlist=""
2266  do i=1,size(anastarvars%dcv)
2267  dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//anastarvars%dcv(i)%dat%btable
2268  if (i /= size(anastarvars%dcv)) dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//","
2269  end do
2270  end if
2271 end if
2272 
2273 if (present(priority)) then
2274  dbafilter_init%priority=priority
2275 else if (nopreserve) then
2276  dbafilter_init%priority=imiss
2277 end if
2278 
2279 if (present(priomin)) then
2280  dbafilter_init%priomin=priomax
2281 else if (nopreserve) then
2282  dbafilter_init%priomin=imiss
2283 end if
2284 
2285 if (present(priomax)) then
2286  dbafilter_init%priomax=priomax
2287 else if (nopreserve) then
2288  dbafilter_init%priomax=imiss
2289 end if
2290 
2291 if (present(contextana)) then
2292  dbafilter_init%contextana=contextana
2293 else if (nopreserve) then
2294  dbafilter_init%contextana=.false.
2295 end if
2296 
2297 if (present(anaonly)) then
2298  dbafilter_init%anaonly=anaonly
2299 else if (nopreserve) then
2300  dbafilter_init%anaonly=.false.
2301 end if
2302 if (present(dataonly)) then
2303  dbafilter_init%dataonly=dataonly
2304 else if (nopreserve) then
2305  dbafilter_init%dataonly=.false.
2306 end if
2307 
2308 if (present(query)) then
2309  dbafilter_init%query=query
2310 else if (nopreserve) then
2311  dbafilter_init%query=cmiss
2312 end if
2313 
2314 end function dbafilter_init
2315 
2317 subroutine dbafilter_display(filter)
2318 class(dbafilter), intent(in) :: filter
2319 
2320 print *,"------------------ filter ---------------"
2321 call filter%ana%display()
2322 call filter%datetime%display()
2323 call filter%level%display()
2324 call filter%timerange%display()
2325 call filter%network%display()
2326 print *, " >>>> minimum:"
2327 call filter%datetimemin%display()
2328 call filter%coordmin%display()
2329 print *, " >>>> maximum:"
2330 call filter%datetimemax%display()
2331 call filter%coordmax%display()
2332 print *, " >>>> vars:"
2333 call filter%vars%display()
2334 print *, " >>>> starvars:"
2335 call filter%starvars%display()
2336 print *, " >>>> anavars:"
2337 call filter%anavars%display()
2338 print *, " >>>> anastarvars:"
2339 call filter%anastarvars%display()
2340 print *,"var=",filter%var
2341 print *,"limit=",filter%limit
2342 print *,"ana_filter=",trim(filter%ana_filter)
2343 print *,"data_filter=",trim(filter%data_filter)
2344 print *,"attr_filter=",trim(filter%attr_filter)
2345 print *,"varlist=",trim(filter%varlist)
2346 print *,"*varlist=",trim(filter%starvarlist)
2347 print *,"anavarlist=",trim(filter%anavarlist)
2348 print *,"ana*varlist=",trim(filter%anastarvarlist)
2349 print *,"priority=",filter%priority
2350 print *,"priomin=",filter%priomin
2351 print *,"priomax=",filter%priomax
2352 print *,"contextana=",filter%contextana
2353 print *,"anaonly=",filter%anaonly
2354 print *,"dataonly=",filter%dataonly
2355 print *,"query=",trim(filter%query)
2356 
2357 print *,"-----------------------------------------"
2358 
2359 end subroutine dbafilter_display
2360 
2362 subroutine dbafilter_set(filter,session)
2363 class(dbafilter), intent(in) :: filter
2364 type(dbasession), intent(in) :: session
2365 
2366 integer :: ier,year,month,day,hour,minute,sec,msec
2367 
2368 call session%unsetall()
2369 
2370 call filter%ana%dbaset(session)
2371 call filter%network%dbaset(session)
2372 ier = idba_set(session%sehandle,"var",filter%var)
2373 
2374 ier = idba_set(session%sehandle,"limit",filter%limit)
2375 ier = idba_set(session%sehandle,"priority",filter%priority)
2376 ier = idba_set(session%sehandle,"priomin",filter%priomin)
2377 ier = idba_set(session%sehandle,"priomax",filter%priomax)
2378 
2379 ier = idba_set(session%sehandle,"latmin",getilat(filter%coordmin%geo_coord))
2380 ier = idba_set(session%sehandle,"lonmin",getilon(filter%coordmin%geo_coord))
2381 ier = idba_set(session%sehandle,"latmax",getilat(filter%coordmax%geo_coord))
2382 ier = idba_set(session%sehandle,"lonmax",getilon(filter%coordmax%geo_coord))
2383 
2384 ier = idba_set(session%sehandle,"ana_filter",filter%ana_filter)
2385 ier = idba_set(session%sehandle,"data_filter",filter%data_filter)
2386 ier = idba_set(session%sehandle,"attr_filter",filter%attr_filter)
2387 
2388 ier = idba_set(session%sehandle,"query",filter%query)
2389 
2390 if (filter%contextana) then
2391 
2392  call session%setcontextana()
2393 
2394  ier = idba_set(session%sehandle,"varlist",filter%anavarlist)
2395  ier = idba_set(session%sehandle,"*varlist",filter%anastarvarlist)
2396 
2397 else
2398 
2399  if (c_e(filter%datetime%datetime)) call filter%datetime%dbaset(session)
2400  if (c_e(filter%level%vol7d_level)) call filter%level%dbaset(session)
2401  if (c_e(filter%timerange%vol7d_timerange)) call filter%timerange%dbaset(session)
2402 
2403  CALL getval(filter%datetimemin%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2404  if (c_e(msec)) then
2405  sec=nint(float(msec)/1000.)
2406  else
2407  sec=imiss
2408  end if
2409 
2410  ier = idba_set(session%sehandle,"yearmin",year)
2411  ier = idba_set(session%sehandle,"monthmin",month)
2412  ier = idba_set(session%sehandle,"daymin",day)
2413  ier = idba_set(session%sehandle,"hourmin",hour)
2414  ier = idba_set(session%sehandle,"minumin",minute)
2415  ier = idba_set(session%sehandle,"secmin",sec)
2416 
2417  CALL getval(filter%datetimemax%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2418 
2419  if (c_e(msec)) then
2420  sec=nint(float(msec)/1000.)
2421  else
2422  sec=imiss
2423  end if
2424 
2425  ier = idba_set(session%sehandle,"yearmax",year)
2426  ier = idba_set(session%sehandle,"monthmax",month)
2427  ier = idba_set(session%sehandle,"daymax",day)
2428  ier = idba_set(session%sehandle,"hourmax",hour)
2429  ier = idba_set(session%sehandle,"minumax",minute)
2430  ier = idba_set(session%sehandle,"secmax",sec)
2431 
2432 
2433  ier = idba_set(session%sehandle,"varlist",filter%varlist)
2434  ier = idba_set(session%sehandle,"*varlist",filter%starvarlist)
2435 end if
2436 
2437 end subroutine dbafilter_set
2438 
2439 
2441 type(dbametadata) function dbametadata_contextana(metadata)
2442 class(dbametadata), intent(in) :: metadata
2443 
2444 type (dbadatetime) :: datetime
2445 type (dbalevel) :: level
2446 type (dbatimerange) :: timerange
2447 
2448 select type(metadata)
2449 type is(dbametadata)
2450  dbametadata_contextana=metadata
2451 end select
2452 
2453 dbametadata_contextana%datetime=datetime%dbacontextana()
2454 dbametadata_contextana%level=level%dbacontextana()
2455 dbametadata_contextana%timerange=timerange%dbacontextana()
2456 
2457 end function dbametadata_contextana
2458 
2459 
2461 subroutine dbametaanddata_display(metaanddata)
2462 class(dbametaanddata), intent(in) :: metaanddata
2463 
2464 call metaanddata%metadata%display()
2465 call metaanddata%dataattrv%display()
2466 
2467 end subroutine dbametaanddata_display
2468 
2470 subroutine dbametaanddata_extrude(metaanddata,session,noattr,filter,attronly,template)
2471 class(dbametaanddata), intent(in) :: metaanddata
2472 type(dbasession), intent(in) :: session
2473 logical, intent(in),optional :: noattr
2474 type(dbafilter),intent(in),optional :: filter
2475 logical, intent(in),optional :: attronly
2476 character(len=*),intent(in),optional :: template
2477 
2478 type(dbafilter) :: myfilter
2479 
2480 !print *,"------------------"
2481 !call metaanddata%display()
2482 !print *,"contextana false"
2483 
2484 myfilter=dbafilter(filter=filter,contextana=.false.)
2485 call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2486 
2487 !print *,"contextana true"
2488 myfilter=dbafilter(filter=filter,contextana=.true.)
2489 call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2490 
2491 contains
2492 
2493 subroutine extrude(metaanddata,session,noattr,filter,attronly,template)
2494 class(dbametaanddata), intent(in) :: metaanddata
2495 type(dbasession), intent(in) :: session
2496 logical, intent(in),optional :: noattr
2497 type(dbafilter),intent(in) :: filter
2498 logical, intent(in),optional :: attronly
2499 character(len=*),intent(in),optional :: template
2500 
2501 if (.not. filter == metaanddata%metadata) return
2502 
2503 call session%unsetall()
2504 !write metadata
2505 call session%set(metadata=metaanddata%metadata)
2506 
2507 !write data and attribute
2508 !call session%extrude(metaanddata%dataattrv,noattr,filter)
2509 call metaanddata%dataattrv%extrude(session,noattr,filter,attronly)
2510 
2511 !to close message on file
2512 call session%close_message(template)
2513 
2514 end subroutine extrude
2515 end subroutine dbametaanddata_extrude
2516 
2517 
2519 subroutine dbametaanddatav_display(metaanddatav)
2520 class(dbametaanddatav), intent(in) :: metaanddatav
2521 
2522 call metaanddatav%metadata%display()
2523 call metaanddatav%datav%display()
2524 
2525 end subroutine dbametaanddatav_display
2526 
2528 subroutine dbametaanddatav_extrude(metaanddatav,session,noattr,filter,template)
2529 class(dbametaanddatav), intent(in) :: metaanddatav
2530 type(dbasession), intent(in) :: session
2531 logical, intent(in),optional :: noattr
2532 type(dbafilter),intent(in),optional :: filter
2533 character(len=*),intent(in),optional :: template
2534 
2535 type(dbafilter) :: myfilter
2536 
2537 myfilter=dbafilter(filter=filter,contextana=.false.)
2538 call extrude(metaanddatav,session,noattr,myfilter,template)
2539 
2540 myfilter=dbafilter(filter=filter,contextana=.true.)
2541 call extrude(metaanddatav,session,noattr,myfilter,template)
2542 
2543 contains
2544 
2545 subroutine extrude(metaanddatav,session,noattr,filter,template)
2546 class(dbametaanddatav), intent(in) :: metaanddatav
2547 type(dbasession), intent(in) :: session
2548 logical, intent(in),optional :: noattr
2549 type(dbafilter),intent(in) :: filter
2550 character(len=*),intent(in),optional :: template
2551 
2552 if (.not. filter == metaanddatav%metadata)return
2553 !write metadata
2554 call session%set(metadata=metaanddatav%metadata)
2555 
2556 !write ana data and attribute
2557 !!$call session%set(datav=metaanddatav%datav)
2558 call metaanddatav%datav%extrude(session,noattr,filter,template)
2559 
2560 print*,"dbaana_metaanddatav"
2561 !to close message on file
2562 call session%close_message(template)
2563 
2564 end subroutine extrude
2565 end subroutine dbametaanddatav_extrude
2566 
2567 
2569 subroutine dbametaanddatal_extrude(metaanddatal,session,noattr,filter,attronly,template)
2570 class(dbametaanddatalist), intent(inout) :: metaanddatal
2571 class(dbasession), intent(in) :: session
2572 logical, intent(in),optional :: noattr
2573 type(dbafilter),intent(in),optional :: filter
2574 type(dbametaanddata) :: metaanddata
2575 logical, intent(in),optional :: attronly
2576 character(len=*),intent(in),optional :: template
2577 
2578 call metaanddatal%rewind()
2579 do while(metaanddatal%element())
2580  !call session%extrude(metaanddatal%current(),noattr,filter)
2581  metaanddata=metaanddatal%current()
2582  call metaanddata%extrude(session,noattr,filter,attronly,template)
2583  call metaanddatal%next()
2584 end do
2585 
2586 end subroutine dbametaanddatal_extrude
2587 
2588 
2590 subroutine displaydbametaanddatai(this)
2591 class(dbametaanddatailist),intent(inout) :: this
2592 type(dbametaanddatai) :: element
2593 
2594 call this%rewind()
2595 do while(this%element())
2596  print *,"index:",this%currentindex()," value:"
2597  element=this%current()
2598  call element%display()
2599  call this%next()
2600 end do
2601 end subroutine displaydbametaanddatai
2602 
2604 type(dbametaanddatai) function currentdbametaanddatai(this)
2605 class(dbametaanddatailist) :: this
2606 class(*), pointer :: v
2607 
2608 v => this%currentpoli()
2609 select type(v)
2610 type is (dbametaanddatai)
2611  currentdbametaanddatai = v
2612 end select
2613 end function currentdbametaanddatai
2614 
2615 
2617 subroutine dbasession_ingest_metaanddatail(session,metaanddatal,filter)
2618 class(dbasession), intent(inout) :: session
2619 type(dbametaanddatailist), intent(inout) :: metaanddatal
2620 type(dbafilter),intent(in),optional :: filter
2621 
2622 type(dbametaanddatai) :: element
2623 
2624 
2625 if (session%memdb .and. .not. session%loadfile)then
2626 
2627  do while (session%messages_read_next())
2628  call session%set(filter=filter)
2629  call session%ingest_metaanddatai()
2630  call session%ingest_metaanddatai(element)
2631  call metaanddatal%append(element)
2632  call session%remove_all()
2633  end do
2634 
2635 else
2636 
2637  call session%set(filter=filter)
2638  call session%ingest_metaanddatai()
2639  do while (c_e(session%count) .and. session%count >0)
2640  call session%ingest_metaanddatai(element)
2641  call metaanddatal%append(element)
2642  if (session%file) call session%ingest()
2643  end do
2644 
2645 end if
2646 
2647 end subroutine dbasession_ingest_metaanddatail
2648 
2650 function toarray_dbametaanddatai(this)
2651 type(dbametaanddatai),allocatable :: toarray_dbametaanddatai(:)
2652 class(dbametaanddatailist) :: this
2653 
2654 integer :: i
2656 allocate (toarray_dbametaanddatai(this%countelements()))
2657 
2658 call this%rewind()
2659 i=0
2660 do while(this%element())
2661  i=i+1
2662  toarray_dbametaanddatai(i) =this%current()
2663  call this%next()
2664 end do
2665 end function toarray_dbametaanddatai
2666 
2667 
2669 subroutine displaydbametaanddatar(this)
2670 class(dbametaanddatarlist),intent(inout) :: this
2671 type(dbametaanddatar) :: element
2672 
2673 call this%rewind()
2674 do while(this%element())
2675  print *,"index:",this%currentindex()," value:"
2676  element=this%current()
2677  call element%display()
2678  call this%next()
2679 end do
2680 end subroutine displaydbametaanddatar
2681 
2683 type(dbametaanddatar) function currentdbametaanddatar(this)
2684 class(dbametaanddatarlist) :: this
2685 class(*), pointer :: v
2686 
2687 v => this%currentpoli()
2688 select type(v)
2689 type is (dbametaanddatar)
2690  currentdbametaanddatar = v
2691 end select
2692 end function currentdbametaanddatar
2693 
2694 
2696 subroutine dbasession_ingest_metaanddatarl(session,metaanddatal,filter)
2697 class(dbasession), intent(inout) :: session
2698 type(dbametaanddatarlist), intent(inout) :: metaanddatal
2699 type(dbafilter),intent(in),optional :: filter
2700 
2701 type(dbametaanddatar) :: element
2702 
2703 if (session%memdb .and. .not. session%loadfile)then
2704 
2705  do while (session%messages_read_next())
2706  call session%set(filter=filter)
2707  call session%ingest_metaanddatar()
2708  call session%ingest_metaanddatar(element)
2709  call metaanddatal%append(element)
2710  call session%remove_all()
2711  end do
2712 
2713 else
2714 
2715  call session%set(filter=filter)
2716  call session%ingest_metaanddatar()
2717  do while (c_e(session%count) .and. session%count >0)
2718  call session%ingest_metaanddatar(element)
2719  call metaanddatal%append(element)
2720  if (session%file) call session%ingest()
2721  end do
2723 end if
2724 
2725 
2726 end subroutine dbasession_ingest_metaanddatarl
2727 
2728 
2730 function toarray_dbametaanddatar(this)
2731 type(dbametaanddatar),allocatable :: toarray_dbametaanddatar(:)
2732 class(dbametaanddatarlist) :: this
2733 
2734 integer :: i
2735 i=this%countelements()
2736 !print *, "allocate:",i
2737 allocate (toarray_dbametaanddatar(this%countelements()))
2738 
2739 call this%rewind()
2740 i=0
2741 do while(this%element())
2742  i=i+1
2743  toarray_dbametaanddatar(i) =this%current()
2744  call this%next()
2745 end do
2746 end function toarray_dbametaanddatar
2747 
2748 
2750 subroutine displaydbametaanddatad(this)
2751 class(dbametaanddatadlist),intent(inout) :: this
2752 type(dbametaanddatad) :: element
2753 
2754 call this%rewind()
2755 do while(this%element())
2756  print *,"index:",this%currentindex()," value:"
2757  element=this%current()
2758  call element%display()
2759  call this%next()
2760 end do
2761 end subroutine displaydbametaanddatad
2762 
2764 type(dbametaanddatad) function currentdbametaanddatad(this)
2765 class(dbametaanddatadlist) :: this
2766 class(*), pointer :: v
2767 
2768 v => this%currentpoli()
2769 select type(v)
2770 type is (dbametaanddatad)
2771  currentdbametaanddatad = v
2772 end select
2773 end function currentdbametaanddatad
2774 
2776 subroutine dbasession_ingest_metaanddatadl(session,metaanddatal,filter)
2777 class(dbasession), intent(inout) :: session
2778 type(dbametaanddatadlist), intent(inout) :: metaanddatal
2779 type(dbafilter),intent(in),optional :: filter
2780 
2781 type(dbametaanddatad) :: element
2782 
2783 if (session%memdb .and. .not. session%loadfile)then
2785  do while (session%messages_read_next())
2786  call session%set(filter=filter)
2787  call session%ingest_metaanddatad()
2788  call session%ingest_metaanddatad(element)
2789  call metaanddatal%append(element)
2790  call session%remove_all()
2791  end do
2792 
2793 else
2794 
2795  call session%set(filter=filter)
2796  call session%ingest_metaanddatad()
2797  do while (c_e(session%count) .and. session%count >0)
2798  call session%ingest_metaanddatad(element)
2799  call metaanddatal%append(element)
2800  if (session%file) call session%ingest()
2801  end do
2802 
2803 end if
2804 
2805 end subroutine dbasession_ingest_metaanddatadl
2806 
2807 
2809 function toarray_dbametaanddatad(this)
2810 type(dbametaanddatad),allocatable :: toarray_dbametaanddatad(:)
2811 class(dbametaanddatadlist) :: this
2812 
2813 integer :: i
2814 
2815 allocate (toarray_dbametaanddatad(this%countelements()))
2816 
2817 call this%rewind()
2818 i=0
2819 do while(this%element())
2820  i=i+1
2821  toarray_dbametaanddatad(i) =this%current()
2822  call this%next()
2823 end do
2824 end function toarray_dbametaanddatad
2825 
2826 
2828 subroutine displaydbametaanddatab(this)
2829 class(dbametaanddatablist),intent(inout) :: this
2830 type(dbametaanddatab) :: element
2831 
2832 call this%rewind()
2833 do while(this%element())
2834  print *,"index:",this%currentindex()," value:"
2835  element=this%current()
2836  call element%display()
2837  call this%next()
2838 end do
2839 end subroutine displaydbametaanddatab
2840 
2842 type(dbametaanddatab) function currentdbametaanddatab(this)
2843 class(dbametaanddatablist) :: this
2844 class(*), pointer :: v
2845 
2846 v => this%currentpoli()
2847 select type(v)
2848 type is (dbametaanddatab)
2849  currentdbametaanddatab = v
2850 end select
2851 end function currentdbametaanddatab
2852 
2853 
2855 subroutine dbasession_ingest_metaanddatabl(session,metaanddatal,filter)
2856 class(dbasession), intent(inout) :: session
2857 type(dbametaanddatablist), intent(inout) :: metaanddatal
2858 type(dbafilter),intent(in),optional :: filter
2859 
2860 type(dbametaanddatab) :: element
2861 
2862 if (session%memdb .and. .not. session%loadfile)then
2864  do while (session%messages_read_next())
2865  call session%set(filter=filter)
2866  call session%ingest_metaanddatab()
2867  call session%ingest_metaanddatab(element)
2868  call metaanddatal%append(element)
2869  call session%remove_all()
2870  end do
2871 
2872 else
2873 
2874  call session%set(filter=filter)
2875  call session%ingest_metaanddatab()
2876  do while (c_e(session%count) .and. session%count >0)
2877  call session%ingest_metaanddatab(element)
2878  call metaanddatal%append(element)
2879  if (session%file) call session%ingest()
2880  end do
2881 
2882 end if
2883 
2884 end subroutine dbasession_ingest_metaanddatabl
2885 
2886 
2888 function toarray_dbametaanddatab(this)
2889 type(dbametaanddatab),allocatable :: toarray_dbametaanddatab(:)
2890 class(dbametaanddatablist) :: this
2891 
2892 integer :: i
2893 
2894 allocate (toarray_dbametaanddatab(this%countelements()))
2895 
2896 call this%rewind()
2897 i=0
2898 do while(this%element())
2899  i=i+1
2900  toarray_dbametaanddatab(i) =this%current()
2901  call this%next()
2902 end do
2903 end function toarray_dbametaanddatab
2904 
2905 
2907 subroutine displaydbametaanddatac(this)
2908 class(dbametaanddataclist),intent(inout) :: this
2909 type(dbametaanddatac) :: element
2910 
2911 call this%rewind()
2912 do while(this%element())
2913  print *,"index:",this%currentindex()," value:"
2914  element=this%current()
2915  call element%display()
2916  call this%next()
2917 end do
2918 end subroutine displaydbametaanddatac
2919 
2921 type(dbametaanddatac) function currentdbametaanddatac(this)
2922 class(dbametaanddataclist) :: this
2923 class(*), pointer :: v
2925 v => this%currentpoli()
2926 select type(v)
2927 type is (dbametaanddatac)
2928  currentdbametaanddatac = v
2929 end select
2930 end function currentdbametaanddatac
2931 
2932 
2934 subroutine dbasession_ingest_metaanddatacl(session,metaanddatal,filter)
2935 class(dbasession), intent(inout) :: session
2936 type(dbametaanddataclist), intent(inout) :: metaanddatal
2937 type(dbafilter),intent(in),optional :: filter
2938 
2939 type(dbametaanddatac) :: element
2940 
2941 if (session%memdb .and. .not. session%loadfile)then
2942 
2943  do while (session%messages_read_next())
2944  call session%set(filter=filter)
2945  call session%ingest_metaanddatac()
2946  call session%ingest_metaanddatac(element)
2947  call metaanddatal%append(element)
2948  call session%remove_all()
2949  end do
2950 
2951 else
2952 
2953  call session%set(filter=filter)
2954  call session%ingest_metaanddatac()
2955  do while (c_e(session%count) .and. session%count >0)
2956  call session%ingest_metaanddatac(element)
2957  call metaanddatal%append(element)
2958  if (session%file) call session%ingest()
2959  end do
2960 
2961 end if
2962 
2963 end subroutine dbasession_ingest_metaanddatacl
2964 
2965 
2967 function toarray_dbametaanddatac(this)
2968 type(dbametaanddatac),allocatable :: toarray_dbametaanddatac(:)
2969 class(dbametaanddataclist) :: this
2971 integer :: i
2972 
2973 allocate (toarray_dbametaanddatac(this%countelements()))
2974 
2975 call this%rewind()
2976 i=0
2977 do while(this%element())
2978  i=i+1
2979  toarray_dbametaanddatac(i) =this%current()
2980  call this%next()
2981 end do
2982 end function toarray_dbametaanddatac
2983 
2984 
2986 subroutine dbametaanddatai_display(data)
2987 class(dbametaanddatai), intent(in) :: data
2988 
2989 call data%metadata%display()
2990 call data%dbadatai%display()
2991 
2992 end subroutine dbametaanddatai_display
2993 
2995 subroutine dbametaanddatab_display(data)
2996 class(dbametaanddatab), intent(in) :: data
2997 
2998 call data%metadata%display()
2999 call data%dbadatab%display()
3000 
3001 end subroutine dbametaanddatab_display
3002 
3004 subroutine dbametaanddatad_display(data)
3005 class(dbametaanddatad), intent(in) :: data
3006 
3007 call data%metadata%display()
3008 call data%dbadatad%display()
3009 
3010 end subroutine dbametaanddatad_display
3011 
3013 subroutine dbametaanddatar_display(data)
3014 class(dbametaanddatar), intent(in) :: data
3015 
3016 call data%metadata%display()
3017 call data%dbadatar%display()
3018 
3019 end subroutine dbametaanddatar_display
3020 
3021 
3023 subroutine dbametaanddatac_display(data)
3024 class(dbametaanddatac), intent(in) :: data
3025 
3026 call data%metadata%display()
3027 call data%dbadatac%display()
3028 
3029 end subroutine dbametaanddatac_display
3030 
3031 
3033 subroutine dbametaanddatai_extrude(metaanddatai,session)
3034 class(dbametaanddatai), intent(in) :: metaanddatai
3035 type(dbasession), intent(in) :: session
3037 call session%unsetall()
3038 !write metadata
3039 call session%set(metadata=metaanddatai%metadata)
3040 !write ana data and attribute
3041 call session%set(data=metaanddatai%dbadatai)
3042 
3043 if (metaanddatai%dbadatai%c_e()) then
3044  call session%prendilo()
3045 else
3046  call session%dimenticami()
3047 endif
3048 
3049 end subroutine dbametaanddatai_extrude
3050 
3052 subroutine dbametaanddatab_extrude(metaanddatab,session)
3053 class(dbametaanddatab), intent(in) :: metaanddatab
3054 type(dbasession), intent(in) :: session
3055 
3056 call session%unsetall()
3057 !write metadata
3058 call session%set(metadata=metaanddatab%metadata)
3059 !write ana data and attribute
3060 call session%set(data=metaanddatab%dbadatab)
3061 
3062 if (metaanddatab%dbadatab%c_e()) then
3063  call session%prendilo()
3064 else
3065  call session%dimenticami()
3066 endif
3067 
3068 end subroutine dbametaanddatab_extrude
3069 
3071 subroutine dbametaanddatad_extrude(metaanddatad,session)
3072 class(dbametaanddatad), intent(in) :: metaanddatad
3073 type(dbasession), intent(in) :: session
3074 
3075 call session%unsetall()
3076 !write metadata
3077 call session%set(metadata=metaanddatad%metadata)
3078 !write ana data and attribute
3079 call session%set(data=metaanddatad%dbadatad)
3080 
3081 if (metaanddatad%dbadatad%c_e()) then
3082  call session%prendilo()
3083 else
3084  call session%dimenticami()
3085 endif
3086 
3087 end subroutine dbametaanddatad_extrude
3088 
3090 subroutine dbametaanddatar_extrude(metaanddatar,session)
3091 class(dbametaanddatar), intent(in) :: metaanddatar
3092 type(dbasession), intent(in) :: session
3093 
3094 call session%unsetall()
3095 !write metadata
3096 call session%set(metadata=metaanddatar%metadata)
3097 !write ana data and attribute
3098 call session%set(data=metaanddatar%dbadatar)
3099 
3100 if (metaanddatar%dbadatar%c_e()) then
3101  call session%prendilo()
3102 else
3103  call session%dimenticami()
3104 endif
3105 
3106 end subroutine dbametaanddatar_extrude
3107 
3109 subroutine dbametaanddatac_extrude(metaanddatac,session)
3110 class(dbametaanddatac), intent(in) :: metaanddatac
3111 type(dbasession), intent(in) :: session
3112 
3113 call session%unsetall()
3114 !write metadata
3115 call session%set(metadata=metaanddatac%metadata)
3116 !write ana data and attribute
3117 call session%set(data=metaanddatac%dbadatac)
3118 
3119 if (metaanddatac%dbadatac%c_e()) then
3120  call session%prendilo()
3121 else
3122  call session%dimenticami()
3123 endif
3124 
3125 end subroutine dbametaanddatac_extrude
3126 
3128 subroutine dbasession_ingest_ana(session,ana)
3129 class(dbasession), intent(inout) :: session
3130 type(dbaana), intent(out),optional :: ana
3131 
3132 integer :: ier
3133 
3134 if (.not. present(ana)) then
3135  ier = idba_quantesono(session%sehandle, session%count)
3136  !print *,"numero ana",session%count
3137 else
3138  ier = idba_elencamele(session%sehandle)
3139  call ana%dbaenq(session)
3140  session%count=session%count-1
3141 end if
3142 
3143 end subroutine dbasession_ingest_ana
3144 
3145 
3147 subroutine dbasession_ingest_anav(session,anav)
3148 class(dbasession), intent(inout) :: session
3149 type(dbaana), intent(out),allocatable :: anav(:)
3150 integer :: i
3151 
3152 call session%ingest_ana()
3153 
3154 if (c_e(session%count)) then
3155  allocate(anav(session%count))
3156  i=0
3157  do while (session%count >0)
3158  i=i+1
3159  call session%ingest_ana(anav(i))
3160  end do
3161 else
3162  allocate(anav(0))
3163 end if
3164 
3165 end subroutine dbasession_ingest_anav
3166 
3167 
3169 subroutine dbasession_ingest_anal(session,anal)
3170 class(dbasession), intent(inout) :: session
3171 type(dbaanalist), intent(out) :: anal
3172 type(dbaana) :: element
3173 
3174 call session%ingest_ana()
3175 do while (c_e(session%count) .and. session%count >0)
3176  call session%ingest_ana(element)
3177  call anal%append(element)
3178  call session%ingest_ana()
3179 end do
3180 end subroutine dbasession_ingest_anal
3181 
3182 
3184 subroutine dbasession_ingest_metaanddata(session,metaanddata,noattr,filter)
3185 class(dbasession), intent(inout) :: session
3186 type(dbametaanddata), intent(inout),optional :: metaanddata
3187 logical,intent(in),optional :: noattr
3188 type(dbafilter),intent(in),optional :: filter
3190 type(dbametadata) :: metadata
3191 integer :: ier,acount,i,j,k
3192 character(len=9) :: btable
3193 character(255) :: value
3194 logical :: lvars,lstarvars
3195 type(dbadcv) :: vars,starvars
3196 
3197 
3198  ! if you do not pass metaanddata we presume to have to initialize the query
3199 if (.not. present(metaanddata)) then
3200  ier = idba_voglioquesto(session%sehandle, session%count)
3201 
3202  ! preroll one read because after I have to read one more to check metadata
3203  if (c_e(session%count) .and. session%count > 0) then
3204  ier = idba_dammelo(session%sehandle, btable)
3205  end if
3206 
3207 else
3208 
3209  ! you pass metaanddata so we continue with the query
3210 
3211  if (allocated(metaanddata%dataattrv%dataattr)) then
3212  deallocate (metaanddata%dataattrv%dataattr)
3213  end if
3214 
3215  lvars=.false.
3216  lstarvars=.false.
3217  if (present(filter)) then
3218 
3219  if (filter%contextana) then
3220 
3221  !todo try to use this: vars=filter%anavars
3222  if (allocated(filter%anavars%dcv)) then
3223  lvars=.true.
3224  allocate(vars%dcv(size(filter%anavars%dcv)))
3225  do i =1,size(filter%anavars%dcv)
3226  allocate(vars%dcv(i)%dat,source=filter%anavars%dcv(i)%dat)
3227  end do
3228  end if
3229 
3230  if (allocated(filter%anastarvars%dcv)) then
3231  lstarvars=.true.
3232  allocate(starvars%dcv(size(filter%anastarvars%dcv)))
3233  do i =1,size(filter%anastarvars%dcv)
3234  allocate(starvars%dcv(i)%dat,source=filter%anastarvars%dcv(i)%dat)
3235  end do
3236  end if
3237 
3238  else
3239 
3240  if (allocated(filter%vars%dcv)) then
3241  lvars=.true.
3242  allocate(vars%dcv(size(filter%vars%dcv)))
3243  do i =1,size(filter%vars%dcv)
3244  allocate(vars%dcv(i)%dat,source=filter%vars%dcv(i)%dat)
3245  end do
3246  end if
3247 
3248  if (allocated(filter%starvars%dcv)) then
3249  lstarvars=.true.
3250  allocate(starvars%dcv(size(filter%starvars%dcv)))
3251  do i =1,size(filter%starvars%dcv)
3252  allocate(starvars%dcv(i)%dat,source=filter%starvars%dcv(i)%dat)
3253  end do
3254  end if
3255 
3256  end if
3257 
3258  end if
3259 
3260  if (lvars) then
3261 
3262  ! create an empty vector for data
3263  allocate (metaanddata%dataattrv%dataattr(size(vars%dcv)))
3264  do i = 1, size(vars%dcv)
3265  allocate (metaanddata%dataattrv%dataattr(i)%dat,source=vars%dcv(i)%dat)
3266  end do
3267 
3268  ! load metadata
3269  call metaanddata%metadata%dbaenq(session)
3270  ! load curret metadata
3271  call metadata%dbaenq(session)
3272 
3273  ! if current metadata is equal to metadata
3274  do while ( metaanddata%metadata == metadata )
3275  ier = idba_enq(session%sehandle,"var",btable)
3276  do i=1,size(metaanddata%dataattrv%dataattr)
3277  if (metaanddata%dataattrv%dataattr(i)%dat%btable == btable) then
3278 
3279  select type ( dat => metaanddata%dataattrv%dataattr(i)%dat )
3280  type is (dbadatai)
3281  ier = idba_enq(session%sehandle, btable,dat%value)
3282  type is (dbadatar)
3283  ier = idba_enq(session%sehandle, btable,dat%value)
3284  type is (dbadatad)
3285  ier = idba_enq(session%sehandle, btable,dat%value)
3286  type is (dbadatab)
3287  ier = idba_enq(session%sehandle, btable,dat%value)
3288  type is (dbadatac)
3289  ier = idba_enq(session%sehandle, btable,dat%value)
3290  end select
3291 
3292  if (optio_log(noattr))then
3293  ! initialize to (0) the attribute vector
3294  allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3295 
3296  else
3297 
3298  if (lstarvars) then
3299 
3300  allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(size(starvars%dcv)))
3301  do j = 1, size(starvars%dcv)
3302  allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
3303  end do
3304 
3305  if (c_e(session%count) .and. session%count > 0) then
3306 
3307  ier = idba_voglioancora(session%sehandle, acount)
3308  do k =1,acount
3309  ier = idba_ancora(session%sehandle, btable)
3310  ier = idba_enq(session%sehandle, btable,value)
3311 
3312  do j=1,size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
3313 
3314  if (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat%btable == btable) then
3315 
3316  select type ( dat => metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat )
3317  type is (dbadatai)
3318  ier = idba_enq(session%sehandle, btable,dat%value)
3319  type is (dbadatar)
3320  ier = idba_enq(session%sehandle, btable,dat%value)
3321  type is (dbadatad)
3322  ier = idba_enq(session%sehandle, btable,dat%value)
3323  type is (dbadatab)
3324  ier = idba_enq(session%sehandle, btable,dat%value)
3325  type is (dbadatac)
3326  ier = idba_enq(session%sehandle, btable,dat%value)
3327  end select
3328 
3329  end if
3330  end do
3331  end do
3332  end if
3333  else
3334  if (c_e(session%count) .and. session%count > 0) then
3335  ier = idba_voglioancora(session%sehandle, acount)
3336 
3337  allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(acount))
3338  do j =1,acount
3339  ier = idba_ancora(session%sehandle, btable)
3340  ier = idba_enq(session%sehandle, btable,value)
3341  allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatac(btable,value))
3342  end do
3343  else
3344  allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3345  end if
3346  end if
3347  end if
3348  end if
3349  end do
3350 
3351  if (c_e(session%count)) session%count=session%count-1
3352 
3353  if (c_e(session%count) .and. session%count > 0 ) then
3354  ier = idba_dammelo(session%sehandle, btable)
3355  call metadata%dbaenq(session)
3356  else
3357  metadata=dbametadata()
3358  end if
3359  end do
3360  else
3361 
3362  allocate (metaanddata%dataattrv%dataattr(1))
3363  ier = idba_enq(session%sehandle,"var",btable)
3364  ier = idba_enq(session%sehandle, btable,value)
3365  allocate (metaanddata%dataattrv%dataattr(1)%dat,source=dbadatac(btable,value))
3366  call metaanddata%metadata%dbaenq(session)
3367 
3368 
3369  if (optio_log(noattr))then
3370 
3371  allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
3372 
3373  else
3374 
3375  if (lstarvars) then
3376 
3377  allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(size(starvars%dcv)))
3378  do j = 1, size(starvars%dcv)
3379  allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
3380  end do
3381 
3382  if (c_e(session%count) .and. session%count > 0) then
3383 
3384  ier = idba_voglioancora(session%sehandle, acount)
3385  do k =1,acount
3386  ier = idba_ancora(session%sehandle, btable)
3387  ier = idba_enq(session%sehandle, btable,value)
3388 
3389  do j=1,size(metaanddata%dataattrv%dataattr(1)%attrv%dcv)
3390 
3391  if (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat%btable == btable) then
3392 
3393  select type ( dat => metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat )
3394  type is (dbadatai)
3395  ier = idba_enq(session%sehandle, btable,dat%value)
3396  type is (dbadatar)
3397  ier = idba_enq(session%sehandle, btable,dat%value)
3398  type is (dbadatad)
3399  ier = idba_enq(session%sehandle, btable,dat%value)
3400  type is (dbadatab)
3401  ier = idba_enq(session%sehandle, btable,dat%value)
3402  type is (dbadatac)
3403  ier = idba_enq(session%sehandle, btable,dat%value)
3404  end select
3405 
3406  end if
3407  end do
3408  end do
3409  end if
3410  else
3411  if (c_e(session%count) .and. session%count > 0) then
3412  ier = idba_voglioancora(session%sehandle, acount)
3413 
3414  allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(acount))
3415  do j =1,acount
3416  ier = idba_ancora(session%sehandle, btable)
3417  ier = idba_enq(session%sehandle, btable,value)
3418  allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=dbadatac(btable,value))
3419  end do
3420  else
3421  allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
3422  end if
3423  end if
3424  end if
3425 
3426  if (c_e(session%count)) then
3427  session%count=session%count-1
3428 
3429  if (session%count > 0 ) then
3430  ier = idba_dammelo(session%sehandle, btable)
3431  end if
3432  end if
3433  end if
3434 !!$ SOLVED by https://github.com/ARPA-SIMC/dballe/issues/73
3435 !!$ !reading from file get some variable not in filter so we can have some attrv%dcv not allocated
3436  do i=1,size(metaanddata%dataattrv%dataattr)
3437  if (.not.allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv)) then
3438  allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3439  endif
3440  end do
3441 
3442 end if
3443 
3444 end subroutine dbasession_ingest_metaanddata
3445 
3446 
3448 subroutine dbasession_ingest_metaanddatav(session,metaanddatav,noattr,filter)
3449 class(dbasession), intent(inout) :: session
3450 type(dbametaanddata), intent(inout),allocatable :: metaanddatav(:)
3451 logical, intent(in),optional :: noattr
3452 type(dbafilter),intent(in),optional :: filter
3453 
3454 type(dbametaanddata),allocatable :: metaanddatavbuf(:)
3455 integer :: i
3456 
3457 !todo aggiungere anche altrove dove passato filter
3458 if (present(filter)) then
3459  call filter%dbaset(session)
3460 else
3461  call session%unsetall()
3462 endif
3463 
3464 call session%ingest()
3465 !print*," count: ",session%count
3466 
3467 if (c_e(session%count)) then
3468  ! allocate to max dimension
3469  allocate(metaanddatavbuf(session%count))
3470  i=0
3471  do while (session%count >0)
3472  i=i+1
3473  call session%ingest(metaanddatavbuf(i),noattr=noattr,filter=filter)
3474  end do
3475 
3476 ! compact data to real dimension
3477  IF (SIZE(metaanddatavbuf) == i) THEN
3478 ! space/time optimization in common case of no filter
3479  CALL move_alloc(metaanddatavbuf, metaanddatav)
3480  ELSE
3481 ! allocate (metaanddatav(i))
3482  metaanddatav=metaanddatavbuf(:i)
3483  DEALLOCATE(metaanddatavbuf)
3484  ENDIF
3485 
3486 else
3487  if (allocated(metaanddatav)) deallocate(metaanddatav)
3488  allocate(metaanddatav(0))
3489 end if
3490 
3491 
3492 end subroutine dbasession_ingest_metaanddatav
3493 
3494 
3496 subroutine dbasession_ingest_metaanddatal(session,metaanddatal,noattr,filter)
3497 class(dbasession), intent(inout) :: session
3498 type(dbametaanddatalist), intent(out) :: metaanddatal
3499 logical, intent(in),optional :: noattr
3500 type(dbafilter),intent(in),optional :: filter
3501 
3502 type(dbametaanddata),allocatable :: metaanddatavbuf(:)
3503 integer :: i
3504 
3505 if (session%memdb .and. .not. session%loadfile)then
3506 
3507  do while (session%messages_read_next())
3508  call session%set(filter=filter)
3509  call session%ingest()
3510  call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
3511  do i=1,size(metaanddatavbuf)
3512  call metaanddatal%append(metaanddatavbuf(i))
3513  end do
3514 
3515  call session%remove_all()
3516  deallocate (metaanddatavbuf)
3517  end do
3518 
3519 else
3520 
3521  call session%ingest()
3522 
3523  do while (c_e(session%count) .and. session%count >0)
3524  call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
3525  do i=1,size(metaanddatavbuf)
3526  if (present(filter)) then
3527  ! exclude contextana data from file
3528  if (filter%contextana) then
3529  if (datetime_new() /= metaanddatavbuf(i)%metadata%datetime%datetime) cycle
3530  end if
3531  end if
3532  call metaanddatal%append(metaanddatavbuf(i))
3533  end do
3534  if (session%file) call session%ingest()
3535  deallocate (metaanddatavbuf)
3536  end do
3537 end if
3538 
3539 end subroutine dbasession_ingest_metaanddatal
3540 
3542 subroutine dbasession_ingest_metaanddatai(session,metaanddata)
3543 class(dbasession), intent(inout) :: session
3544 type(dbametaanddatai), intent(inout),optional :: metaanddata
3545 
3546 integer :: ier
3547 character(len=9) :: btable
3548 integer :: value
3549 
3550 if (.not. present(metaanddata)) then
3551  ier = idba_voglioquesto(session%sehandle, session%count)
3552 else
3553  ier = idba_dammelo(session%sehandle, btable)
3554  ier = idba_enq(session%sehandle, btable,value)
3555  metaanddata%dbadatai=dbadatai(btable,value)
3556  call metaanddata%metadata%dbaenq(session)
3557  session%count=session%count-1
3558 end if
3559 end subroutine dbasession_ingest_metaanddatai
3560 
3561 
3563 subroutine dbasession_ingest_metaanddataiv(session,metaanddatav)
3564 class(dbasession), intent(inout) :: session
3565 type(dbametaanddatai), intent(inout),allocatable :: metaanddatav(:)
3566 
3567 integer :: i
3568 
3569 call session%ingest_metaanddatai()
3570 if (c_e(session%count)) then
3571  allocate(metaanddatav(session%count))
3572  i=0
3573  do while (session%count >0)
3574  i=i+1
3575  call session%ingest_metaanddatai(metaanddatav(i))
3576  end do
3577 else
3578  allocate(metaanddatav(0))
3579 end if
3580 
3581 end subroutine dbasession_ingest_metaanddataiv
3582 
3583 
3585 subroutine dbasession_ingest_metaanddatab(session,metaanddata)
3586 class(dbasession), intent(inout) :: session
3587 type(dbametaanddatab), intent(inout),optional :: metaanddata
3588 
3589 integer :: ier
3590 character(len=9) :: btable
3591 integer(kind=int_b) :: value
3592 
3593 if (.not. present(metaanddata)) then
3594  ier = idba_voglioquesto(session%sehandle, session%count)
3595 else
3596  ier = idba_dammelo(session%sehandle, btable)
3597  ier = idba_enq(session%sehandle, btable,value)
3598  metaanddata%dbadatab=dbadatab(btable,value)
3599  call metaanddata%metadata%dbaenq(session)
3600  session%count=session%count-1
3601 end if
3602 end subroutine dbasession_ingest_metaanddatab
3603 
3604 
3606 subroutine dbasession_ingest_metaanddatabv(session,metaanddatav)
3607 class(dbasession), intent(inout) :: session
3608 type(dbametaanddatab), intent(inout),allocatable :: metaanddatav(:)
3609 
3610 integer :: i
3611 
3612 call session%ingest_metaanddatab()
3613 if (c_e(session%count)) then
3614  allocate(metaanddatav(session%count))
3615  i=0
3616  do while (session%count >0)
3617  i=i+1
3618  call session%ingest_metaanddatab(metaanddatav(i))
3619  end do
3620 else
3621  allocate(metaanddatav(0))
3622 end if
3623 
3624 end subroutine dbasession_ingest_metaanddatabv
3625 
3626 
3628 subroutine dbasession_ingest_metaanddatad(session,metaanddata)
3629 class(dbasession), intent(inout) :: session
3630 type(dbametaanddatad), intent(inout),optional :: metaanddata
3631 
3632 integer :: ier
3633 character(len=9) :: btable
3634 doubleprecision :: value
3635 
3636 if (.not. present(metaanddata)) then
3637  ier = idba_voglioquesto(session%sehandle, session%count)
3638 else
3639  ier = idba_dammelo(session%sehandle, btable)
3640  ier = idba_enq(session%sehandle, btable,value)
3641  metaanddata%dbadatad=dbadatad(btable,value)
3642  call metaanddata%metadata%dbaenq(session)
3643  session%count=session%count-1
3644 end if
3645 end subroutine dbasession_ingest_metaanddatad
3646 
3647 
3649 subroutine dbasession_ingest_metaanddatadv(session,metaanddatav)
3650 class(dbasession), intent(inout) :: session
3651 type(dbametaanddatad), intent(inout),allocatable :: metaanddatav(:)
3652 
3653 integer :: i
3654 
3655 call session%ingest_metaanddatad()
3656 if (c_e(session%count)) then
3657  allocate(metaanddatav(session%count))
3658  i=0
3659  do while (session%count >0)
3660  i=i+1
3661  call session%ingest_metaanddatad(metaanddatav(i))
3662  end do
3663 else
3664  allocate(metaanddatav(0))
3665 end if
3666 end subroutine dbasession_ingest_metaanddatadv
3667 
3668 
3670 subroutine dbasession_ingest_metaanddatar(session,metaanddata)
3671 class(dbasession), intent(inout) :: session
3672 type(dbametaanddatar), intent(inout),optional :: metaanddata
3673 
3674 integer :: ier
3675 character(len=9) :: btable
3676 real :: value
3677 
3678 if (.not. present(metaanddata)) then
3679  ier = idba_voglioquesto(session%sehandle, session%count)
3680 else
3681  ier = idba_dammelo(session%sehandle, btable)
3682  ier = idba_enq(session%sehandle, btable,value)
3683  metaanddata%dbadatar=dbadatar(btable,value)
3684  call metaanddata%metadata%dbaenq(session)
3685  session%count=session%count-1
3686 end if
3687 end subroutine dbasession_ingest_metaanddatar
3688 
3689 
3691 subroutine dbasession_ingest_metaanddatarv(session,metaanddatav)
3692 class(dbasession), intent(inout) :: session
3693 type(dbametaanddatar), intent(inout),allocatable :: metaanddatav(:)
3694 
3695 integer :: i
3696 
3697 call session%ingest_metaanddatar()
3698 if (c_e(session%count)) then
3699  allocate(metaanddatav(session%count))
3700  i=0
3701  do while (session%count >0)
3702  i=i+1
3703  call session%ingest_metaanddatar(metaanddatav(i))
3704  end do
3705 else
3706  allocate(metaanddatav(0))
3707 end if
3708 end subroutine dbasession_ingest_metaanddatarv
3709 
3710 
3711 
3713 subroutine dbasession_ingest_metaanddatac(session,metaanddata)
3714 class(dbasession), intent(inout) :: session
3715 type(dbametaanddatac), intent(inout),optional :: metaanddata
3716 
3717 integer :: ier
3718 character(len=9) :: btable
3719 character(len=255) :: value
3720 
3721 if (.not. present(metaanddata)) then
3722  ier = idba_voglioquesto(session%sehandle, session%count)
3723 else
3724  ier = idba_dammelo(session%sehandle, btable)
3725  ier = idba_enq(session%sehandle, btable,value)
3726  metaanddata%dbadatac=dbadatac(btable,value)
3727  call metaanddata%metadata%dbaenq(session)
3728  session%count=session%count-1
3729 end if
3730 end subroutine dbasession_ingest_metaanddatac
3731 
3732 
3734 subroutine dbasession_ingest_metaanddatacv(session,metaanddatav)
3735 class(dbasession), intent(inout) :: session
3736 type(dbametaanddatac), intent(inout),allocatable :: metaanddatav(:)
3737 
3738 integer :: i
3739 
3740 call session%ingest_metaanddatac()
3741 if (c_e(session%count)) then
3742  allocate(metaanddatav(session%count))
3743  i=0
3744  do while (session%count >0)
3745  i=i+1
3746  call session%ingest_metaanddatac(metaanddatav(i))
3747  end do
3748 else
3749  allocate(metaanddatav(session%count))
3750 end if
3751 end subroutine dbasession_ingest_metaanddatacv
3752 
3755 type(dbaconnection) function dbaconnection_init(dsn, user, password,categoryappend,idbhandle)
3756 character (len=*), intent(in), optional :: dsn
3757 character (len=*), intent(in), optional :: user
3758 character (len=*), intent(in), optional :: password
3759 character(len=*),INTENT(in),OPTIONAL :: categoryappend
3760 integer,INTENT(in),OPTIONAL :: idbhandle
3761 
3762 integer :: ier
3763 character(len=512) :: a_name,quidsn
3764 
3765 if (present(categoryappend))then
3766  call l4f_launcher(a_name,a_name_append=trim(subcategory)//"."//trim(categoryappend))
3767 else
3768  call l4f_launcher(a_name,a_name_append=trim(subcategory))
3769 endif
3770 dbaconnection_init%category=l4f_category_get(a_name)
3771 
3772 ! impostiamo la gestione dell'errore
3773 ier=idba_error_set_callback(0,c_funloc(dballe_error_handler), &
3774  dbaconnection_init%category,dbaconnection_init%handle_err)
3775 if (.not. c_e(optio_i(idbhandle))) then
3776 
3777  quidsn = "test"
3778  IF (PRESENT(dsn)) THEN
3779  IF (c_e(dsn)) quidsn = dsn
3780  ENDIF
3781 
3782  ier=idba_presentati(dbaconnection_init%dbhandle,quidsn)
3783 else
3784  dbaconnection_init%dbhandle=optio_i(idbhandle)
3785 end if
3786 
3787 end function dbaconnection_init
3788 
3790 subroutine dbaconnection_delete(handle)
3791 #ifdef F2003_FULL_FEATURES
3792 type (dbaconnection), intent(inout) :: handle
3793 #else
3794 class(dbaconnection), intent(inout) :: handle
3795 #endif
3796 
3797 integer :: ier
3798 
3799 if (c_e(handle%dbhandle)) then
3800  ier = idba_arrivederci(handle%dbhandle)
3801  ier = idba_error_remove_callback(handle%handle_err)
3802 end if
3803 
3804 end subroutine dbaconnection_delete
3805 
3808 recursive type(dbasession) function dbasession_init(connection,anaflag, dataflag, attrflag,&
3809  filename,mode,format,template,write,wipe,repinfo,simplified,memdb,loadfile,categoryappend)
3810 type(dbaconnection),intent(in),optional :: connection
3811 character (len=*), intent(in), optional :: anaflag
3812 character (len=*), intent(in), optional :: dataflag
3813 character (len=*), intent(in), optional :: attrflag
3814 character (len=*), intent(in), optional :: filename
3815 character (len=*), intent(in), optional :: mode
3816 character (len=*), intent(in), optional :: template
3817 logical,INTENT(in),OPTIONAL :: write
3818 logical,INTENT(in),OPTIONAL :: wipe
3819 character(len=*), INTENT(in),OPTIONAL :: repinfo
3820 character(len=*),intent(in),optional :: format
3821 logical,intent(in),optional :: simplified
3822 logical,intent(in),optional :: memdb
3823 logical,intent(in),optional :: loadfile
3824 character(len=*),INTENT(in),OPTIONAL :: categoryappend
3825 
3826 integer :: ier
3827 character (len=5) :: lanaflag,ldataflag,lattrflag
3828 character (len=1) :: lmode
3829 logical :: lwrite,lwipe
3830 character(len=255) :: lrepinfo
3831 character(len=40) :: lformat
3832 logical :: exist,lsimplified,read_next,lfile,lmemdb,lloadfile
3833 character(len=512) :: a_name
3834 character(len=40) :: ltemplate
3835 
3836 ! those are assigned by the default constructor?
3837 !!$dbasession_init%sehandle=imiss
3838 !!$dbasession_init%file=.false.
3839 !!$dbasession_init%template=cmiss
3840 !!$dbasession_init%count=imiss
3841 
3842 if (present(categoryappend))then
3843  call l4f_launcher(a_name,a_name_append=trim(subcategory)//"."//trim(categoryappend))
3844 else
3845  call l4f_launcher(a_name,a_name_append=trim(subcategory))
3846 endif
3847 dbasession_init%category=l4f_category_get(a_name)
3848 
3849 
3850 lwrite=.false.
3851 if (present(write))then
3852  lwrite=write
3853 endif
3854 
3855 lwipe=.false.
3856 lrepinfo=""
3857 if (present(wipe))then
3858  lwipe=wipe
3859  if (present(repinfo))then
3860  lrepinfo=repinfo
3861  endif
3862 endif
3863 
3864 lmemdb=.false.
3865 lloadfile=.false.
3866 lfile=.false.
3867 
3868 if (present(template))then
3869  ltemplate=template
3870 else
3871  ltemplate=cmiss
3872 endif
3873 
3874 lsimplified=.true.
3875 if (present(simplified))then
3876  lsimplified=simplified
3877 end if
3878 
3879 lformat="BUFR"
3880 if (present(format))then
3881  lformat=format
3882 end if
3883 
3884 lmode="r"
3886 if (present(filename)) then
3887 
3888  lfile=.true.
3889 
3890  IF (filename == '') THEN
3891 ! if stdio do not check existence, stdin always exist, stdout never exist
3892  exist = .NOT.lwrite
3893  ELSE
3894  INQUIRE(file=filename,exist=exist)
3895  ENDIF
3896 
3897  if (lwrite)then
3898  if (lwipe.or..not.exist) then
3899  lmode="w"
3900  else
3901  lmode="a"
3902  call l4f_category_log(dbasession_init%category,l4f_info,"file exists; appending data to file")
3903  end if
3904  else
3905  if (.not.exist) then
3906  call l4f_category_log(dbasession_init%category,l4f_error,"file does not exist; cannot open file for read")
3907  CALL raise_fatal_error()
3908  end if
3909  end if
3910 
3911  if (present(mode)) lmode = mode
3912 
3913  if (.not.present(memdb))then
3914  dbasession_init%memdb=.true. ! default with filename
3915  end if
3916 
3917  if (.not.present(loadfile))then
3918  dbasession_init%loadfile=.true. ! default with filename
3919  end if
3920 
3921 end if
3922 
3923 if (present(memdb))then
3924  lmemdb=memdb
3925 end if
3926 
3927 if (present(loadfile))then
3928  lloadfile=loadfile
3929 end if
3930 
3931 
3932 call optio(anaflag,lanaflag)
3933 if (.not. c_e(lanaflag))then
3934  if (lwrite) then
3935  lanaflag = "write"
3936  else
3937  lanaflag = "read"
3938  end if
3939 end if
3940 
3941 call optio(dataflag,ldataflag)
3942 if (.not. c_e(ldataflag)) then
3943  if (lwrite) then
3944  ldataflag = "write"
3945  else
3946  ldataflag = "read"
3947  end if
3948 end if
3950 call optio(attrflag,lattrflag)
3951 if (.not. c_e(lattrflag))then
3952  if (lwrite) then
3953  lattrflag = "write"
3954  else
3955  lattrflag = "read"
3956  end if
3957 end if
3958 
3959 
3960 !!$print*,"---------------- call session_init --------------------------------"
3961 !!$print *,"session_init,lformat,ltemplate,lmemdb,lfile,lloadfile,lanaflag,ldataflag,lattrflag"
3962 !!$print *,"session_init",lformat,ltemplate,lmemdb,lfile,lloadfile,lanaflag,ldataflag,lattrflag
3963 !!$print*,"------------------------------------------------"
3964 
3965 if (lfile) then
3966 
3967  if (present(anaflag).or.present(dataflag).or.present( attrflag)) then
3968  call l4f_category_log(dbasession_init%category,l4f_error,"option anaflag, dataflag, attrflag defined with filename access")
3969  CALL raise_error()
3970  end if
3971 
3972 else
3973 
3974  if(.not. present(connection)) then
3975  call l4f_category_log(dbasession_init%category,l4f_error,"connection not present accessing DBA")
3976  CALL raise_error()
3977  end if
3978 
3979  if (present(mode).or.present(format).or.present(template).or.present(simplified)) then
3980  call l4f_category_log(dbasession_init%category,l4f_error,&
3981  "option mode or format or template or simplified defined without filename")
3982  CALL raise_error()
3983  end if
3985 end if
3986 
3987 
3988 ! check filename for recursive call
3989 if (present(filename))then
3990  if (lmemdb)then
3991  if (.not. present(connection)) then
3992  ! connect to dsn type DBA
3993  dbasession_init%memconnection=dbaconnection(dsn="mem:")
3994  !call self with memconnection without filename
3995  dbasession_init=dbasession(dbasession_init%memconnection,&
3996  write=.true.,wipe=lwrite,repinfo=lrepinfo,&
3997  memdb=lmemdb,loadfile=lloadfile) ! without categoryappend
3998 
3999  else
4000  dbasession_init%memconnection=connection
4001  !call self with memconnection without filename
4002  dbasession_init=dbasession(dbasession_init%memconnection,&
4003  write=.true.,wipe=lwrite,repinfo=lrepinfo,&
4004  memdb=lmemdb,loadfile=lloadfile) ! without categoryappend
4005 
4006  end if
4007 
4008  if (lmode == "r") then
4009  call dbasession_init%messages_open_input(filename=filename,mode=lmode,&
4010  format=lformat,simplified=lsimplified)
4011 
4012  if (lloadfile)then
4013  read_next = dbasession_init%messages_read_next()
4014  do while (read_next)
4015  read_next = dbasession_init%messages_read_next()
4016  end do
4017  end if
4018  else
4019 
4020  call dbasession_init%messages_open_output(filename=filename,&
4021  mode=lmode,format=lformat)
4022 
4023  end if
4024 
4025  else
4026 
4027  ier = idba_messaggi(dbasession_init%sehandle,filename, lmode, lformat)
4028 
4029  end if
4030 
4031 else
4032 
4033  ier = idba_preparati(connection%dbhandle,dbasession_init%sehandle, lanaflag, ldataflag, lattrflag)
4034  if (lwipe)ier=idba_scopa(dbasession_init%sehandle,lrepinfo)
4035 
4036 end if
4037 
4038 dbasession_init%file=lfile
4039 if (dbasession_init%file) dbasession_init%filename=filename
4040 dbasession_init%mode=lmode
4041 dbasession_init%format=lformat
4042 dbasession_init%simplified=lsimplified
4043 dbasession_init%memdb=lmemdb
4044 dbasession_init%loadfile=lloadfile
4045 dbasession_init%template=ltemplate
4046 
4047 !!$print*,"--------------- at end ---------------------------------"
4048 !!$print *,'file',dbasession_init%file
4049 !!$print *,'filename',trim(dbasession_init%filename)
4050 !!$print *,'mode',dbasession_init%mode
4051 !!$print *,'format',dbasession_init%format
4052 !!$print *,'simplified',dbasession_init%simplified
4053 !!$print *,'memdb',dbasession_init%memdb
4054 !!$print *,'loadfile',dbasession_init%loadfile
4055 !!$print *,'template',dbasession_init%template
4056 !!$print*,"------------------------------------------------"
4057 
4058 end function dbasession_init
4059 
4060 
4062 subroutine dbasession_unsetall(session)
4063 class(dbasession), intent(in) :: session
4064 integer :: ier
4065 
4066 if (c_e(session%sehandle)) then
4067  ier = idba_unsetall(session%sehandle)
4068 end if
4069 
4070 end subroutine dbasession_unsetall
4071 
4072 
4074 subroutine dbasession_remove_all(session)
4075 class(dbasession), intent(in) :: session
4076 integer :: ier
4077 
4078 if (c_e(session%sehandle)) then
4079  ier = idba_remove_all(session%sehandle)
4080 end if
4081 
4082 end subroutine dbasession_remove_all
4083 
4084 
4086 subroutine dbasession_prendilo(session)
4087 class(dbasession), intent(in) :: session
4088 integer :: ier
4089 
4090 if (c_e(session%sehandle)) then
4091  ier = idba_prendilo(session%sehandle)
4092 end if
4093 
4094 end subroutine dbasession_prendilo
4095 
4097 subroutine dbasession_var_related(session,btable)
4098 class(dbasession), intent(in) :: session
4099 character(len=*),INTENT(IN) :: btable
4100 integer :: ier
4101 
4102 if (c_e(session%sehandle)) then
4103  ier = idba_set(session%sehandle,"*var_related",btable)
4104 end if
4105 
4106 end subroutine dbasession_var_related
4107 
4109 subroutine dbasession_setcontextana(session)
4110 class(dbasession), intent(in) :: session
4111 integer :: ier
4112 
4113 if (c_e(session%sehandle)) then
4114  ier = idba_setcontextana(session%sehandle)
4115 end if
4116 
4117 end subroutine dbasession_setcontextana
4118 
4120 subroutine dbasession_dimenticami(session)
4121 class(dbasession), intent(in) :: session
4122 integer :: ier
4123 
4124 if (c_e(session%sehandle)) then
4125  ier = idba_dimenticami(session%sehandle)
4126 end if
4127 
4128 end subroutine dbasession_dimenticami
4129 
4131 subroutine dbasession_critica(session)
4132 class(dbasession), intent(in) :: session
4133 integer :: ier
4134 
4135 if (c_e(session%sehandle)) then
4136  ier = idba_critica(session%sehandle)
4137 end if
4138 
4139 end subroutine dbasession_critica
4140 
4142 subroutine dbasession_scusa(session)
4143 class(dbasession), intent(in) :: session
4144 integer :: ier
4145 
4146 if (c_e(session%sehandle)) then
4147  ier = idba_scusa(session%sehandle)
4148 end if
4149 
4150 end subroutine dbasession_scusa
4151 
4153 subroutine dbasession_set(session,metadata,datav,data,datetime,ana,network,level,timerange,filter)
4154 class(dbasession), intent(in) :: session
4155 type (dbametadata),optional :: metadata
4156 class(dbadcv),optional :: datav
4157 class(dbadata),optional :: data
4158 type (dbadatetime),optional :: datetime
4159 type (dbaana),optional :: ana
4160 type (dbanetwork),optional :: network
4161 type (dbalevel),optional :: level
4162 type (dbatimerange),optional :: timerange
4163 type (dbafilter),optional :: filter
4164 
4165 if (present(metadata)) then
4166  call metadata%dbaset(session)
4167 endif
4168 
4169 if (present(datetime)) then
4170  call datetime%dbaset(session)
4171 endif
4172 
4173 if (present(ana)) then
4174  call ana%dbaset(session)
4175 endif
4176 
4177 if (present(network)) then
4178  call network%dbaset(session)
4179 endif
4180 
4181 if (present(level)) then
4182  call level%dbaset(session)
4183 endif
4184 
4185 if (present(timerange)) then
4186  call timerange%dbaset(session)
4187 endif
4188 
4189 if (present(datav)) then
4190  call datav%dbaset(session)
4191 end if
4192 
4193 if (present(data)) then
4194  call data%dbaset(session)
4195 end if
4196 
4197 if (present(filter)) then
4198  call filter%dbaset(session)
4199 end if
4200 
4201 end subroutine dbasession_set
4202 
4203 
4204 !!! Those are for reverse order call session%extrude(object)
4205 
4206 !!$!> put data on DSN
4207 !!$subroutine dbasession_extrude_ana(session,ana)
4208 !!$class(dbasession), intent(in) :: session
4209 !!$class(dbaana) :: ana !< ana
4210 !!$call ana%extrude(session)
4211 !!$end subroutine dbasession_extrude_ana
4212 !!$
4213 !!$!> put data on DSN
4214 !!$subroutine dbasession_extrude_dataattr(session,dataattr)
4215 !!$class(dbasession), intent(in) :: session
4216 !!$class(dbadataattr) :: dataattr !< dataattr
4217 !!$call dataattr%extrude(session)
4218 !!$end subroutine dbasession_extrude_dataattr
4219 !!$
4220 !!$!> put data on DSN
4221 !!$subroutine dbasession_extrude_dataattrv(session,dataattrv,noattr,filter)
4222 !!$class(dbasession), intent(in) :: session
4223 !!$class(dbadataattrv) :: dataattrv !< array datatattr
4224 !!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
4225 !!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
4226 !!$
4227 !!$call dataattrv%extrude(session,noattr,filter)
4228 !!$end subroutine dbasession_extrude_dataattrv
4229 !!$
4230 !!$!> put data on DSN
4231 !!$subroutine dbasession_extrude_metaanddata(session,metaanddata,noattr,filter)
4232 !!$class(dbasession), intent(in) :: session
4233 !!$class(dbametaanddata) :: metaanddata !< metaanddata
4234 !!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
4235 !!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
4236 !!$
4237 !!$call metaanddata%extrude(session,noattr,filter)
4238 !!$end subroutine dbasession_extrude_metaanddata
4239 !!$
4240 !!$!> put data on DSN
4241 !!$subroutine dbasession_extrude_metaanddatai(session,metaanddatai)
4242 !!$class(dbasession), intent(in) :: session
4243 !!$class(dbametaanddatai) :: metaanddatai !< metaanddatai
4244 !!$call metaanddatai%extrude(session)
4245 !!$end subroutine dbasession_extrude_metaanddatai
4246 !!$
4247 !!$!> put data on DSN
4248 !!$subroutine dbasession_extrude_metaanddatab(session,metaanddatab)
4249 !!$class(dbasession), intent(in) :: session
4250 !!$class(dbametaanddatab) :: metaanddatab !< metaanddatab
4251 !!$call metaanddatab%extrude(session)
4252 !!$end subroutine dbasession_extrude_metaanddatab
4253 !!$
4254 !!$!> put data on DSN
4255 !!$subroutine dbasession_extrude_metaanddatad(session,metaanddatad)
4256 !!$class(dbasession), intent(in) :: session
4257 !!$class(dbametaanddatad) :: metaanddatad !< metaanddatad
4258 !!$call metaanddatad%extrude(session)
4259 !!$end subroutine dbasession_extrude_metaanddatad
4260 !!$
4261 !!$!> put data on DSN
4262 !!$subroutine dbasession_extrude_metaanddatac(session,metaanddatac)
4263 !!$class(dbasession), intent(in) :: session
4264 !!$class(dbametaanddatac) :: metaanddatac !< metaanddatac
4265 !!$call metaanddatac%extrude(session)
4266 !!$end subroutine dbasession_extrude_metaanddatac
4267 !!$
4268 !!$!> put data on DSN
4269 !!$subroutine dbasession_extrude_metaanddatar(session,metaanddatar)
4270 !!$class(dbasession), intent(in) :: session
4271 !!$class(dbametaanddatar) :: metaanddatar !< metaanddatar
4272 !!$call metaanddatar%extrude(session)
4273 !!$end subroutine dbasession_extrude_metaanddatar
4274 !!$
4275 !!$!> put data on DSN
4276 !!$subroutine dbasession_extrude_metaanddatav(session, metaanddatav,noattr,filter)
4277 !!$class(dbasession), intent(in) :: session
4278 !!$class(dbametaanddatav) :: metaanddatav !< array metaanddata
4279 !!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
4280 !!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
4281 !!$
4282 !!$call metaanddatav%extrude(session,noattr,filter)
4283 !!$end subroutine dbasession_extrude_metaanddatav
4284 !!$
4285 !!$subroutine dbasession_extrude_metaanddatal(session, metaanddatal,noattr,filter)
4286 !!$class(dbasession), intent(in) :: session
4287 !!$class (dbametaanddatalist) :: metaanddatal !< metaanddata list
4288 !!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
4289 !!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
4290 !!$
4291 !!$call metaanddatal%extrude(session,noattr,filter)
4292 !!$end subroutine dbasession_extrude_metaanddatal
4293 !!$
4294 !!$!> put data on DSN
4295 !!$subroutine dbasession_extrude(session,ana,dataattr,dataattrv,metaanddata,&
4296 !!$ metaanddatai,metaanddatab,metaanddatad,metaanddatac,metaanddatar,&
4297 !!$ metaanddatav ,metaanddatal,noattr,filter)
4298 !!$class(dbasession), intent(in) :: session
4299 !!$class(dbaana),optional :: ana !< ana
4300 !!$class(dbadataattr),optional :: dataattr !< dataattr
4301 !!$class(dbadataattrv),optional :: dataattrv !< array datatattr
4302 !!$class(dbametaanddata),optional :: metaanddata !< metaanddata
4303 !!$class(dbametaanddatai),optional :: metaanddatai !< metaanddatai
4304 !!$class(dbametaanddatab),optional :: metaanddatab !< metaanddatab
4305 !!$class(dbametaanddatad),optional :: metaanddatad !< metaanddatad
4306 !!$class(dbametaanddatac),optional :: metaanddatac !< metaanddatac
4307 !!$class(dbametaanddatar),optional :: metaanddatar !< metaanddatar
4308 !!$class(dbametaanddatav),optional :: metaanddatav !< array metaanddata
4309 !!$class(dbametaanddatalist),optional :: metaanddatal !< metaanddata list
4310 !!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
4311 !!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
4312 !!$
4313 !!$if (present(ana)) then
4314 !!$ call ana%extrude(session)
4315 !!$end if
4316 !!$
4317 !!$if (present(dataattr)) then
4318 !!$ call dataattr%extrude(session)
4319 !!$end if
4320 !!$
4321 !!$if (present(dataattrv)) then
4322 !!$ call dataattrv%extrude(session,noattr,filter)
4323 !!$end if
4324 !!$
4325 !!$if (present(metaanddata)) then
4326 !!$ call metaanddata%extrude(session)
4327 !!$end if
4328 !!$
4329 !!$if (present(metaanddatai)) then
4330 !!$ call metaanddatai%extrude(session)
4331 !!$end if
4332 !!$
4333 !!$if (present(metaanddatab)) then
4334 !!$ call metaanddatab%extrude(session)
4335 !!$end if
4336 !!$
4337 !!$if (present(metaanddatad)) then
4338 !!$ call metaanddatad%extrude(session)
4339 !!$end if
4340 !!$
4341 !!$if (present(metaanddatac)) then
4342 !!$ call metaanddatac%extrude(session)
4343 !!$end if
4344 !!$
4345 !!$if (present(metaanddatar)) then
4346 !!$ call metaanddatar%extrude(session)
4347 !!$end if
4348 !!$
4349 !!$if (present(metaanddatav)) then
4350 !!$ call metaanddatav%extrude(session,noattr,filter)
4351 !!$end if
4352 !!$
4353 !!$if (present(metaanddatal)) then
4354 !!$ call metaanddatal%extrude(session,noattr,filter)
4355 !!$end if
4356 !!$
4357 !!$end subroutine dbasession_extrude
4358 
4359 # ifndef F2003_FULL_FEATURES
4360 
4361 subroutine dbasession_delete(session)
4362 class(dbasession), intent(inout) :: session
4363 integer :: ier
4364 type(dbasession) :: defsession
4365 
4366 if (c_e(session%sehandle)) then
4367  ier = idba_fatto(session%sehandle)
4368 end if
4369 
4370 call session%memconnection%delete()
4371 
4372 select type (session)
4373 type is (dbasession)
4374  session = defsession
4375 end select
4376 
4377 !!$session%sehandle=imiss
4378 !!$session%file=.false.
4379 !!$session%template=cmiss
4380 !!$session%filename=cmiss
4381 !!$session%mode=cmiss
4382 !!$session%format=cmiss
4383 !!$session%simplified=.true.
4384 !!$session%memdb=.false.
4385 !!$session%category=imiss
4386 !!$session%count=imiss
4387 
4388 end subroutine dbasession_delete
4389 
4390 #else
4391 
4393 subroutine dbasession_delete(session)
4394 type (dbasession), intent(inout) :: session
4395 integer :: ier
4396 
4397 if (c_e(session%sehandle)) then
4398  ier = idba_fatto(session%sehandle)
4399 end if
4400 
4401 !!$session%sehandle=imiss
4402 !!$session%file=.false.
4403 !!$session%template=cmiss
4404 !!$session%filename=cmiss
4405 !!$session%mode=cmiss
4406 !!$session%format=cmiss
4407 !!$session%simplified=.true.
4408 !!$session%memdb=.false.
4409 !!$session%category=imiss
4410 !!$session%count=imiss
4411 
4412 end subroutine dbasession_delete
4413 
4414 #endif
4415 
4416 
4417 
4419 subroutine dbasession_filerewind(session)
4420 class(dbasession), intent(inout) :: session
4421 integer :: ier
4422 
4423 if (c_e(session%sehandle).and. session%file) then
4424  ier = idba_fatto(session%sehandle)
4425  ier = idba_messaggi(session%sehandle,session%filename,session%mode,session%format)
4426 
4427 !!$! example: here we call constructor after a cast to reassign self (can you pass self attributes to constructor?)
4428 !!$ select type(session)
4429 !!$ type is (dbasession)
4430 !!$ session=dbasession(filename=session%filename,mode=session%mode,format=session%format)
4431 !!$ end select
4432 
4433 end if
4434 
4435 end subroutine dbasession_filerewind
4436 
4437 
4438 FUNCTION dballe_error_handler(category)
4439 INTEGER :: category, code, l4f_level
4440 INTEGER :: dballe_error_handler
4441 
4442 CHARACTER(len=1000) :: message, buf
4443 
4444 code = idba_error_code()
4445 
4446 ! check if "Value outside acceptable domain"
4447 if (code == 13 ) then
4448  l4f_level=l4f_warn
4449 else
4450  l4f_level=l4f_error
4451 end if
4452 
4453 call idba_error_message(message)
4454 call l4f_category_log(category,l4f_level,trim(message))
4455 
4456 call idba_error_context(buf)
4457 
4458 call l4f_category_log(category,l4f_level,trim(buf))
4459 
4460 call idba_error_details(buf)
4461 call l4f_category_log(category,l4f_info,trim(buf))
4462 
4463 
4464 ! if "Value outside acceptable domain" do not raise error
4465 if (l4f_level == l4f_error ) CALL raise_fatal_error("dballe: "//message)
4466 
4467 dballe_error_handler = 0
4468 return
4469 
4470 END FUNCTION dballe_error_handler
4471 
4472 end MODULE dballe_class
4473 
print a summary of object contents
Function to check whether a value is missing or not.
Classi per la gestione delle coordinate temporali.
class for import and export data from e to DB-All.e.
Gestione degli errori.
Classes for handling georeferenced sparse points in geographical corodinates.
abstract class to use lists in fortran 2003.
classe per la gestione del logging
Definitions of constants and functions for working with missing values.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione dell'anagrafica di stazioni meteo e affini.
Classe per la gestione di un volume completo di dati osservati.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Classe per la gestione delle reti di stazioni per osservazioni meteo e affini.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini.
Class for expressing an absolute time value.
double linked list of ana
manage connection handle to a DSN
fortran 2003 interface to geo_coord
base (abstract) type for data
vector of dbadataattr (more data plus attributes)
byte version for dbadata
character version for dbadata
doubleprecision version for dbadata
integer version for dbadata
real version for dbadata
container for dbadata (used for promiscuous vector of data)
vector of container of dbadata
filter to apply before ingest data
one metadata with more data plus attributes
metadata and byte data
metadata and byte data double linked list
metadata and character data
metadata and character data double linked list
metadata and doubleprecision data
metadata and diubleprecision data double linked list
metadata and integer data
metadata and integer data double linked list
double linked list of dbametaanddata
metadata and real data
metadata and real data double linked list
one metadata plus vector of container of dbadata
summ of all metadata pieces
manage session handle
Derived type defining an isolated georeferenced point on Earth in polar geographical coordinates.
Abstract implementation of doubly-linked list.
Definisce l'anagrafica di una stazione.
Definisce il livello verticale di un'osservazione.
Definisce la rete a cui appartiene una stazione.
Definisce l'intervallo temporale di un'osservazione meteo.

Generated with Doxygen.