57 #ifdef HAVE_DBALLEF_MOD 62 #ifndef HAVE_DBALLEF_MOD 67 character (len=255),
parameter:: subcategory=
"dballe_class" 71 integer :: dbhandle=imiss
72 integer :: handle_err=imiss
75 # ifdef F2003_FULL_FEATURES 76 final :: dbaconnection_delete
78 procedure :: delete => dbaconnection_delete
84 procedure dbaconnection_init
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
100 integer :: count=imiss
102 # ifdef F2003_FULL_FEATURES 103 final :: dbasession_delete
105 procedure :: delete => dbasession_delete
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,&
162 ingest_metaanddataiv,ingest_metaanddatabv,ingest_metaanddatadv,ingest_metaanddatarv,ingest_metaanddatacv,&
163 ingest_metaanddatail,ingest_metaanddatarl,ingest_metaanddatadl,ingest_metaanddatabl,ingest_metaanddatacl
171 procedure dbasession_init
178 # ifdef F2003_FULL_FEATURES 183 procedure :: display => dbalevel_display
184 procedure :: dbaset => dbalevel_set
185 procedure :: dbaenq => dbalevel_enq
186 procedure,
nopass :: dbacontextana => dbalevel_contextana
192 procedure dbalevel_init
198 # ifdef F2003_FULL_FEATURES 203 procedure :: display => dbatimerange_display
204 procedure :: dbaset => dbatimerange_set
205 procedure :: dbaenq => dbatimerange_enq
206 procedure,
nopass :: dbacontextana => dbatimerange_contextana
212 procedure dbatimerange_init
224 # ifdef F2003_FULL_FEATURES 229 procedure :: display => dbacoord_display
235 procedure dbacoord_init
242 # ifdef F2003_FULL_FEATURES 247 procedure :: display => dbaana_display
248 procedure :: dbaset => dbaana_set
249 procedure :: dbaenq => dbaana_enq
250 procedure :: extrude => dbaana_extrude
255 procedure dbaana_init
261 procedure :: current => currentdbaana
262 procedure :: display => displaydbaana
275 # ifdef F2003_FULL_FEATURES 280 procedure :: display => dbanetwork_display
281 procedure :: dbaset => dbanetwork_set
282 procedure :: dbaenq => dbanetwork_enq
288 procedure dbanetwork_init
296 # ifdef F2003_FULL_FEATURES 301 procedure :: display => dbadatetime_display
302 procedure :: dbaset => dbadatetime_set
303 procedure :: dbaenq => dbadatetime_enq
304 procedure,
nopass :: dbacontextana => dbadatetime_contextana
309 procedure dbadatetime_init
314 type,
public,
abstract ::
dbadata 315 character(len=9) :: btable
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
331 procedure :: equal => dbadata_equal
332 generic ::
operator (==) => equal
355 procedure :: dbadata_geti => dbadatai_geti
356 procedure :: dbaset => dbadatai_set
362 procedure :: dbadatai_init
369 procedure :: dbadata_getr => dbadatar_getr
370 procedure :: dbaset => dbadatar_set
376 procedure :: dbadatar_init
382 doubleprecision :: value
384 procedure :: dbadata_getd => dbadatad_getd
385 procedure :: dbaset => dbadatad_set
386 procedure ::
display => dbadatad_display
391 procedure :: dbadatad_init
397 integer(kind=int_b) :: value
399 procedure :: dbadata_getb => dbadatab_getb
400 procedure :: dbaset => dbadatab_set
401 procedure ::
display => dbadatab_display
406 procedure :: dbadatab_init
414 character(vol7d_cdatalen) :: value
417 procedure :: dbadata_getc => dbadatac_getc
418 procedure :: dbaset => dbadatac_set
424 procedure :: dbadatac_init
429 type(dbalevel) :: level
430 type(dbatimerange) :: timerange
432 type(dbanetwork) :: network
433 type(dbadatetime) :: datetime
435 # ifdef F2003_FULL_FEATURES 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
450 procedure dbametadata_init
454 type,
public ::
dbadc 455 class(dbadata),
allocatable :: dat
457 procedure :: display => dbadc_display
458 procedure :: dbaset => dbadc_set
459 procedure :: extrude => dbadc_extrude
465 type(
dbadc),
allocatable :: dcv(:)
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
478 procedure ::
display => dbadataattr_display
479 procedure :: extrude => dbadataattr_extrude
484 class(dbadataattr),
allocatable :: dataattr(:)
486 procedure :: display => dbadataattrv_display
487 procedure :: extrude => dbadataattrv_extrude
492 type(dbametadata) :: metadata
495 procedure ::
display => dbametaanddata_display
496 procedure :: extrude => dbametaanddata_extrude
504 procedure ::
display => dbametaanddatav_display
505 procedure :: extrude => dbametaanddatav_extrude
511 procedure :: current => currentdbametaanddata
512 procedure :: display => displaydbametaanddata
513 procedure :: extrude => dbametaanddatal_extrude
520 procedure ::
display => dbametaanddatai_display
521 procedure :: extrude => dbametaanddatai_extrude
527 procedure :: current => currentdbametaanddatai
528 procedure :: display => displaydbametaanddatai
529 procedure :: toarray => toarray_dbametaanddatai
536 procedure ::
display => dbametaanddatab_display
537 procedure :: extrude => dbametaanddatab_extrude
543 procedure :: current => currentdbametaanddatab
544 procedure ::
display => displaydbametaanddatab
545 procedure :: toarray => toarray_dbametaanddatab
550 type(dbametadata) :: metadata
552 procedure :: display => dbametaanddatad_display
553 procedure :: extrude => dbametaanddatad_extrude
559 procedure :: current => currentdbametaanddatad
560 procedure :: display => displaydbametaanddatad
561 procedure :: toarray => toarray_dbametaanddatad
566 type(dbametadata) :: metadata
568 procedure ::
display => dbametaanddatar_display
569 procedure :: extrude => dbametaanddatar_extrude
575 procedure :: current => currentdbametaanddatar
576 procedure ::
display => displaydbametaanddatar
577 procedure :: toarray => toarray_dbametaanddatar
584 procedure ::
display => dbametaanddatac_display
585 procedure :: extrude => dbametaanddatac_extrude
591 procedure :: current => currentdbametaanddatac
592 procedure ::
display => displaydbametaanddatac
593 procedure :: toarray => toarray_dbametaanddatac
599 character(len=6) :: var
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
615 type(
dbadcv) :: anavars,anastarvars
617 procedure ::
display => dbafilter_display
618 procedure :: dbaset => dbafilter_set
619 procedure :: equalmetadata => dbafilter_equal_dbametadata
622 generic ::
operator (==) => equalmetadata
627 procedure dbafilter_init
633 subroutine displaydbametaanddata(this)
638 do while(this%element())
639 print *,
"index:",this%currentindex(),
" value:" 640 element=this%current()
641 call element%display()
644 end subroutine displaydbametaanddata
647 type(dbametaanddata) function currentdbametaanddata(this)
648 class(dbametaanddataList) :: this
649 class(*),
pointer :: v
651 v => this%currentpoli()
654 currentdbametaanddata = v
656 end function currentdbametaanddata
660 elemental logical function dbadata_equal(this,that)
662 class(
dbadata),
intent(in) :: this
663 class(
dbadata),
intent(in) :: that
665 if ( this%btable == that%btable )
then 666 dbadata_equal = .true.
668 dbadata_equal = .false.
671 end function dbadata_equal
675 subroutine dbadata_geti(data,value)
676 class(
dbadata),
intent(in) :: data
677 integer,
intent(out) ::
value 685 end subroutine dbadata_geti
689 logical function dbadata_c_e_i(data)
690 class(
dbadata),
intent(in) :: data
692 dbadata_c_e_i=.false.
696 dbadata_c_e_i = c_e(data%value)
699 end function dbadata_c_e_i
702 subroutine dbadata_getr(data,value)
703 class(
dbadata),
intent(in) :: data
704 real,
intent(out) ::
value 712 end subroutine dbadata_getr
715 logical function dbadata_c_e_r(data)
716 class(dbadata),
intent(in) :: data
718 dbadata_c_e_r=.false.
722 dbadata_c_e_r = c_e(data%value)
725 end function dbadata_c_e_r
728 subroutine dbadata_getd(data,value)
729 class(
dbadata),
intent(in) :: data
730 doubleprecision,
intent(out) ::
value 738 end subroutine dbadata_getd
741 logical function dbadata_c_e_d(data)
744 dbadata_c_e_d=.false.
748 dbadata_c_e_d = c_e(data%value)
751 end function dbadata_c_e_d
755 subroutine dbadata_getb(data,value)
757 INTEGER(kind=int_b),
intent(out) ::
value 765 end subroutine dbadata_getb
768 logical function dbadata_c_e_b(data)
769 class(
dbadata),
intent(in) :: data
771 dbadata_c_e_b=.false.
775 dbadata_c_e_b = c_e(data%value)
778 end function dbadata_c_e_b
781 subroutine dbadata_getc(data,value)
783 character(len=*),
intent(out) ::
value 791 end subroutine dbadata_getc
795 logical function dbadata_c_e_c(data)
796 class(
dbadata),
intent(in) :: data
798 dbadata_c_e_c=.false.
802 dbadata_c_e_c = c_e(data%value)
805 end function dbadata_c_e_c
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()
815 end function dbadata_c_e
819 subroutine dbalevel_display(level)
820 class(dbalevel),
intent(in) :: level
821 call display (level%vol7d_level)
822 end subroutine dbalevel_display
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
833 call init (dbalevel_init%vol7d_level,level1, l1, level2, l2)
834 end function dbalevel_init
837 subroutine dbalevel_set(level,session)
838 class(
dbalevel),
intent(in) :: level
843 ier = idba_setlevel(session%sehandle,&
844 level%level1, level%l1, level%level2, level%l2)
847 if (.not. c_e(level%vol7d_level))
then 848 call session%setcontextana
851 end subroutine dbalevel_set
854 subroutine dbalevel_enq(level,session)
855 class(dbalevel),
intent(out) :: level
856 type(dbasession),
intent(in) :: session
859 ier = idba_enqlevel(session%sehandle,&
860 level%level1, level%l1, level%level2, level%l2)
862 end subroutine dbalevel_enq
865 type(
dbalevel) function dbalevel_contextana()
869 end function dbalevel_contextana
873 subroutine dbaana_display(ana)
875 call display (ana%vol7d_ana)
876 end subroutine dbaana_display
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
887 CALL init(dbacoord_init%geo_coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
889 end function dbacoord_init
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
907 if (
present(coord))
then 908 CALL init(dbaana_init%vol7d_ana, ilon=getilon(coord%geo_coord), ilat=getilat(coord%geo_coord), ident=ident)
910 CALL init(dbaana_init%vol7d_ana, lon=lon, lat=lat, ilon=ilon, ilat=ilat, ident=ident)
913 end function dbaana_init
916 subroutine dbaana_set(ana,session)
917 class(dbaana),
intent(in) :: ana
918 type(dbasession),
intent(in) :: session
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)
928 ier = idba_set(session%sehandle,
"ident",cmiss)
929 ier = idba_set(session%sehandle,
"mobile",imiss)
932 end subroutine dbaana_set
935 subroutine dbaana_enq(ana,session)
936 class(
dbaana),
intent(out) :: ana
938 integer :: ier,ilat,ilon
941 ier = idba_enq(session%sehandle,
"lat",ilat)
942 ier = idba_enq(session%sehandle,
"lon",ilon)
944 call init(ana%vol7d_ana%coord,ilon=ilon,ilat=ilat)
945 ier = idba_enq(session%sehandle,
"ident",ana%vol7d_ana%ident)
947 end subroutine dbaana_enq
951 subroutine dbaana_extrude(ana,session)
952 class(dbaana),
intent(in) :: ana
953 type(dbasession),
intent(in) :: session
955 call session%unsetall()
957 call session%set(ana=ana)
958 call session%prendilo()
961 call session%close_message()
963 end subroutine dbaana_extrude
967 subroutine displaydbaana(this)
969 type(dbaana) :: element
972 do while(this%element())
973 print *,
"index:",this%currentindex(),
" value:" 974 element=this%current()
975 call element%display()
978 end subroutine displaydbaana
981 type(dbaana) function currentdbaana(this)
983 class(*),
pointer :: v
985 v => this%currentpoli()
990 end function currentdbaana
994 subroutine dbadc_set(dc,session)
995 class(dbadc),
intent(in) :: dc
996 type(dbasession),
intent(in) :: session
998 call dc%dat%dbaset(session)
1000 end subroutine dbadc_set
1003 subroutine dbadc_display(dc)
1004 class(dbadc),
intent(in) :: dc
1006 call dc%dat%display()
1008 end subroutine dbadc_display
1011 subroutine dbadcv_set(dcv,session)
1012 class(
dbadcv),
intent(in) :: dcv
1016 do i=1,
size(dcv%dcv)
1017 call dcv%dcv(i)%dbaset(session)
1020 end subroutine dbadcv_set
1025 subroutine dbadcv_extrude(dcv,session,noattr,filter,template)
1026 class(
dbadcv),
intent(in) :: dcv
1028 logical,
intent(in),
optional :: noattr
1029 type(
dbafilter),
intent(in),
optional :: filter
1030 character(len=*),
intent(in),
optional :: template
1033 do i=1,
size(dcv%dcv)
1034 call dcv%dcv(i)%extrude(session,noattr,filter,template=template)
1037 end subroutine dbadcv_extrude
1040 subroutine dbadc_extrude(data,session,noattr,filter,attronly,template)
1041 class(
dbadc),
intent(in) :: data
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
1048 call data%extrude(session,noattr,filter,attronly,template)
1050 end subroutine dbadc_extrude
1054 subroutine dbadcv_display(dcv)
1055 class(dbadcv),
intent(in) :: dcv
1058 if (
allocated(dcv%dcv))
then 1059 do i=1,
size(dcv%dcv)
1060 call dcv%dcv(i)%display()
1063 end subroutine dbadcv_display
1089 subroutine dbasession_unsetb(session)
1090 class(dbasession),
intent(in) :: session
1094 ier=idba_unsetb(session%sehandle)
1096 end subroutine dbasession_unsetb
1099 subroutine dbasession_close_message(session,template)
1101 character(len=*),
intent(in),
optional :: template
1103 character(len=40) :: ltemplate
1106 ltemplate=session%template
1107 if (
present(template)) ltemplate=template
1120 if (session%file)
then 1122 if (session%memdb)
then 1129 if (c_e(ltemplate))
then 1130 ier=idba_set(session%sehandle,
"query",
"message "//trim(ltemplate))
1132 ier=idba_set(session%sehandle,
"query",
"message")
1135 call session%unsetb()
1136 call session%prendilo()
1140 end subroutine dbasession_close_message
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
1152 character (len=40) :: lmode, lformat
1153 logical :: lsimplified
1156 if (
present(mode)) lmode=mode
1159 if (
present(format)) lformat=
format 1162 if (
present(simplified)) lsimplified=simplified
1164 ier = idba_messages_open_input(session%sehandle, filename, lmode, lformat, lsimplified)
1166 end subroutine dbasession_messages_open_input
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
1177 character (len=40) :: lmode, lformat
1180 if (
present(mode)) lmode=mode
1183 if (
present(format)) lformat=
format 1185 ier = idba_messages_open_output(session%sehandle, filename, lmode, lformat)
1187 end subroutine dbasession_messages_open_output
1191 logical function dbasession_messages_read_next(session)
1192 class(dbasession),
intent(in) :: session
1196 ier = idba_messages_read_next(session%sehandle, dbasession_messages_read_next)
1198 end function dbasession_messages_read_next
1201 subroutine dbasession_messages_write_next(session,template)
1203 character(len=*),
optional :: template
1204 character(len=40) :: ltemplate
1211 ltemplate=session%template
1212 if (
present(template)) ltemplate=template
1214 ier = idba_messages_write_next(session%sehandle,ltemplate)
1216 end subroutine dbasession_messages_write_next
1220 subroutine dbasession_dissolve_metadata(session,metadata)
1221 class(dbasession),
intent(in) :: session
1222 type(dbametadata),
intent(in) :: metadata(:)
1226 do i =1,
size (metadata)
1228 call metadata(i)%dbaset(session)
1229 call session%dissolve()
1233 end subroutine dbasession_dissolve_metadata
1238 subroutine dbasession_dissolveattr_metadata(session,metadata)
1239 class(dbasession),
intent(in) :: session
1240 type(dbametadata),
intent(in),
optional :: metadata(:)
1242 character(len=9) :: btable
1243 integer :: i,ii,count,ier
1245 if (
present (metadata))
then 1246 do i =1,
size (metadata)
1249 call metadata(i)%dbaset(session)
1250 ier = idba_voglioquesto(session%sehandle, count)
1252 if (.not. c_e(count)) cycle
1254 ier = idba_dammelo(session%sehandle, btable)
1256 call session%scusa()
1262 ier = idba_voglioquesto(session%sehandle, count)
1264 if (c_e(count))
then 1266 ier = idba_dammelo(session%sehandle, btable)
1268 call session%scusa()
1272 end subroutine dbasession_dissolveattr_metadata
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
1285 character(len=9) :: btable
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()
1293 if (
present(filter))
then 1294 if (filter%contextana)
then 1295 if (.not. filter%anavars == data%dbadc%dat)
return 1297 if (.not. filter%vars == data%dbadc%dat)
return 1307 if (.not. data%dbadc%dat%c_e() .and. session%file)
return 1309 call data%dbadc%dbaset(session)
1311 code = idba_error_code()
1313 if (optio_log(attronly).or. .not. data%dbadc%dat%c_e() .or. code ==13 )
then 1316 ierr = idba_set(session%sehandle,
"var",data%dbadc%dat%btable)
1319 ierr = idba_voglioquesto(session%sehandle, count)
1323 ierr=idba_unsetb(session%sehandle)
1324 if (count ==0)
return 1326 if (c_e(count))
then 1327 if (optio_log(attronly))
then 1328 ierr=idba_dammelo(session%sehandle, btable)
1332 ierr=idba_dimenticami(session%sehandle)
1336 call session%prendilo()
1337 ierr=idba_unsetb(session%sehandle)
1340 if (optio_log(noattr))
return 1343 if (
allocated(data%attrv%dcv))
then 1344 if (
size(data%attrv%dcv) > 0 )
then 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
1351 if (.not. filter%starvars == data%attrv%dcv(i)%dat) cycle
1355 if (data%attrv%dcv(i)%dat%c_e())
then 1358 call data%attrv%dcv(i)%dat%dbaset(session)
1360 else if(optio_log(attronly))
then 1364 ierr = idba_set(session%sehandle,
"*var",data%attrv%dcv(i)%dat%btable)
1367 call session%scusa()
1373 call session%critica()
1383 end subroutine dbadataattr_extrude
1386 subroutine dbadataattr_display(dc)
1387 class(dbadataattr),
intent(in) :: dc
1390 call dc%dbadc%display()
1391 print*,
"Attributes:" 1392 call dc%attrv%display()
1394 end subroutine dbadataattr_display
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
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)
1417 end subroutine dbadataattrv_extrude
1420 subroutine dbadataattrv_display(dataattr)
1421 class(dbadataattrv),
intent(in) :: dataattr
1424 do i=1,
size(dataattr%dataattr)
1425 call dataattr%dataattr(i)%display()
1428 end subroutine dbadataattrv_display
1431 subroutine dbadatai_geti(data,value)
1432 class(dbadatai),
intent(in) :: data
1433 integer,
intent(out) ::
value 1435 end subroutine dbadatai_geti
1438 subroutine dbadatar_getr(data,value)
1439 class(dbadatar),
intent(in) :: data
1440 real,
intent(out) ::
value 1442 end subroutine dbadatar_getr
1445 subroutine dbadatad_getd(data,value)
1446 class(dbadatad),
intent(in) :: data
1447 doubleprecision,
intent(out) ::
value 1449 end subroutine dbadatad_getd
1452 subroutine dbadatab_getb(data,value)
1453 class(dbadatab),
intent(in) :: data
1454 integer(kind=int_b),
intent(out) ::
value 1456 end subroutine dbadatab_getb
1459 subroutine dbadatac_getc(data,value)
1460 class(dbadatac),
intent(in) :: data
1461 character(len=*),
intent(out) ::
value 1463 end subroutine dbadatac_getc
1468 type(dbadatai)
elemental function dbadatai_init(btable,value)
1470 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1471 INTEGER,
INTENT(IN),
OPTIONAL ::
value 1473 if (
present(btable))
then 1474 dbadatai_init%btable=btable
1476 dbadatai_init%btable=cmiss
1479 if (
present(
value))
then 1480 dbadatai_init%value=
value 1482 dbadatai_init%value=imiss
1485 end function dbadatai_init
1489 type(dbadatar)
elemental function dbadatar_init(btable,value)
1491 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1492 real,
INTENT(IN),
OPTIONAL ::
value 1494 if (
present(btable))
then 1495 dbadatar_init%btable=btable
1497 dbadatar_init%btable=cmiss
1500 if (
present(
value))
then 1501 dbadatar_init%value=
value 1503 dbadatar_init%value=rmiss
1506 end function dbadatar_init
1510 type(dbadatad)
elemental function dbadatad_init(btable,value)
1512 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1513 double precision,
INTENT(IN),
OPTIONAL ::
value 1515 if (
present(btable))
then 1516 dbadatad_init%btable=btable
1518 dbadatad_init%btable=cmiss
1521 if (
present(
value))
then 1522 dbadatad_init%value=
value 1524 dbadatad_init%value=dmiss
1527 end function dbadatad_init
1532 type(dbadatab)
elemental function dbadatab_init(btable,value)
1534 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1535 INTEGER(kind=int_b) ,
INTENT(IN),
OPTIONAL ::
value 1537 if (
present(btable))
then 1538 dbadatab_init%btable=btable
1540 dbadatab_init%btable=cmiss
1543 if (
present(
value))
then 1544 dbadatab_init%value=
value 1546 dbadatab_init%value=bmiss
1549 end function dbadatab_init
1553 type(dbadatac)
elemental function dbadatac_init(btable,value)
1555 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1556 character(len=*),
INTENT(IN),
OPTIONAL ::
value 1558 if (
present(btable))
then 1559 dbadatac_init%btable=btable
1561 dbadatac_init%btable=cmiss
1564 if (
present(
value))
then 1565 dbadatac_init%value=
value 1567 dbadatac_init%value=cmiss
1570 end function dbadatac_init
1574 subroutine dbadatai_set(data,session)
1575 class(dbadatai),
intent(in) :: data
1576 type(dbasession),
intent(in) :: session
1578 if (.not. c_e(data%btable))
return 1579 ier = idba_set(session%sehandle,data%btable,data%value)
1580 end subroutine dbadatai_set
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
1589 subroutine dbadatar_set(data,session)
1590 class(dbadatar),
intent(in) :: data
1591 type(dbasession),
intent(in) :: session
1593 if (.not. c_e(data%btable))
return 1594 ier = idba_set(session%sehandle,data%btable,data%value)
1595 end subroutine dbadatar_set
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
1605 subroutine dbadatad_set(data,session)
1606 class(dbadatad),
intent(in) :: data
1607 type(dbasession),
intent(in) :: session
1609 if (.not. c_e(data%btable))
return 1610 ier = idba_set(session%sehandle,data%btable,data%value)
1611 end subroutine dbadatad_set
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
1620 subroutine dbadatab_set(data,session)
1621 class(dbadatab),
intent(in) :: data
1622 type(dbasession),
intent(in) :: session
1624 if (.not. c_e(data%btable))
return 1625 ier = idba_set(session%sehandle,data%btable,data%value)
1626 end subroutine dbadatab_set
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
1635 subroutine dbadatac_set(data,session)
1636 class(dbadatac),
intent(in) :: data
1637 type(dbasession),
intent(in) :: session
1639 if (.not. c_e(data%btable))
return 1640 ier = idba_set(session%sehandle,data%btable,data%value)
1641 end subroutine dbadatac_set
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
1663 subroutine dbatimerange_display(timerange)
1664 class(dbatimerange),
intent(in) :: timerange
1665 call display (timerange%vol7d_timerange)
1666 end subroutine dbatimerange_display
1669 subroutine dbatimerange_set(timerange,session)
1670 class(dbatimerange),
intent(in) :: timerange
1671 type(dbasession),
intent(in) :: session
1674 ier = idba_settimerange(session%sehandle,&
1675 timerange%timerange, timerange%p1, timerange%p2)
1678 if (.not. c_e(timerange%vol7d_timerange))
then 1679 call session%setcontextana
1682 end subroutine dbatimerange_set
1685 subroutine dbatimerange_enq(timerange,session)
1690 ier = idba_enqtimerange(session%sehandle,&
1691 timerange%timerange, timerange%p1, timerange%p2)
1693 end subroutine dbatimerange_enq
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
1702 call init (dbatimerange_init%vol7d_timerange,timerange, p1, p2)
1703 end function dbatimerange_init
1710 end function dbatimerange_contextana
1714 subroutine dbanetwork_display(network)
1716 call display (network%vol7d_network)
1717 print *,
"Priority=",network%priority
1718 end subroutine dbanetwork_display
1721 subroutine dbanetwork_set(network,session)
1726 ier = idba_set(session%sehandle,
"rep_memo", network%name)
1728 end subroutine dbanetwork_set
1731 subroutine dbanetwork_enq(network,session)
1736 ier = idba_enq(session%sehandle,
"rep_memo", network%name)
1737 ier = idba_enq(session%sehandle,
"priority", network%priority)
1739 end subroutine dbanetwork_enq
1743 type(
dbanetwork) function dbanetwork_init(name)
1744 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: name
1746 call init (dbanetwork_init%vol7d_network,name)
1747 dbanetwork_init%priority=imiss
1748 end function dbanetwork_init
1752 subroutine dbadatetime_display(datetime)
1754 call display (datetime%datetime)
1755 end subroutine dbadatetime_display
1758 subroutine dbadatetime_set(datetime,session)
1761 integer :: ier,year,month,day,hour,minute,sec,msec
1763 CALL getval(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1766 sec=nint(float(msec)/1000.)
1771 ier = idba_setdate(session%sehandle,year,month,day,hour,minute,sec)
1774 if (.not. c_e(datetime%datetime))
then 1775 call session%setcontextana
1778 end subroutine dbadatetime_set
1781 subroutine dbadatetime_enq(datetime,session)
1785 integer :: ier,year,month,day,hour,minute,sec,msec
1787 ier = idba_enqdate(session%sehandle,year,month,day,hour,minute,sec)
1797 if (year==1000)
then 1798 datetime%datetime=datetime_new()
1800 CALL init(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1803 end subroutine dbadatetime_enq
1807 type(dbadatetime) function dbadatetime_init(dt)
1808 type(datetime),
INTENT(in),
OPTIONAL :: dt
1810 if (
present(dt))
then 1811 dbadatetime_init%datetime=dt
1813 dbadatetime_init%datetime=datetime_new()
1816 end function dbadatetime_init
1819 type(dbadatetime) function dbadatetime_contextana()
1821 dbadatetime_contextana%datetime=datetime_new()
1823 end function dbadatetime_contextana
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
1836 if (
present(level))
then 1837 dbametadata_init%level=level
1842 if (
present(timerange))
then 1843 dbametadata_init%timerange=timerange
1848 if (
present(ana))
then 1849 dbametadata_init%ana=ana
1851 dbametadata_init%ana=
dbaana()
1854 if (
present(network))
then 1855 dbametadata_init%network=network
1860 if (
present(datetime))
then 1861 dbametadata_init%datetime=datetime
1866 end function dbametadata_init
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()
1877 end subroutine dbametadata_display
1880 subroutine dbametadata_set(metadata,session)
1881 class(dbametadata),
intent(in) :: metadata
1882 type(dbasession),
intent(in) :: session
1887 call metadata%ana%dbaset(session)
1888 call metadata%network%dbaset(session)
1890 if (c_e(metadata%datetime%datetime) .or. &
1891 c_e(metadata%level%vol7d_level) .or. &
1892 c_e(metadata%timerange%vol7d_timerange))
then 1894 call metadata%datetime%dbaset(session)
1895 call metadata%level%dbaset(session)
1896 call metadata%timerange%dbaset(session)
1899 call session%setcontextana()
1902 end subroutine dbametadata_set
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)
1915 end subroutine dbametadata_enq
1919 logical function dbafilter_equal_dbametadata(this,that)
1924 dbafilter_equal_dbametadata = .false.
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 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 1943 if (c_e(this%coordmin%geo_coord))
then 1944 if (geo_coord_ll(that%ana%vol7d_ana%coord, this%coordmin%geo_coord))
return 1947 if (c_e(this%coordmax%geo_coord))
then 1948 if (geo_coord_ur(that%ana%vol7d_ana%coord, this%coordmax%geo_coord))
return 1951 dbafilter_equal_dbametadata = .true.
1953 end function dbafilter_equal_dbametadata
1982 elemental logical function dbadcv_equal_dbadata(this,that)
1984 class(dbadcv),
intent(in) :: this
1985 class(dbadata),
intent(in) :: that
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 1999 dbadcv_equal_dbadata=.true.
2002 end function dbadcv_equal_dbadata
2006 elemental logical function dbametadata_equal(this,that)
2008 class(dbametadata),
intent(in) :: this
2009 class(dbametadata),
intent(in) :: that
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 &
2018 dbametadata_equal = .true.
2020 dbametadata_equal = .false.
2023 end function dbametadata_equal
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)
2035 type(
dbafilter),
intent(in),
optional :: filter
2036 type(
dbaana),
intent(in),
optional :: ana
2037 character(len=*),
intent(in),
optional :: var
2039 type(
dbalevel),
intent(in),
optional :: level
2041 type(
dbanetwork),
intent(in),
optional :: network
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
2059 class(
dbadcv),
intent(in),
optional :: starvars
2060 class(
dbadcv),
intent(in),
optional :: anavars
2061 class(
dbadcv),
intent(in),
optional :: anastarvars
2062 character(len=*),
intent(in),
optional :: query
2063 logical,
intent(in),
optional :: anaonly
2064 logical,
intent(in),
optional :: dataonly
2067 logical :: nopreserve
2070 if (
present(filter))
then 2071 dbafilter_init=filter
2109 if (
present(ana))
then 2110 dbafilter_init%ana=ana
2111 else if (nopreserve)
then 2112 dbafilter_init%ana=
dbaana()
2115 if (
present(var))
then 2116 dbafilter_init%var=var
2117 else if (nopreserve)
then 2118 dbafilter_init%var=cmiss
2121 if (
present(datetime))
then 2122 dbafilter_init%datetime=datetime
2123 else if (nopreserve)
then 2127 if (
present(level))
then 2128 dbafilter_init%level=level
2129 else if (nopreserve)
then 2133 if (
present(timerange))
then 2134 dbafilter_init%timerange=timerange
2135 else if (nopreserve)
then 2139 if (
present(network))
then 2140 dbafilter_init%network=network
2141 else if (nopreserve)
then 2145 if (
present(datetimemin))
then 2146 dbafilter_init%datetimemin=datetimemin
2147 else if (nopreserve)
then 2151 if (
present(datetimemax))
then 2152 dbafilter_init%datetimemax=datetimemax
2153 else if (nopreserve)
then 2157 if (
present(coordmin))
then 2158 dbafilter_init%coordmin=coordmin
2159 else if (nopreserve)
then 2163 if (
present(coordmax))
then 2164 dbafilter_init%coordmax=coordmax
2165 else if (nopreserve)
then 2169 if (
present(limit))
then 2170 dbafilter_init%limit=limit
2171 else if (nopreserve)
then 2172 dbafilter_init%limit=imiss
2175 if (
present(ana_filter))
then 2176 dbafilter_init%ana_filter=ana_filter
2177 else if (nopreserve)
then 2178 dbafilter_init%ana_filter=cmiss
2181 if (
present(data_filter))
then 2182 dbafilter_init%data_filter=data_filter
2183 else if (nopreserve)
then 2184 dbafilter_init%data_filter=cmiss
2187 if (
present(attr_filter))
then 2188 dbafilter_init%attr_filter=attr_filter
2189 else if (nopreserve)
then 2190 dbafilter_init%attr_filter=cmiss
2193 if (
present(varlist))
then 2194 dbafilter_init%varlist=varlist
2195 else if (nopreserve)
then 2196 dbafilter_init%varlist=cmiss
2199 if (
present(starvarlist))
then 2200 dbafilter_init%starvarlist=starvarlist
2201 else if (nopreserve)
then 2202 dbafilter_init%starvarlist=cmiss
2205 if (
present(anavarlist))
then 2206 dbafilter_init%anavarlist=anavarlist
2207 else if (nopreserve)
then 2208 dbafilter_init%anavarlist=cmiss
2211 if (
present(anastarvarlist))
then 2212 dbafilter_init%anastarvarlist=anastarvarlist
2213 else if (nopreserve)
then 2214 dbafilter_init%anastarvarlist=cmiss
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)
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)//
"," 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)
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)//
"," 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)
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)//
"," 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)
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)//
"," 2278 if (
present(priority))
then 2279 dbafilter_init%priority=priority
2280 else if (nopreserve)
then 2281 dbafilter_init%priority=imiss
2284 if (
present(priomin))
then 2285 dbafilter_init%priomin=priomax
2286 else if (nopreserve)
then 2287 dbafilter_init%priomin=imiss
2290 if (
present(priomax))
then 2291 dbafilter_init%priomax=priomax
2292 else if (nopreserve)
then 2293 dbafilter_init%priomax=imiss
2296 if (
present(contextana))
then 2297 dbafilter_init%contextana=contextana
2298 else if (nopreserve)
then 2299 dbafilter_init%contextana=.false.
2302 if (
present(anaonly))
then 2303 dbafilter_init%anaonly=anaonly
2304 else if (nopreserve)
then 2305 dbafilter_init%anaonly=.false.
2307 if (
present(dataonly))
then 2308 dbafilter_init%dataonly=dataonly
2309 else if (nopreserve)
then 2310 dbafilter_init%dataonly=.false.
2313 if (
present(query))
then 2314 dbafilter_init%query=query
2315 else if (nopreserve)
then 2316 dbafilter_init%query=cmiss
2319 end function dbafilter_init
2322 subroutine dbafilter_display(filter)
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)
2362 print *,
"-----------------------------------------" 2364 end subroutine dbafilter_display
2367 subroutine dbafilter_set(filter,session)
2371 integer :: ier,year,month,day,hour,minute,sec,msec
2373 call session%unsetall()
2375 call filter%ana%dbaset(session)
2376 call filter%network%dbaset(session)
2377 ier = idba_set(session%sehandle,
"var",filter%var)
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)
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))
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)
2393 ier = idba_set(session%sehandle,
"query",filter%query)
2395 if (filter%contextana)
then 2397 call session%setcontextana()
2399 ier = idba_set(session%sehandle,
"varlist",filter%anavarlist)
2400 ier = idba_set(session%sehandle,
"*varlist",filter%anastarvarlist)
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)
2408 CALL getval(filter%datetimemin%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2410 sec=nint(float(msec)/1000.)
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)
2422 CALL getval(filter%datetimemax%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2425 sec=nint(float(msec)/1000.)
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)
2438 ier = idba_set(session%sehandle,
"varlist",filter%varlist)
2439 ier = idba_set(session%sehandle,
"*varlist",filter%starvarlist)
2442 end subroutine dbafilter_set
2446 type(
dbametadata) function dbametadata_contextana(metadata)
2453 select type(metadata)
2455 dbametadata_contextana=metadata
2458 dbametadata_contextana%datetime=datetime%dbacontextana()
2459 dbametadata_contextana%level=level%dbacontextana()
2460 dbametadata_contextana%timerange=timerange%dbacontextana()
2462 end function dbametadata_contextana
2466 subroutine dbametaanddata_display(metaanddata)
2469 call metaanddata%metadata%display()
2470 call metaanddata%dataattrv%display()
2472 end subroutine dbametaanddata_display
2475 subroutine dbametaanddata_extrude(metaanddata,session,noattr,filter,attronly,template)
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
2489 myfilter=
dbafilter(filter=filter,contextana=.false.)
2490 call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2493 myfilter=
dbafilter(filter=filter,contextana=.true.)
2494 call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2498 subroutine extrude(metaanddata,session,noattr,filter,attronly,template)
2501 logical,
intent(in),
optional :: noattr
2503 logical,
intent(in),
optional :: attronly
2504 character(len=*),
intent(in),
optional :: template
2506 if (.not. filter == metaanddata%metadata)
return 2508 call session%unsetall()
2510 call session%set(metadata=metaanddata%metadata)
2514 call metaanddata%dataattrv%extrude(session,noattr,filter,attronly)
2517 call session%close_message(template)
2519 end subroutine extrude
2520 end subroutine dbametaanddata_extrude
2524 subroutine dbametaanddatav_display(metaanddatav)
2527 call metaanddatav%metadata%display()
2528 call metaanddatav%datav%display()
2530 end subroutine dbametaanddatav_display
2533 subroutine dbametaanddatav_extrude(metaanddatav,session,noattr,filter,template)
2536 logical,
intent(in),
optional :: noattr
2537 type(dbafilter),
intent(in),
optional :: filter
2538 character(len=*),
intent(in),
optional :: template
2540 type(dbafilter) :: myfilter
2542 myfilter=
dbafilter(filter=filter,contextana=.false.)
2543 call extrude(metaanddatav,session,noattr,myfilter,template)
2545 myfilter=
dbafilter(filter=filter,contextana=.true.)
2546 call extrude(metaanddatav,session,noattr,myfilter,template)
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
2557 if (.not. filter == metaanddatav%metadata)
return 2559 call session%set(metadata=metaanddatav%metadata)
2563 call metaanddatav%datav%extrude(session,noattr,filter,template)
2565 print*,
"dbaana_metaanddatav" 2567 call session%close_message(template)
2569 end subroutine extrude
2570 end subroutine dbametaanddatav_extrude
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
2583 call metaanddatal%rewind()
2584 do while(metaanddatal%element())
2586 metaanddata=metaanddatal%current()
2587 call metaanddata%extrude(session,noattr,filter,attronly,template)
2588 call metaanddatal%next()
2591 end subroutine dbametaanddatal_extrude
2595 subroutine displaydbametaanddatai(this)
2596 class(dbametaanddataiList) :: this
2597 type(dbametaanddatai) :: element
2600 do while(this%element())
2601 print *,
"index:",this%currentindex(),
" value:" 2602 element=this%current()
2603 call element%display()
2606 end subroutine displaydbametaanddatai
2609 type(dbametaanddatai) function currentdbametaanddatai(this)
2610 class(dbametaanddataiList) :: this
2611 class(*),
pointer :: v
2613 v => this%currentpoli()
2616 currentdbametaanddatai = v
2618 end function currentdbametaanddatai
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
2627 type(dbametaanddatai) :: element
2630 if (session%memdb .and. .not. session%loadfile)
then 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()
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()
2652 end subroutine dbasession_ingest_metaanddatail
2655 function toarray_dbametaanddatai(this)
2656 type(dbametaanddatai),
allocatable :: toarray_dbametaanddatai(:)
2657 class(dbametaanddataiList) :: this
2661 allocate (toarray_dbametaanddatai(this%countelements()))
2665 do while(this%element())
2667 toarray_dbametaanddatai(i) =this%current()
2670 end function toarray_dbametaanddatai
2674 subroutine displaydbametaanddatar(this)
2679 do while(this%element())
2680 print *,
"index:",this%currentindex(),
" value:" 2681 element=this%current()
2682 call element%display()
2685 end subroutine displaydbametaanddatar
2688 type(dbametaanddatar) function currentdbametaanddatar(this)
2689 class(dbametaanddatarList) :: this
2690 class(*),
pointer :: v
2692 v => this%currentpoli()
2695 currentdbametaanddatar = v
2697 end function currentdbametaanddatar
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
2706 type(dbametaanddatar) :: element
2708 if (session%memdb .and. .not. session%loadfile)
then 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()
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()
2731 end subroutine dbasession_ingest_metaanddatarl
2735 function toarray_dbametaanddatar(this)
2736 type(dbametaanddatar),
allocatable :: toarray_dbametaanddatar(:)
2737 class(dbametaanddatarList) :: this
2740 i=this%countelements()
2742 allocate (toarray_dbametaanddatar(this%countelements()))
2746 do while(this%element())
2748 toarray_dbametaanddatar(i) =this%current()
2751 end function toarray_dbametaanddatar
2755 subroutine displaydbametaanddatad(this)
2756 class(dbametaanddatadList) :: this
2757 type(dbametaanddatad) :: element
2760 do while(this%element())
2761 print *,
"index:",this%currentindex(),
" value:" 2762 element=this%current()
2763 call element%display()
2766 end subroutine displaydbametaanddatad
2769 type(dbametaanddatad) function currentdbametaanddatad(this)
2770 class(dbametaanddatadList) :: this
2771 class(*),
pointer :: v
2773 v => this%currentpoli()
2776 currentdbametaanddatad = v
2778 end function currentdbametaanddatad
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
2786 type(dbametaanddatad) :: element
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()
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()
2810 end subroutine dbasession_ingest_metaanddatadl
2814 function toarray_dbametaanddatad(this)
2815 type(dbametaanddatad),
allocatable :: toarray_dbametaanddatad(:)
2816 class(dbametaanddatadList) :: this
2820 allocate (toarray_dbametaanddatad(this%countelements()))
2824 do while(this%element())
2826 toarray_dbametaanddatad(i) =this%current()
2829 end function toarray_dbametaanddatad
2833 subroutine displaydbametaanddatab(this)
2838 do while(this%element())
2839 print *,
"index:",this%currentindex(),
" value:" 2840 element=this%current()
2841 call element%display()
2844 end subroutine displaydbametaanddatab
2847 type(dbametaanddatab) function currentdbametaanddatab(this)
2848 class(dbametaanddatabList) :: this
2849 class(*),
pointer :: v
2851 v => this%currentpoli()
2854 currentdbametaanddatab = v
2856 end function currentdbametaanddatab
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
2865 type(dbametaanddatab) :: element
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()
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()
2889 end subroutine dbasession_ingest_metaanddatabl
2893 function toarray_dbametaanddatab(this)
2894 type(dbametaanddatab),
allocatable :: toarray_dbametaanddatab(:)
2895 class(dbametaanddatabList) :: this
2899 allocate (toarray_dbametaanddatab(this%countelements()))
2903 do while(this%element())
2905 toarray_dbametaanddatab(i) =this%current()
2908 end function toarray_dbametaanddatab
2912 subroutine displaydbametaanddatac(this)
2917 do while(this%element())
2918 print *,
"index:",this%currentindex(),
" value:" 2919 element=this%current()
2920 call element%display()
2923 end subroutine displaydbametaanddatac
2926 type(dbametaanddatac) function currentdbametaanddatac(this)
2927 class(dbametaanddatacList) :: this
2928 class(*),
pointer :: v
2930 v => this%currentpoli()
2933 currentdbametaanddatac = v
2935 end function currentdbametaanddatac
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
2944 type(dbametaanddatac) :: element
2946 if (session%memdb .and. .not. session%loadfile)
then 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()
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()
2968 end subroutine dbasession_ingest_metaanddatacl
2972 function toarray_dbametaanddatac(this)
2973 type(dbametaanddatac),
allocatable :: toarray_dbametaanddatac(:)
2974 class(dbametaanddatacList) :: this
2978 allocate (toarray_dbametaanddatac(this%countelements()))
2982 do while(this%element())
2984 toarray_dbametaanddatac(i) =this%current()
2987 end function toarray_dbametaanddatac
2991 subroutine dbametaanddatai_display(data)
2994 call data%metadata%display()
2995 call data%dbadatai%display()
2997 end subroutine dbametaanddatai_display
3000 subroutine dbametaanddatab_display(data)
3001 class(dbametaanddatab),
intent(in) :: data
3003 call data%metadata%display()
3004 call data%dbadatab%display()
3006 end subroutine dbametaanddatab_display
3009 subroutine dbametaanddatad_display(data)
3010 class(dbametaanddatad),
intent(in) :: data
3012 call data%metadata%display()
3013 call data%dbadatad%display()
3015 end subroutine dbametaanddatad_display
3018 subroutine dbametaanddatar_display(data)
3019 class(dbametaanddatar),
intent(in) :: data
3021 call data%metadata%display()
3022 call data%dbadatar%display()
3024 end subroutine dbametaanddatar_display
3028 subroutine dbametaanddatac_display(data)
3031 call data%metadata%display()
3032 call data%dbadatac%display()
3034 end subroutine dbametaanddatac_display
3038 subroutine dbametaanddatai_extrude(metaanddatai,session)
3042 call session%unsetall()
3044 call session%set(metadata=metaanddatai%metadata)
3046 call session%set(data=metaanddatai%dbadatai)
3048 if (metaanddatai%dbadatai%c_e())
then 3049 call session%prendilo()
3051 call session%dimenticami()
3054 end subroutine dbametaanddatai_extrude
3057 subroutine dbametaanddatab_extrude(metaanddatab,session)
3058 class(dbametaanddatab),
intent(in) :: metaanddatab
3059 type(dbasession),
intent(in) :: session
3061 call session%unsetall()
3063 call session%set(metadata=metaanddatab%metadata)
3065 call session%set(data=metaanddatab%dbadatab)
3067 if (metaanddatab%dbadatab%c_e())
then 3068 call session%prendilo()
3070 call session%dimenticami()
3073 end subroutine dbametaanddatab_extrude
3076 subroutine dbametaanddatad_extrude(metaanddatad,session)
3077 class(dbametaanddatad),
intent(in) :: metaanddatad
3078 type(dbasession),
intent(in) :: session
3080 call session%unsetall()
3082 call session%set(metadata=metaanddatad%metadata)
3084 call session%set(data=metaanddatad%dbadatad)
3086 if (metaanddatad%dbadatad%c_e())
then 3087 call session%prendilo()
3089 call session%dimenticami()
3092 end subroutine dbametaanddatad_extrude
3095 subroutine dbametaanddatar_extrude(metaanddatar,session)
3096 class(dbametaanddatar),
intent(in) :: metaanddatar
3097 type(dbasession),
intent(in) :: session
3099 call session%unsetall()
3101 call session%set(metadata=metaanddatar%metadata)
3103 call session%set(data=metaanddatar%dbadatar)
3105 if (metaanddatar%dbadatar%c_e())
then 3106 call session%prendilo()
3108 call session%dimenticami()
3111 end subroutine dbametaanddatar_extrude
3114 subroutine dbametaanddatac_extrude(metaanddatac,session)
3118 call session%unsetall()
3120 call session%set(metadata=metaanddatac%metadata)
3122 call session%set(data=metaanddatac%dbadatac)
3124 if (metaanddatac%dbadatac%c_e())
then 3125 call session%prendilo()
3127 call session%dimenticami()
3130 end subroutine dbametaanddatac_extrude
3133 subroutine dbasession_ingest_ana(session,ana)
3134 class(dbasession),
intent(inout) :: session
3135 type(dbaana),
intent(out),
optional :: ana
3139 if (.not.
present(ana))
then 3140 ier = idba_quantesono(session%sehandle, session%count)
3143 ier = idba_elencamele(session%sehandle)
3144 call ana%dbaenq(session)
3145 session%count=session%count-1
3148 end subroutine dbasession_ingest_ana
3152 subroutine dbasession_ingest_anav(session,anav)
3153 class(dbasession),
intent(inout) :: session
3154 type(dbaana),
intent(out),
allocatable :: anav(:)
3157 call session%ingest_ana()
3159 if (c_e(session%count))
then 3160 allocate(anav(session%count))
3162 do while (session%count >0)
3164 call session%ingest_ana(anav(i))
3170 end subroutine dbasession_ingest_anav
3174 subroutine dbasession_ingest_anal(session,anal)
3175 class(dbasession),
intent(inout) :: session
3176 type(dbaanalist),
intent(out) :: anal
3177 type(dbaana) :: element
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()
3185 end subroutine dbasession_ingest_anal
3189 subroutine dbasession_ingest_metaanddata(session,metaanddata,noattr,filter)
3192 logical,
intent(in),
optional :: noattr
3193 type(
dbafilter),
intent(in),
optional :: filter
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
3204 if (.not.
present(metaanddata))
then 3205 ier = idba_voglioquesto(session%sehandle, session%count)
3208 if (c_e(session%count) .and. session%count > 0)
then 3209 ier = idba_dammelo(session%sehandle, btable)
3216 if (
allocated(metaanddata%dataattrv%dataattr))
then 3217 deallocate (metaanddata%dataattrv%dataattr)
3222 if (
present(filter))
then 3224 if (filter%contextana)
then 3227 if (
allocated(filter%anavars%dcv))
then 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)
3235 if (
allocated(filter%anastarvars%dcv))
then 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)
3245 if (
allocated(filter%vars%dcv))
then 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)
3253 if (
allocated(filter%starvars%dcv))
then 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)
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)
3274 call metaanddata%metadata%dbaenq(session)
3276 call metadata%dbaenq(session)
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 3284 select type ( dat => metaanddata%dataattrv%dataattr(i)%dat )
3286 ier = idba_enq(session%sehandle, btable,dat%value)
3288 ier = idba_enq(session%sehandle, btable,dat%value)
3290 ier = idba_enq(session%sehandle, btable,dat%value)
3292 ier = idba_enq(session%sehandle, btable,dat%value)
3294 ier = idba_enq(session%sehandle, btable,dat%value)
3297 if (optio_log(noattr))
then 3299 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
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)
3310 if (c_e(session%count) .and. session%count > 0)
then 3312 ier = idba_voglioancora(session%sehandle, acount)
3314 ier = idba_ancora(session%sehandle, btable)
3315 ier = idba_enq(session%sehandle, btable,
value)
3317 do j=1,
size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
3319 if (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat%btable == btable)
then 3321 select type ( dat => metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat )
3323 ier = idba_enq(session%sehandle, btable,dat%value)
3325 ier = idba_enq(session%sehandle, btable,dat%value)
3327 ier = idba_enq(session%sehandle, btable,dat%value)
3329 ier = idba_enq(session%sehandle, btable,dat%value)
3331 ier = idba_enq(session%sehandle, btable,dat%value)
3339 if (c_e(session%count) .and. session%count > 0)
then 3340 ier = idba_voglioancora(session%sehandle, acount)
3342 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(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))
3349 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3356 if (c_e(session%count)) session%count=session%count-1
3358 if (c_e(session%count) .and. session%count > 0 )
then 3359 ier = idba_dammelo(session%sehandle, btable)
3360 call metadata%dbaenq(session)
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)
3374 if (optio_log(noattr))
then 3376 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
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)
3387 if (c_e(session%count) .and. session%count > 0)
then 3389 ier = idba_voglioancora(session%sehandle, acount)
3391 ier = idba_ancora(session%sehandle, btable)
3392 ier = idba_enq(session%sehandle, btable,
value)
3394 do j=1,
size(metaanddata%dataattrv%dataattr(1)%attrv%dcv)
3396 if (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat%btable == btable)
then 3398 select type ( dat => metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat )
3400 ier = idba_enq(session%sehandle, btable,dat%value)
3402 ier = idba_enq(session%sehandle, btable,dat%value)
3404 ier = idba_enq(session%sehandle, btable,dat%value)
3406 ier = idba_enq(session%sehandle, btable,dat%value)
3408 ier = idba_enq(session%sehandle, btable,dat%value)
3416 if (c_e(session%count) .and. session%count > 0)
then 3417 ier = idba_voglioancora(session%sehandle, acount)
3419 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(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))
3426 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
3431 if (c_e(session%count))
then 3432 session%count=session%count-1
3434 if (session%count > 0 )
then 3435 ier = idba_dammelo(session%sehandle, btable)
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))
3449 end subroutine dbasession_ingest_metaanddata
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
3459 type(dbametaanddata),
allocatable :: metaanddatavbuf(:)
3463 if (
present(filter))
then 3464 call filter%dbaset(session)
3466 call session%unsetall()
3469 call session%ingest()
3472 if (c_e(session%count))
then 3474 allocate(metaanddatavbuf(session%count))
3476 do while (session%count >0)
3478 call session%ingest(metaanddatavbuf(i),noattr=noattr,filter=filter)
3482 IF (
SIZE(metaanddatavbuf) == i)
THEN 3484 CALL move_alloc(metaanddatavbuf, metaanddatav)
3487 metaanddatav=metaanddatavbuf(:i)
3488 DEALLOCATE(metaanddatavbuf)
3492 if (
allocated(metaanddatav))
deallocate(metaanddatav)
3493 allocate(metaanddatav(0))
3497 end subroutine dbasession_ingest_metaanddatav
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
3507 type(dbametaanddata),
allocatable :: metaanddatavbuf(:)
3510 if (session%memdb .and. .not. session%loadfile)
then 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))
3520 call session%remove_all()
3521 deallocate (metaanddatavbuf)
3526 call session%ingest()
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 3533 if (filter%contextana)
then 3534 if (datetime_new() /= metaanddatavbuf(i)%metadata%datetime%datetime) cycle
3537 call metaanddatal%append(metaanddatavbuf(i))
3539 if (session%file)
call session%ingest()
3540 deallocate (metaanddatavbuf)
3544 end subroutine dbasession_ingest_metaanddatal
3547 subroutine dbasession_ingest_metaanddatai(session,metaanddata)
3548 class(dbasession),
intent(inout) :: session
3549 type(dbametaanddatai),
intent(inout),
optional :: metaanddata
3552 character(len=9) :: btable
3555 if (.not.
present(metaanddata))
then 3556 ier = idba_voglioquesto(session%sehandle, session%count)
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
3564 end subroutine dbasession_ingest_metaanddatai
3568 subroutine dbasession_ingest_metaanddataiv(session,metaanddatav)
3569 class(dbasession),
intent(inout) :: session
3570 type(dbametaanddatai),
intent(inout),
allocatable :: metaanddatav(:)
3574 call session%ingest_metaanddatai()
3575 if (c_e(session%count))
then 3576 allocate(metaanddatav(session%count))
3578 do while (session%count >0)
3580 call session%ingest_metaanddatai(metaanddatav(i))
3583 allocate(metaanddatav(0))
3586 end subroutine dbasession_ingest_metaanddataiv
3590 subroutine dbasession_ingest_metaanddatab(session,metaanddata)
3591 class(dbasession),
intent(inout) :: session
3592 type(dbametaanddatab),
intent(inout),
optional :: metaanddata
3595 character(len=9) :: btable
3596 integer(kind=int_b) :: value
3598 if (.not.
present(metaanddata))
then 3599 ier = idba_voglioquesto(session%sehandle, session%count)
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
3607 end subroutine dbasession_ingest_metaanddatab
3611 subroutine dbasession_ingest_metaanddatabv(session,metaanddatav)
3612 class(dbasession),
intent(inout) :: session
3613 type(dbametaanddatab),
intent(inout),
allocatable :: metaanddatav(:)
3617 call session%ingest_metaanddatab()
3618 if (c_e(session%count))
then 3619 allocate(metaanddatav(session%count))
3621 do while (session%count >0)
3623 call session%ingest_metaanddatab(metaanddatav(i))
3626 allocate(metaanddatav(0))
3629 end subroutine dbasession_ingest_metaanddatabv
3633 subroutine dbasession_ingest_metaanddatad(session,metaanddata)
3634 class(dbasession),
intent(inout) :: session
3635 type(dbametaanddatad),
intent(inout),
optional :: metaanddata
3638 character(len=9) :: btable
3639 doubleprecision :: value
3641 if (.not.
present(metaanddata))
then 3642 ier = idba_voglioquesto(session%sehandle, session%count)
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
3650 end subroutine dbasession_ingest_metaanddatad
3654 subroutine dbasession_ingest_metaanddatadv(session,metaanddatav)
3655 class(dbasession),
intent(inout) :: session
3656 type(dbametaanddatad),
intent(inout),
allocatable :: metaanddatav(:)
3660 call session%ingest_metaanddatad()
3661 if (c_e(session%count))
then 3662 allocate(metaanddatav(session%count))
3664 do while (session%count >0)
3666 call session%ingest_metaanddatad(metaanddatav(i))
3669 allocate(metaanddatav(0))
3671 end subroutine dbasession_ingest_metaanddatadv
3675 subroutine dbasession_ingest_metaanddatar(session,metaanddata)
3676 class(dbasession),
intent(inout) :: session
3677 type(dbametaanddatar),
intent(inout),
optional :: metaanddata
3680 character(len=9) :: btable
3683 if (.not.
present(metaanddata))
then 3684 ier = idba_voglioquesto(session%sehandle, session%count)
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
3692 end subroutine dbasession_ingest_metaanddatar
3696 subroutine dbasession_ingest_metaanddatarv(session,metaanddatav)
3697 class(dbasession),
intent(inout) :: session
3698 type(dbametaanddatar),
intent(inout),
allocatable :: metaanddatav(:)
3702 call session%ingest_metaanddatar()
3703 if (c_e(session%count))
then 3704 allocate(metaanddatav(session%count))
3706 do while (session%count >0)
3708 call session%ingest_metaanddatar(metaanddatav(i))
3711 allocate(metaanddatav(0))
3713 end subroutine dbasession_ingest_metaanddatarv
3718 subroutine dbasession_ingest_metaanddatac(session,metaanddata)
3719 class(dbasession),
intent(inout) :: session
3720 type(dbametaanddatac),
intent(inout),
optional :: metaanddata
3723 character(len=9) :: btable
3724 character(len=255) :: value
3726 if (.not.
present(metaanddata))
then 3727 ier = idba_voglioquesto(session%sehandle, session%count)
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
3735 end subroutine dbasession_ingest_metaanddatac
3739 subroutine dbasession_ingest_metaanddatacv(session,metaanddatav)
3740 class(dbasession),
intent(inout) :: session
3741 type(dbametaanddatac),
intent(inout),
allocatable :: metaanddatav(:)
3745 call session%ingest_metaanddatac()
3746 if (c_e(session%count))
then 3747 allocate(metaanddatav(session%count))
3749 do while (session%count >0)
3751 call session%ingest_metaanddatac(metaanddatav(i))
3754 allocate(metaanddatav(session%count))
3756 end subroutine dbasession_ingest_metaanddatacv
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
3767 character(len=50) :: quiuser,quipassword
3769 character(len=512) :: a_name,quidsn
3771 if (
present(categoryappend))
then 3772 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
3774 call l4f_launcher(a_name,a_name_append=trim(subcategory))
3776 dbaconnection_init%category=l4f_category_get(a_name)
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)
3783 ier=idba_error_set_callback(0,dballe_error_handler, &
3784 dbaconnection_init%category,dbaconnection_init%handle_err)
3786 if (.not. c_e(optio_i(idbhandle)))
then 3791 IF (
PRESENT(dsn))
THEN 3792 IF (c_e(dsn)) quidsn = dsn
3794 IF (
PRESENT(user))
THEN 3795 IF (c_e(user)) quiuser = user
3797 IF (
PRESENT(password))
THEN 3798 IF (c_e(password)) quipassword = password
3801 #ifdef HAVE_DBALLEF_MOD 3802 ier=idba_presentati(dbaconnection_init%dbhandle,quidsn)
3804 ier=idba_presentati(dbaconnection_init%dbhandle,quidsn,quiuser,quipassword)
3807 dbaconnection_init%dbhandle=optio_i(idbhandle)
3810 end function dbaconnection_init
3813 subroutine dbaconnection_delete(handle)
3817 if (c_e(handle%dbhandle))
then 3818 ier = idba_arrivederci(handle%dbhandle)
3819 ier = idba_error_remove_callback(handle%handle_err)
3823 end subroutine dbaconnection_delete
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
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
3861 if (
present(categoryappend))
then 3862 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
3864 call l4f_launcher(a_name,a_name_append=trim(subcategory))
3866 dbasession_init%category=l4f_category_get(a_name)
3870 if (
present(write))
then 3876 if (
present(wipe))
then 3878 if (
present(repinfo))
then 3887 if (
present(template))
then 3894 if (
present(simplified))
then 3895 lsimplified=simplified
3899 if (
present(format))
then 3905 if (
present(filename))
then 3909 IF (filename ==
'')
THEN 3913 INQUIRE(file=filename,exist=exist)
3917 if (lwipe.or..not.exist)
then 3921 call l4f_category_log(dbasession_init%category,l4f_info,
"file exists; appending data to file")
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()
3930 if (
present(mode)) lmode = mode
3932 if (.not.
present(memdb))
then 3933 dbasession_init%memdb=.true.
3936 if (.not.
present(loadfile))
then 3937 dbasession_init%loadfile=.true.
3942 if (
present(memdb))
then 3946 if (
present(loadfile))
then 3951 call optio(anaflag,lanaflag)
3952 if (.not. c_e(lanaflag))
then 3960 call optio(dataflag,ldataflag)
3961 if (.not. c_e(ldataflag))
then 3969 call optio(attrflag,lattrflag)
3970 if (.not. c_e(lattrflag))
then 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")
3993 if(.not.
present(connection))
then 3994 call l4f_category_log(dbasession_init%category,l4f_error,
"connection not present accessing DBA")
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")
4008 if (
present(filename))
then 4010 if (.not.
present(connection))
then 4014 dbasession_init=
dbasession(dbasession_init%memconnection,&
4015 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
4016 memdb=lmemdb,loadfile=lloadfile)
4019 dbasession_init%memconnection=connection
4021 dbasession_init=
dbasession(dbasession_init%memconnection,&
4022 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
4023 memdb=lmemdb,loadfile=lloadfile)
4027 if (lmode ==
"r")
then 4028 call dbasession_init%messages_open_input(filename=filename,mode=lmode,&
4029 format=lformat,simplified=lsimplified)
4032 read_next = dbasession_init%messages_read_next()
4033 do while (read_next)
4034 read_next = dbasession_init%messages_read_next()
4039 call dbasession_init%messages_open_output(filename=filename,&
4040 mode=lmode,format=lformat)
4046 ier = idba_messaggi(dbasession_init%sehandle,filename, lmode, lformat)
4052 ier = idba_preparati(connection%dbhandle,dbasession_init%sehandle, lanaflag, ldataflag, lattrflag)
4053 if (lwipe)ier=idba_scopa(dbasession_init%sehandle,lrepinfo)
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
4077 end function dbasession_init
4081 subroutine dbasession_unsetall(session)
4085 if (c_e(session%sehandle))
then 4086 ier = idba_unsetall(session%sehandle)
4089 end subroutine dbasession_unsetall
4093 subroutine dbasession_remove_all(session)
4097 if (c_e(session%sehandle))
then 4098 ier = idba_remove_all(session%sehandle)
4101 end subroutine dbasession_remove_all
4105 subroutine dbasession_prendilo(session)
4109 if (c_e(session%sehandle))
then 4110 ier = idba_prendilo(session%sehandle)
4113 end subroutine dbasession_prendilo
4116 subroutine dbasession_var_related(session,btable)
4118 character(len=*),
INTENT(IN) :: btable
4121 if (c_e(session%sehandle))
then 4122 ier = idba_set(session%sehandle,
"*var_related",btable)
4125 end subroutine dbasession_var_related
4128 subroutine dbasession_setcontextana(session)
4132 if (c_e(session%sehandle))
then 4133 ier = idba_setcontextana(session%sehandle)
4136 end subroutine dbasession_setcontextana
4139 subroutine dbasession_dimenticami(session)
4143 if (c_e(session%sehandle))
then 4144 ier = idba_dimenticami(session%sehandle)
4147 end subroutine dbasession_dimenticami
4150 subroutine dbasession_critica(session)
4154 if (c_e(session%sehandle))
then 4155 ier = idba_critica(session%sehandle)
4158 end subroutine dbasession_critica
4161 subroutine dbasession_scusa(session)
4165 if (c_e(session%sehandle))
then 4166 ier = idba_scusa(session%sehandle)
4169 end subroutine dbasession_scusa
4172 subroutine dbasession_set(session,metadata,datav,data,datetime,ana,network,level,timerange,filter)
4175 class(
dbadcv),
optional :: datav
4176 class(
dbadata),
optional :: data
4178 type(
dbaana),
optional :: ana
4184 if (
present(metadata))
then 4185 call metadata%dbaset(session)
4188 if (
present(datetime))
then 4189 call datetime%dbaset(session)
4192 if (
present(ana))
then 4193 call ana%dbaset(session)
4196 if (
present(network))
then 4197 call network%dbaset(session)
4200 if (
present(level))
then 4201 call level%dbaset(session)
4204 if (
present(timerange))
then 4205 call timerange%dbaset(session)
4208 if (
present(datav))
then 4209 call datav%dbaset(session)
4212 if (
present(data))
then 4213 call data%dbaset(session)
4216 if (
present(filter))
then 4217 call filter%dbaset(session)
4220 end subroutine dbasession_set
4379 subroutine dbasession_delete(session)
4382 type(dbasession) :: defsession
4384 if (c_e(session%sehandle))
then 4385 ier = idba_fatto(session%sehandle)
4388 call session%memconnection%delete()
4390 select type (session)
4392 session = defsession
4406 end subroutine dbasession_delete
4410 subroutine dbasession_filerewind(session)
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)
4426 end subroutine dbasession_filerewind
4429 FUNCTION dballe_error_handler(category)
4430 INTEGER :: category, code, l4f_level
4431 INTEGER :: dballe_error_handler
4433 CHARACTER(len=1000) :: message, buf
4435 code = idba_error_code()
4438 if (code == 13 )
then 4444 call idba_error_message(message)
4445 call l4f_category_log(category,l4f_level,trim(message))
4447 call idba_error_context(buf)
4449 call l4f_category_log(category,l4f_level,trim(buf))
4451 call idba_error_details(buf)
4452 call l4f_category_log(category,l4f_info,trim(buf))
4456 if (l4f_level == l4f_error )
CALL raise_fatal_error(
"dballe: "//message)
4458 dballe_error_handler = 0
4461 END FUNCTION dballe_error_handler
Function to check whether a value is missing or not.
container for dbadata (used for promiscuous vector of data)
Class for expressing an absolute time value.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione dell'anagrafica di stazioni meteo e affini.
abstract class to use lists in fortran 2003.
Import one or more geo_coordvect objects from a plain text file or for a file in ESRI/Shapefile forma...
Classi per la gestione delle coordinate temporali.
vector of container of dbadata
double linked list of ana
Definisce la rete a cui appartiene una stazione.
Definisce l'intervallo temporale di un'osservazione meteo.
character version for dbadata
doubleprecision version for dbadata
print a summary of object contents
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Classes for handling georeferenced sparse points in geographical corodinates.
Classe per la gestione delle reti di stazioni per osservazioni meteo e affini.
vector of dbadataattr (more data plus attributes)
filter to apply before ingest data
base (abstract) type for data
Definisce l'anagrafica di una stazione.
manage connection handle to a DSN
Classe per la gestione di un volume completo di dati osservati.
Definisce il livello verticale di un'osservazione.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. ...
Abstract implementation of doubly-linked list.
Definitions of constants and functions for working with missing values.
integer version for dbadata
class for import and export data from e to DB-All.e.
classe per la gestione del logging
Derived type defining an isolated georeferenced point on Earth in polar geographical coordinates...
fortran 2003 interface to geo_coord