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

Generated with Doxygen.