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.
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
175 type,public,extends(vol7d_level) ::
dbalevel
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
216 type,public,extends(geo_coord) ::
dbacoord
224 # ifdef F2003_FULL_FEATURES
229 procedure ::
display => dbacoord_display
235 procedure dbacoord_init
239 type,public,extends(vol7d_ana) ::
dbaana
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
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
357 procedure ::
display => dbadatai_display
362 procedure :: dbadatai_init
369 procedure :: dbadata_getr => dbadatar_getr
370 procedure :: dbaset => dbadatar_set
371 procedure ::
display => dbadatar_display
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
419 procedure ::
display => dbadatac_display
424 procedure :: dbadatac_init
435 # ifdef F2003_FULL_FEATURES
440 procedure :: dbaset => dbametadata_set
441 procedure :: dbaenq => dbametadata_enq
442 procedure :: dbacontextana => dbametadata_contextana
444 procedure :: equal => dbametadata_equal
445 generic :: operator(==) => equal
450 procedure dbametadata_init
454 type, public ::
dbadc
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
486 procedure ::
display => dbadataattrv_display
487 procedure :: extrude => dbadataattrv_extrude
495 procedure ::
display => dbametaanddata_display
496 procedure :: extrude => dbametaanddata_extrude
504 procedure ::
display => dbametaanddatav_display
505 procedure :: extrude => dbametaanddatav_extrude
511 procedure :: current => currentdbametaanddata
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
552 procedure ::
display => dbametaanddatad_display
553 procedure :: extrude => dbametaanddatad_extrude
559 procedure :: current => currentdbametaanddatad
560 procedure ::
display => displaydbametaanddatad
561 procedure :: toarray => toarray_dbametaanddatad
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
614 type(dbadcv) :: vars,starvars
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
649 class(*),
pointer :: v
651 v => this%currentpoli()
654 currentdbametaanddata = v
656 end function currentdbametaanddata
660 elemental logical function dbadata_equal(this,that)
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)
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)
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)
742 class(
dbadata),
intent(in) ::
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)
756 class(
dbadata),
intent(in) ::
data
757 INTEGER(kind=int_b),
intent(out) :: value
765 end subroutine dbadata_getb
768 logical function dbadata_c_e_b(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)
782 class(
dbadata),
intent(in) ::
data
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
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)
874 class(
dbaana),
intent(in) :: 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
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
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
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)
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
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)
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
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)
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)
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)
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)
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)
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)
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)
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)
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)
1424 do i=1,
size(dataattr%dataattr)
1425 call dataattr%dataattr(i)%display()
1428 end subroutine dbadataattrv_display
1431 subroutine dbadatai_geti(data,value)
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
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
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
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
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
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)
1665 call
display(timerange%vol7d_timerange)
1666 end subroutine dbatimerange_display
1669 subroutine dbatimerange_set(timerange,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
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
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)
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)
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)
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)
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
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
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
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)
2553 logical,
intent(in),
optional :: noattr
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)
2577 logical,
intent(in),
optional :: noattr
2578 type(
dbafilter),
intent(in),
optional :: filter
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)
2600 do while(this%element())
2601 print *,
"index:",this%currentindex(),
" value:"
2602 element=this%current()
2603 call element%display()
2606 end subroutine displaydbametaanddatai
2611 class(*),
pointer :: v
2613 v => this%currentpoli()
2616 currentdbametaanddatai = v
2618 end function currentdbametaanddatai
2622 subroutine dbasession_ingest_metaanddatail(session,metaanddatal,filter)
2625 type(
dbafilter),
intent(in),
optional :: filter
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)
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
2690 class(*),
pointer :: v
2692 v => this%currentpoli()
2695 currentdbametaanddatar = v
2697 end function currentdbametaanddatar
2701 subroutine dbasession_ingest_metaanddatarl(session,metaanddatal,filter)
2704 type(
dbafilter),
intent(in),
optional :: filter
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)
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)
2760 do while(this%element())
2761 print *,
"index:",this%currentindex(),
" value:"
2762 element=this%current()
2763 call element%display()
2766 end subroutine displaydbametaanddatad
2771 class(*),
pointer :: v
2773 v => this%currentpoli()
2776 currentdbametaanddatad = v
2778 end function currentdbametaanddatad
2781 subroutine dbasession_ingest_metaanddatadl(session,metaanddatal,filter)
2784 type(
dbafilter),
intent(in),
optional :: filter
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)
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
2849 class(*),
pointer :: v
2851 v => this%currentpoli()
2854 currentdbametaanddatab = v
2856 end function currentdbametaanddatab
2860 subroutine dbasession_ingest_metaanddatabl(session,metaanddatal,filter)
2863 type(
dbafilter),
intent(in),
optional :: filter
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)
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
2928 class(*),
pointer :: v
2930 v => this%currentpoli()
2933 currentdbametaanddatac = v
2935 end function currentdbametaanddatac
2939 subroutine dbasession_ingest_metaanddatacl(session,metaanddatal,filter)
2942 type(
dbafilter),
intent(in),
optional :: filter
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)
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)
3003 call data%metadata%display()
3004 call data%dbadatab%display()
3006 end subroutine dbametaanddatab_display
3009 subroutine dbametaanddatad_display(data)
3012 call data%metadata%display()
3013 call data%dbadatad%display()
3015 end subroutine dbametaanddatad_display
3018 subroutine dbametaanddatar_display(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)
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)
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)
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)
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)
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)
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)
3455 type(dbametaanddata),
intent(inout),
allocatable :: metaanddatav(:)
3456 logical,
intent(in),
optional :: noattr
3457 type(
dbafilter),
intent(in),
optional :: filter
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)
3504 logical,
intent(in),
optional :: noattr
3505 type(
dbafilter),
intent(in),
optional :: filter
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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
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
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)
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)
4447 call idba_error_context(buf)
4451 call idba_error_details(buf)
4456 if (l4f_level == l4f_error ) CALL raise_fatal_error(
"dballe: "//message)
4458 dballe_error_handler = 0
4461 END FUNCTION dballe_error_handler
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.
Import one or more geo_coordvect objects from a plain text file or for a file in ESRI/Shapefile forma...
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
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
character version for dbadata
doubleprecision version for dbadata
print a summary of object contents
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
base (abstract) type for data
Restituiscono il valore dell'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'anagrafica di stazioni meteo e affini.
abstract class to use lists in fortran 2003.
integer version for dbadata
classe per la gestione del logging
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Emit log message for a category with specific priority.
fortran 2003 interface to geo_coord