62 character (len=255),
parameter:: subcategory=
"dballe_class" 66 integer :: dbhandle=imiss
67 integer :: handle_err=imiss
70 # ifdef F2003_FULL_FEATURES 71 final :: dbaconnection_delete
73 procedure :: delete => dbaconnection_delete
79 procedure dbaconnection_init
84 integer :: sehandle=imiss
85 logical :: file=.false.
86 character(len=40) :: template=
'generic' 87 character(len=255) :: filename=cmiss
88 character(len=40) :: mode=cmiss
89 character(len=40) :: format=cmiss
90 logical :: simplified=.true.
91 logical :: memdb=.false.
92 logical :: loadfile=.false.
93 type(dbaconnection) :: memconnection
95 integer :: count=imiss
97 # ifdef F2003_FULL_FEATURES 98 final :: dbasession_delete
100 procedure :: delete => dbasession_delete
102 procedure :: unsetall => dbasession_unsetall
103 procedure :: remove_all => dbasession_remove_all
104 procedure :: set => dbasession_set
105 procedure :: setcontextana => dbasession_setcontextana
106 procedure :: dimenticami => dbasession_dimenticami
119 procedure :: prendilo => dbasession_prendilo
120 procedure :: var_related => dbasession_var_related
121 procedure :: critica => dbasession_critica
122 procedure :: scusa => dbasession_scusa
123 procedure :: messages_open_input => dbasession_messages_open_input
124 procedure :: messages_open_output => dbasession_messages_open_output
125 procedure :: messages_read_next => dbasession_messages_read_next
126 procedure :: messages_write_next => dbasession_messages_write_next
127 procedure :: close_message => dbasession_close_message
128 procedure :: unsetb => dbasession_unsetb
129 procedure :: filerewind => dbasession_filerewind
130 procedure :: ingest_ana => dbasession_ingest_ana
131 procedure :: ingest_anav => dbasession_ingest_anav
132 procedure :: ingest_anal => dbasession_ingest_anal
133 procedure :: ingest_metaanddata => dbasession_ingest_metaanddata
134 procedure :: ingest_metaanddatal => dbasession_ingest_metaanddatal
135 procedure :: ingest_metaanddatav => dbasession_ingest_metaanddatav
136 procedure :: ingest_metaanddatai => dbasession_ingest_metaanddatai
137 procedure :: ingest_metaanddataiv => dbasession_ingest_metaanddataiv
138 procedure :: ingest_metaanddatail => dbasession_ingest_metaanddatail
139 procedure :: ingest_metaanddatab => dbasession_ingest_metaanddatab
140 procedure :: ingest_metaanddatabv => dbasession_ingest_metaanddatabv
141 procedure :: ingest_metaanddatabl => dbasession_ingest_metaanddatabl
142 procedure :: ingest_metaanddatad => dbasession_ingest_metaanddatad
143 procedure :: ingest_metaanddatadv => dbasession_ingest_metaanddatadv
144 procedure :: ingest_metaanddatadl => dbasession_ingest_metaanddatadl
145 procedure :: ingest_metaanddatar => dbasession_ingest_metaanddatar
146 procedure :: ingest_metaanddatarv => dbasession_ingest_metaanddatarv
147 procedure :: ingest_metaanddatarl => dbasession_ingest_metaanddatarl
148 procedure :: ingest_metaanddatac => dbasession_ingest_metaanddatac
149 procedure :: ingest_metaanddatacv => dbasession_ingest_metaanddatacv
150 procedure :: ingest_metaanddatacl => dbasession_ingest_metaanddatacl
151 procedure :: dissolve_metadata => dbasession_dissolve_metadata
152 procedure :: dissolveattr => dbasession_dissolveattr_metadata
153 generic :: dissolve => dissolve_metadata ,dimenticami
154 generic :: ingesta => ingest_ana, ingest_anav,ingest_anal
155 generic :: ingest => ingest_metaanddata,ingest_metaanddatav,ingest_metaanddatal,&
157 ingest_metaanddataiv,ingest_metaanddatabv,ingest_metaanddatadv,ingest_metaanddatarv,ingest_metaanddatacv,&
158 ingest_metaanddatail,ingest_metaanddatarl,ingest_metaanddatadl,ingest_metaanddatabl,ingest_metaanddatacl
166 procedure dbasession_init
173 # ifdef F2003_FULL_FEATURES 178 procedure :: display => dbalevel_display
179 procedure :: dbaset => dbalevel_set
180 procedure :: dbaenq => dbalevel_enq
181 procedure,
nopass :: dbacontextana => dbalevel_contextana
187 procedure dbalevel_init
193 # ifdef F2003_FULL_FEATURES 198 procedure :: display => dbatimerange_display
199 procedure :: dbaset => dbatimerange_set
200 procedure :: dbaenq => dbatimerange_enq
201 procedure,
nopass :: dbacontextana => dbatimerange_contextana
207 procedure dbatimerange_init
219 # ifdef F2003_FULL_FEATURES 224 procedure :: display => dbacoord_display
230 procedure dbacoord_init
237 # ifdef F2003_FULL_FEATURES 242 procedure :: display => dbaana_display
243 procedure :: dbaset => dbaana_set
244 procedure :: dbaenq => dbaana_enq
245 procedure :: extrude => dbaana_extrude
250 procedure dbaana_init
256 procedure :: current => currentdbaana
257 procedure :: display => displaydbaana
270 # ifdef F2003_FULL_FEATURES 275 procedure ::
display => dbanetwork_display
276 procedure :: dbaset => dbanetwork_set
277 procedure :: dbaenq => dbanetwork_enq
283 procedure dbanetwork_init
291 # ifdef F2003_FULL_FEATURES 296 procedure ::
display => dbadatetime_display
297 procedure :: dbaset => dbadatetime_set
298 procedure :: dbaenq => dbadatetime_enq
299 procedure,
nopass :: dbacontextana => dbadatetime_contextana
304 procedure dbadatetime_init
309 type,
public,
abstract ::
dbadata 310 character(len=9) :: btable
313 procedure :: dbadata_geti
314 procedure :: dbadata_getr
315 procedure :: dbadata_getd
316 procedure :: dbadata_getb
317 procedure :: dbadata_getc
318 generic :: get => dbadata_geti,dbadata_getr,dbadata_getd,dbadata_getb,dbadata_getc
319 procedure :: dbadata_c_e_i
320 procedure :: dbadata_c_e_r
321 procedure :: dbadata_c_e_d
322 procedure :: dbadata_c_e_b
323 procedure :: dbadata_c_e_c
324 procedure ::
c_e => dbadata_c_e
326 procedure :: equal => dbadata_equal
327 generic ::
operator (==) => equal
350 procedure :: dbadata_geti => dbadatai_geti
351 procedure :: dbaset => dbadatai_set
357 procedure :: dbadatai_init
364 procedure :: dbadata_getr => dbadatar_getr
365 procedure :: dbaset => dbadatar_set
366 procedure ::
display => dbadatar_display
371 procedure :: dbadatar_init
377 doubleprecision :: value
379 procedure :: dbadata_getd => dbadatad_getd
380 procedure :: dbaset => dbadatad_set
381 procedure ::
display => dbadatad_display
386 procedure :: dbadatad_init
392 integer(kind=int_b) :: value
394 procedure :: dbadata_getb => dbadatab_getb
395 procedure :: dbaset => dbadatab_set
401 procedure :: dbadatab_init
409 character(vol7d_cdatalen) :: value
412 procedure :: dbadata_getc => dbadatac_getc
413 procedure :: dbaset => dbadatac_set
414 procedure :: display => dbadatac_display
419 procedure :: dbadatac_init
424 type(dbalevel) :: level
425 type(dbatimerange) :: timerange
427 type(dbanetwork) :: network
428 type(dbadatetime) :: datetime
430 # ifdef F2003_FULL_FEATURES 435 procedure :: dbaset => dbametadata_set
436 procedure :: dbaenq => dbametadata_enq
437 procedure :: dbacontextana => dbametadata_contextana
438 procedure :: display => dbametadata_display
439 procedure :: equal => dbametadata_equal
440 generic ::
operator (==) => equal
445 procedure dbametadata_init
449 type,
public ::
dbadc 450 class(
dbadata),
allocatable :: dat
452 procedure :: display => dbadc_display
453 procedure :: dbaset => dbadc_set
454 procedure :: extrude => dbadc_extrude
460 type(dbadc),
allocatable :: dcv(:)
462 procedure :: display => dbadcv_display
463 procedure :: dbaset => dbadcv_set
464 procedure :: extrude => dbadcv_extrude
465 procedure :: equal => dbadcv_equal_dbadata
466 generic ::
operator (==) => equal
471 type(dbadcv) :: attrv
474 procedure :: extrude => dbadataattr_extrude
481 procedure ::
display => dbadataattrv_display
482 procedure :: extrude => dbadataattrv_extrude
487 type(dbametadata) :: metadata
488 type(dbadataattrv) ::dataattrv
490 procedure :: display => dbametaanddata_display
491 procedure :: extrude => dbametaanddata_extrude
499 procedure ::
display => dbametaanddatav_display
500 procedure :: extrude => dbametaanddatav_extrude
506 procedure :: current => currentdbametaanddata
507 procedure :: display => displaydbametaanddata
508 procedure :: extrude => dbametaanddatal_extrude
515 procedure ::
display => dbametaanddatai_display
516 procedure :: extrude => dbametaanddatai_extrude
522 procedure :: current => currentdbametaanddatai
523 procedure ::
display => displaydbametaanddatai
524 procedure :: toarray => toarray_dbametaanddatai
531 procedure :: display => dbametaanddatab_display
532 procedure :: extrude => dbametaanddatab_extrude
538 procedure :: current => currentdbametaanddatab
539 procedure :: display => displaydbametaanddatab
540 procedure :: toarray => toarray_dbametaanddatab
545 type(dbametadata) :: metadata
547 procedure :: display => dbametaanddatad_display
548 procedure :: extrude => dbametaanddatad_extrude
554 procedure :: current => currentdbametaanddatad
555 procedure ::
display => displaydbametaanddatad
556 procedure :: toarray => toarray_dbametaanddatad
563 procedure ::
display => dbametaanddatar_display
564 procedure :: extrude => dbametaanddatar_extrude
570 procedure :: current => currentdbametaanddatar
571 procedure ::
display => displaydbametaanddatar
572 procedure :: toarray => toarray_dbametaanddatar
579 procedure ::
display => dbametaanddatac_display
580 procedure :: extrude => dbametaanddatac_extrude
586 procedure :: current => currentdbametaanddatac
587 procedure ::
display => displaydbametaanddatac
588 procedure :: toarray => toarray_dbametaanddatac
594 character(len=6) :: var
603 character(len=255) :: ana_filter, data_filter, attr_filter, varlist, starvarlist, anavarlist, anastarvarlist
604 character(len=40) :: query
605 integer :: priority,priomin,priomax
606 logical :: contextana
609 type(dbadcv) :: vars,starvars
613 procedure :: dbaset => dbafilter_set
614 procedure :: equalmetadata => dbafilter_equal_dbametadata
617 generic ::
operator (==) => equalmetadata
622 procedure dbafilter_init
628 subroutine displaydbametaanddata(this)
629 class(dbametaanddataList),
intent(inout) :: this
630 type(dbametaanddata) :: element
633 do while(this%element())
634 print *,
"index:",this%currentindex(),
" value:" 635 element=this%current()
636 call element%display()
639 end subroutine displaydbametaanddata
644 class(*),
pointer :: v
646 v => this%currentpoli()
649 currentdbametaanddata = v
651 end function currentdbametaanddata
655 elemental logical function dbadata_equal(this,that)
657 class(dbadata),
intent(in) :: this
658 class(dbadata),
intent(in) :: that
660 if ( this%btable == that%btable )
then 661 dbadata_equal = .true.
663 dbadata_equal = .false.
666 end function dbadata_equal
670 subroutine dbadata_geti(data,value)
672 integer,
intent(out) ::
value 680 end subroutine dbadata_geti
684 logical function dbadata_c_e_i(data)
685 class(dbadata),
intent(in) :: data
687 dbadata_c_e_i=.false.
691 dbadata_c_e_i = c_e(data%value)
694 end function dbadata_c_e_i
697 subroutine dbadata_getr(data,value)
699 real,
intent(out) ::
value 707 end subroutine dbadata_getr
710 logical function dbadata_c_e_r(data)
711 class(dbadata),
intent(in) :: data
713 dbadata_c_e_r=.false.
717 dbadata_c_e_r = c_e(data%value)
720 end function dbadata_c_e_r
723 subroutine dbadata_getd(data,value)
724 class(
dbadata),
intent(in) :: data
725 doubleprecision,
intent(out) ::
value 733 end subroutine dbadata_getd
736 logical function dbadata_c_e_d(data)
739 dbadata_c_e_d=.false.
743 dbadata_c_e_d = c_e(data%value)
746 end function dbadata_c_e_d
750 subroutine dbadata_getb(data,value)
751 class(dbadata),
intent(in) :: data
752 INTEGER(kind=int_b),
intent(out) ::
value 760 end subroutine dbadata_getb
763 logical function dbadata_c_e_b(data)
764 class(
dbadata),
intent(in) :: data
766 dbadata_c_e_b=.false.
770 dbadata_c_e_b = c_e(data%value)
773 end function dbadata_c_e_b
776 subroutine dbadata_getc(data,value)
778 character(len=*),
intent(out) ::
value 786 end subroutine dbadata_getc
790 logical function dbadata_c_e_c(data)
791 class(dbadata),
intent(in) :: data
793 dbadata_c_e_c=.false.
797 dbadata_c_e_c = c_e(data%value)
800 end function dbadata_c_e_c
804 logical function dbadata_c_e(data)
805 class(dbadata),
intent(in) :: data
807 dbadata_c_e=data%dbadata_c_e_i() .or. data%dbadata_c_e_r() .or. data%dbadata_c_e_d() &
808 .or. data%dbadata_c_e_b() .or. data%dbadata_c_e_c()
810 end function dbadata_c_e
814 subroutine dbalevel_display(level)
816 call display (level%vol7d_level)
817 end subroutine dbalevel_display
821 type(
dbalevel) function dbalevel_init(level1, l1, level2, l2)
823 INTEGER,
INTENT(IN),
OPTIONAL :: level1
824 INTEGER,
INTENT(IN),
OPTIONAL :: l1
825 INTEGER,
INTENT(IN),
OPTIONAL :: level2
826 INTEGER,
INTENT(IN),
OPTIONAL :: l2
828 call init (dbalevel_init%vol7d_level,level1, l1, level2, l2)
829 end function dbalevel_init
832 subroutine dbalevel_set(level,session)
833 class(dbalevel),
intent(in) :: level
834 type(dbasession),
intent(in) :: session
838 ier = idba_setlevel(session%sehandle,&
839 level%level1, level%l1, level%level2, level%l2)
842 if (.not. c_e(level%vol7d_level))
then 843 call session%setcontextana
846 end subroutine dbalevel_set
849 subroutine dbalevel_enq(level,session)
850 class(
dbalevel),
intent(out) :: level
854 ier = idba_enqlevel(session%sehandle,&
855 level%level1, level%l1, level%level2, level%l2)
857 end subroutine dbalevel_enq
860 type(
dbalevel) function dbalevel_contextana()
864 end function dbalevel_contextana
868 subroutine dbaana_display(ana)
869 class(dbaana),
intent(in) :: ana
870 call display (ana%vol7d_ana)
871 end subroutine dbaana_display
876 type(dbacoord) function dbacoord_init(lon, lat, ilon, ilat)
877 REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lon
878 REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lat
879 INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilon
880 INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilat
882 CALL init(dbacoord_init%geo_coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
884 end function dbacoord_init
887 subroutine dbacoord_display(coord)
888 class(
dbacoord),
intent(in) :: coord
889 call display (coord%geo_coord)
890 end subroutine dbacoord_display
894 type(
dbaana) function dbaana_init(coord,ident,lon, lat, ilon, ilat)
895 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: ident
896 TYPE(dbacoord),
INTENT(IN),
optional :: coord
897 REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lon
898 REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lat
899 INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilon
900 INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilat
902 if (
present(coord))
then 903 CALL init(dbaana_init%vol7d_ana, ilon=getilon(coord%geo_coord), ilat=getilat(coord%geo_coord), ident=ident)
905 CALL init(dbaana_init%vol7d_ana, lon=lon, lat=lat, ilon=ilon, ilat=ilat, ident=ident)
908 end function dbaana_init
911 subroutine dbaana_set(ana,session)
912 class(
dbaana),
intent(in) :: ana
917 ier = idba_set(session%sehandle,
"lat",getilat(ana%vol7d_ana%coord))
918 ier = idba_set(session%sehandle,
"lon",getilon(ana%vol7d_ana%coord))
919 if (c_e(ana%vol7d_ana%ident))
then 920 ier = idba_set(session%sehandle,
"ident",ana%vol7d_ana%ident)
921 ier = idba_set(session%sehandle,
"mobile",1)
923 ier = idba_set(session%sehandle,
"ident",cmiss)
924 ier = idba_set(session%sehandle,
"mobile",imiss)
927 end subroutine dbaana_set
930 subroutine dbaana_enq(ana,session)
931 class(dbaana),
intent(out) :: ana
932 type(dbasession),
intent(in) :: session
933 integer :: ier,ilat,ilon
936 ier = idba_enq(session%sehandle,
"lat",ilat)
937 ier = idba_enq(session%sehandle,
"lon",ilon)
939 call init(ana%vol7d_ana%coord,ilon=ilon,ilat=ilat)
940 ier = idba_enq(session%sehandle,
"ident",ana%vol7d_ana%ident)
942 end subroutine dbaana_enq
946 subroutine dbaana_extrude(ana,session)
947 class(
dbaana),
intent(in) :: ana
950 call session%unsetall()
952 call session%set(ana=ana)
953 call session%prendilo()
956 call session%close_message()
958 end subroutine dbaana_extrude
962 subroutine displaydbaana(this)
967 do while(this%element())
968 print *,
"index:",this%currentindex(),
" value:" 969 element=this%current()
970 call element%display()
973 end subroutine displaydbaana
976 type(
dbaana) function currentdbaana(this)
978 class(*),
pointer :: v
980 v => this%currentpoli()
985 end function currentdbaana
989 subroutine dbadc_set(dc,session)
990 class(
dbadc),
intent(in) :: dc
993 call dc%dat%dbaset(session)
995 end subroutine dbadc_set
998 subroutine dbadc_display(dc)
999 class(
dbadc),
intent(in) :: dc
1001 call dc%dat%display()
1003 end subroutine dbadc_display
1006 subroutine dbadcv_set(dcv,session)
1007 class(
dbadcv),
intent(in) :: dcv
1011 do i=1,
size(dcv%dcv)
1012 call dcv%dcv(i)%dbaset(session)
1015 end subroutine dbadcv_set
1020 subroutine dbadcv_extrude(dcv,session,noattr,filter,template)
1021 class(
dbadcv),
intent(in) :: dcv
1023 logical,
intent(in),
optional :: noattr
1024 type(
dbafilter),
intent(in),
optional :: filter
1025 character(len=*),
intent(in),
optional :: template
1028 do i=1,
size(dcv%dcv)
1029 call dcv%dcv(i)%extrude(session,noattr,filter,template=template)
1032 end subroutine dbadcv_extrude
1035 subroutine dbadc_extrude(data,session,noattr,filter,attronly,template)
1036 class(dbadc),
intent(in) :: data
1037 type(dbasession),
intent(in) :: session
1038 logical,
intent(in),
optional :: noattr
1039 type(dbafilter),
intent(in),
optional :: filter
1040 logical,
intent(in),
optional :: attronly
1041 character(len=*),
intent(in),
optional :: template
1043 call data%extrude(session,noattr,filter,attronly,template)
1045 end subroutine dbadc_extrude
1049 subroutine dbadcv_display(dcv)
1050 class(dbadcv),
intent(in) :: dcv
1053 if (
allocated(dcv%dcv))
then 1054 do i=1,
size(dcv%dcv)
1055 call dcv%dcv(i)%display()
1058 end subroutine dbadcv_display
1084 subroutine dbasession_unsetb(session)
1089 ier=idba_unsetb(session%sehandle)
1091 end subroutine dbasession_unsetb
1094 subroutine dbasession_close_message(session,template)
1095 class(dbasession),
intent(in) :: session
1096 character(len=*),
intent(in),
optional :: template
1098 character(len=40) :: ltemplate
1101 ltemplate=session%template
1102 if (
present(template)) ltemplate=template
1115 if (session%file)
then 1117 if (session%memdb)
then 1124 if (c_e(ltemplate))
then 1125 ier=idba_set(session%sehandle,
"query",
"message "//trim(ltemplate))
1127 ier=idba_set(session%sehandle,
"query",
"message")
1130 call session%unsetb()
1131 call session%prendilo()
1135 end subroutine dbasession_close_message
1139 subroutine dbasession_messages_open_input(session,filename,mode,format,simplified)
1140 class(dbasession),
intent(in) :: session
1141 character (len=*),
intent(in) :: filename
1142 character (len=*),
intent(in),
optional :: mode
1143 character (len=*),
intent(in),
optional :: format
1144 logical,
intent(in),
optional :: simplified
1147 character (len=40) :: lmode, lformat
1148 logical :: lsimplified
1151 if (
present(mode)) lmode=mode
1154 if (
present(format)) lformat=
format 1157 if (
present(simplified)) lsimplified=simplified
1159 ier = idba_messages_open_input(session%sehandle, filename, lmode, lformat, lsimplified)
1161 end subroutine dbasession_messages_open_input
1165 subroutine dbasession_messages_open_output(session,filename,mode,format)
1166 class(dbasession),
intent(in) :: session
1167 character (len=*),
intent(in) :: filename
1168 character (len=*),
intent(in),
optional :: mode
1169 character (len=*),
intent(in),
optional :: format
1172 character (len=40) :: lmode, lformat
1175 if (
present(mode)) lmode=mode
1178 if (
present(format)) lformat=
format 1180 ier = idba_messages_open_output(session%sehandle, filename, lmode, lformat)
1182 end subroutine dbasession_messages_open_output
1186 logical function dbasession_messages_read_next(session)
1191 ier = idba_messages_read_next(session%sehandle, dbasession_messages_read_next)
1193 end function dbasession_messages_read_next
1196 subroutine dbasession_messages_write_next(session,template)
1197 class(dbasession),
intent(in) :: session
1198 character(len=*),
optional :: template
1199 character(len=40) :: ltemplate
1206 ltemplate=session%template
1207 if (
present(template)) ltemplate=template
1209 ier = idba_messages_write_next(session%sehandle,ltemplate)
1211 end subroutine dbasession_messages_write_next
1215 subroutine dbasession_dissolve_metadata(session,metadata)
1216 class(dbasession),
intent(in) :: session
1217 type(dbametadata),
intent(in) :: metadata(:)
1221 do i =1,
size (metadata)
1223 call metadata(i)%dbaset(session)
1224 call session%dissolve()
1228 end subroutine dbasession_dissolve_metadata
1233 subroutine dbasession_dissolveattr_metadata(session,metadata)
1234 class(dbasession),
intent(in) :: session
1235 type(dbametadata),
intent(in),
optional :: metadata(:)
1237 character(len=9) :: btable
1238 integer :: i,ii,count,ier
1240 if (
present (metadata))
then 1241 do i =1,
size (metadata)
1244 call metadata(i)%dbaset(session)
1245 ier = idba_voglioquesto(session%sehandle, count)
1247 if (.not. c_e(count)) cycle
1249 ier = idba_dammelo(session%sehandle, btable)
1251 call session%scusa()
1257 ier = idba_voglioquesto(session%sehandle, count)
1259 if (c_e(count))
then 1261 ier = idba_dammelo(session%sehandle, btable)
1263 call session%scusa()
1267 end subroutine dbasession_dissolveattr_metadata
1271 subroutine dbadataattr_extrude(data,session,noattr,filter,attronly,template)
1272 class(dbadataattr),
intent(in) :: data
1273 type(dbasession),
intent(in) :: session
1274 logical,
intent(in),
optional :: noattr
1275 type(dbafilter),
intent(in),
optional :: filter
1276 logical,
intent(in),
optional :: attronly
1277 character(len=*),
intent(in),
optional :: template
1278 integer :: i,ierr,count,code
1280 character(len=9) :: btable
1283 if (session%file .and. optio_log(attronly))
then 1284 call l4f_category_log(session%category,l4f_error,
"attronly writing on file not supported")
1285 CALL raise_fatal_error()
1288 if (
present(filter))
then 1289 if (filter%contextana)
then 1290 if (.not. filter%anavars == data%dbadc%dat)
return 1292 if (.not. filter%vars == data%dbadc%dat)
return 1302 if (.not. data%dbadc%dat%c_e() .and. session%file)
return 1304 call data%dbadc%dbaset(session)
1306 code = idba_error_code()
1308 if (optio_log(attronly).or. .not. data%dbadc%dat%c_e() .or. code ==13 )
then 1311 ierr = idba_set(session%sehandle,
"var",data%dbadc%dat%btable)
1314 ierr = idba_voglioquesto(session%sehandle, count)
1318 ierr=idba_unsetb(session%sehandle)
1319 if (count ==0)
return 1321 if (c_e(count))
then 1322 if (optio_log(attronly))
then 1323 ierr=idba_dammelo(session%sehandle, btable)
1327 ierr=idba_dimenticami(session%sehandle)
1331 call session%prendilo()
1332 ierr=idba_unsetb(session%sehandle)
1335 if (optio_log(noattr))
return 1338 if (
allocated(data%attrv%dcv))
then 1339 if (
size(data%attrv%dcv) > 0 )
then 1341 do i = 1,
size(data%attrv%dcv)
1342 if (
present(filter))
then 1343 if (filter%contextana)
then 1344 if (.not. filter%anastarvars == data%attrv%dcv(i)%dat) cycle
1346 if (.not. filter%starvars == data%attrv%dcv(i)%dat) cycle
1350 if (data%attrv%dcv(i)%dat%c_e())
then 1353 call data%attrv%dcv(i)%dat%dbaset(session)
1355 else if(optio_log(attronly))
then 1359 ierr = idba_set(session%sehandle,
"*var",data%attrv%dcv(i)%dat%btable)
1362 call session%scusa()
1368 call session%critica()
1378 end subroutine dbadataattr_extrude
1381 subroutine dbadataattr_display(dc)
1382 class(dbadataattr),
intent(in) :: dc
1385 call dc%dbadc%display()
1386 print*,
"Attributes:" 1387 call dc%attrv%display()
1389 end subroutine dbadataattr_display
1393 subroutine dbadataattrv_extrude(dataattr,session,noattr,filter,attronly,template)
1395 type(dbasession),
intent(in) :: session
1396 logical,
intent(in),
optional :: noattr
1397 type(dbafilter),
intent(in),
optional :: filter
1398 logical,
intent(in),
optional :: attronly
1399 character(len=*),
intent(in),
optional :: template
1403 if(.not.
allocated(dataattr%dataattr))
return 1404 do i=1,
size(dataattr%dataattr)
1405 call dataattr%dataattr(i)%extrude(session,noattr,filter,attronly,template)
1412 end subroutine dbadataattrv_extrude
1415 subroutine dbadataattrv_display(dataattr)
1416 class(dbadataattrv),
intent(in) :: dataattr
1419 do i=1,
size(dataattr%dataattr)
1420 call dataattr%dataattr(i)%display()
1423 end subroutine dbadataattrv_display
1426 subroutine dbadatai_geti(data,value)
1427 class(dbadatai),
intent(in) :: data
1428 integer,
intent(out) ::
value 1430 end subroutine dbadatai_geti
1433 subroutine dbadatar_getr(data,value)
1434 class(dbadatar),
intent(in) :: data
1435 real,
intent(out) ::
value 1437 end subroutine dbadatar_getr
1440 subroutine dbadatad_getd(data,value)
1441 class(dbadatad),
intent(in) :: data
1442 doubleprecision,
intent(out) ::
value 1444 end subroutine dbadatad_getd
1447 subroutine dbadatab_getb(data,value)
1448 class(dbadatab),
intent(in) :: data
1449 integer(kind=int_b),
intent(out) ::
value 1451 end subroutine dbadatab_getb
1454 subroutine dbadatac_getc(data,value)
1455 class(dbadatac),
intent(in) :: data
1456 character(len=*),
intent(out) ::
value 1458 end subroutine dbadatac_getc
1463 type(dbadatai)
elemental function dbadatai_init(btable,value)
1465 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1466 INTEGER,
INTENT(IN),
OPTIONAL ::
value 1468 if (
present(btable))
then 1469 dbadatai_init%btable=btable
1471 dbadatai_init%btable=cmiss
1474 if (
present(
value))
then 1475 dbadatai_init%value=
value 1477 dbadatai_init%value=imiss
1480 end function dbadatai_init
1484 type(dbadatar)
elemental function dbadatar_init(btable,value)
1486 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1487 real,
INTENT(IN),
OPTIONAL ::
value 1489 if (
present(btable))
then 1490 dbadatar_init%btable=btable
1492 dbadatar_init%btable=cmiss
1495 if (
present(
value))
then 1496 dbadatar_init%value=
value 1498 dbadatar_init%value=rmiss
1501 end function dbadatar_init
1505 type(dbadatad)
elemental function dbadatad_init(btable,value)
1507 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1508 double precision,
INTENT(IN),
OPTIONAL ::
value 1510 if (
present(btable))
then 1511 dbadatad_init%btable=btable
1513 dbadatad_init%btable=cmiss
1516 if (
present(
value))
then 1517 dbadatad_init%value=
value 1519 dbadatad_init%value=dmiss
1522 end function dbadatad_init
1527 type(dbadatab)
elemental function dbadatab_init(btable,value)
1529 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1530 INTEGER(kind=int_b) ,
INTENT(IN),
OPTIONAL ::
value 1532 if (
present(btable))
then 1533 dbadatab_init%btable=btable
1535 dbadatab_init%btable=cmiss
1538 if (
present(
value))
then 1539 dbadatab_init%value=
value 1541 dbadatab_init%value=bmiss
1544 end function dbadatab_init
1548 type(dbadatac)
elemental function dbadatac_init(btable,value)
1550 character(len=*),
INTENT(IN),
OPTIONAL :: btable
1551 character(len=*),
INTENT(IN),
OPTIONAL ::
value 1553 if (
present(btable))
then 1554 dbadatac_init%btable=btable
1556 dbadatac_init%btable=cmiss
1559 if (
present(
value))
then 1560 dbadatac_init%value=
value 1562 dbadatac_init%value=cmiss
1565 end function dbadatac_init
1569 subroutine dbadatai_set(data,session)
1570 class(dbadatai),
intent(in) :: data
1571 type(dbasession),
intent(in) :: session
1573 if (.not. c_e(data%btable))
return 1574 ier = idba_set(session%sehandle,data%btable,data%value)
1575 end subroutine dbadatai_set
1578 subroutine dbadatai_display(data)
1579 class(dbadatai),
intent(in) :: data
1580 print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1581 end subroutine dbadatai_display
1584 subroutine dbadatar_set(data,session)
1585 class(dbadatar),
intent(in) :: data
1586 type(dbasession),
intent(in) :: session
1588 if (.not. c_e(data%btable))
return 1589 ier = idba_set(session%sehandle,data%btable,data%value)
1590 end subroutine dbadatar_set
1593 subroutine dbadatar_display(data)
1594 class(dbadatar),
intent(in) :: data
1595 print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1596 end subroutine dbadatar_display
1600 subroutine dbadatad_set(data,session)
1601 class(dbadatad),
intent(in) :: data
1602 type(dbasession),
intent(in) :: session
1604 if (.not. c_e(data%btable))
return 1605 ier = idba_set(session%sehandle,data%btable,data%value)
1606 end subroutine dbadatad_set
1609 subroutine dbadatad_display(data)
1610 class(dbadatad),
intent(in) :: data
1611 print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1612 end subroutine dbadatad_display
1615 subroutine dbadatab_set(data,session)
1616 class(dbadatab),
intent(in) :: data
1617 type(dbasession),
intent(in) :: session
1619 if (.not. c_e(data%btable))
return 1620 ier = idba_set(session%sehandle,data%btable,data%value)
1621 end subroutine dbadatab_set
1624 subroutine dbadatab_display(data)
1625 class(dbadatab),
intent(in) :: data
1626 print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1627 end subroutine dbadatab_display
1630 subroutine dbadatac_set(data,session)
1631 class(dbadatac),
intent(in) :: data
1632 type(dbasession),
intent(in) :: session
1634 if (.not. c_e(data%btable))
return 1635 ier = idba_set(session%sehandle,data%btable,data%value)
1636 end subroutine dbadatac_set
1639 subroutine dbadatac_display(data)
1640 class(dbadatac),
intent(in) :: data
1641 print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1642 end subroutine dbadatac_display
1658 subroutine dbatimerange_display(timerange)
1659 class(dbatimerange),
intent(in) :: timerange
1660 call display (timerange%vol7d_timerange)
1661 end subroutine dbatimerange_display
1664 subroutine dbatimerange_set(timerange,session)
1669 ier = idba_settimerange(session%sehandle,&
1670 timerange%timerange, timerange%p1, timerange%p2)
1673 if (.not. c_e(timerange%vol7d_timerange))
then 1674 call session%setcontextana
1677 end subroutine dbatimerange_set
1680 subroutine dbatimerange_enq(timerange,session)
1685 ier = idba_enqtimerange(session%sehandle,&
1686 timerange%timerange, timerange%p1, timerange%p2)
1688 end subroutine dbatimerange_enq
1692 type(
dbatimerange) function dbatimerange_init(timerange, p1, p2)
1693 INTEGER,
INTENT(IN),
OPTIONAL :: timerange
1694 INTEGER,
INTENT(IN),
OPTIONAL :: p1
1695 INTEGER,
INTENT(IN),
OPTIONAL :: p2
1697 call init (dbatimerange_init%vol7d_timerange,timerange, p1, p2)
1698 end function dbatimerange_init
1705 end function dbatimerange_contextana
1709 subroutine dbanetwork_display(network)
1711 call display (network%vol7d_network)
1712 print *,
"Priority=",network%priority
1713 end subroutine dbanetwork_display
1716 subroutine dbanetwork_set(network,session)
1721 ier = idba_set(session%sehandle,
"rep_memo", network%name)
1723 end subroutine dbanetwork_set
1726 subroutine dbanetwork_enq(network,session)
1731 ier = idba_enq(session%sehandle,
"rep_memo", network%name)
1732 ier = idba_enq(session%sehandle,
"priority", network%priority)
1734 end subroutine dbanetwork_enq
1738 type(
dbanetwork) function dbanetwork_init(name)
1739 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: name
1741 call init (dbanetwork_init%vol7d_network,name)
1742 dbanetwork_init%priority=imiss
1743 end function dbanetwork_init
1747 subroutine dbadatetime_display(datetime)
1749 call display (datetime%datetime)
1750 end subroutine dbadatetime_display
1753 subroutine dbadatetime_set(datetime,session)
1756 integer :: ier,year,month,day,hour,minute,sec,msec
1758 CALL getval(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1761 sec=nint(float(msec)/1000.)
1766 ier = idba_setdate(session%sehandle,year,month,day,hour,minute,sec)
1769 if (.not. c_e(datetime%datetime))
then 1770 call session%setcontextana
1773 end subroutine dbadatetime_set
1776 subroutine dbadatetime_enq(datetime,session)
1777 class(dbadatetime),
intent(out) :: datetime
1778 type(dbasession),
intent(in) :: session
1780 integer :: ier,year,month,day,hour,minute,sec,msec
1782 ier = idba_enqdate(session%sehandle,year,month,day,hour,minute,sec)
1792 if (year==1000)
then 1793 datetime%datetime=datetime_new()
1795 CALL init(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1798 end subroutine dbadatetime_enq
1802 type(dbadatetime) function dbadatetime_init(dt)
1803 type(datetime),
INTENT(in),
OPTIONAL :: dt
1805 if (
present(dt))
then 1806 dbadatetime_init%datetime=dt
1808 dbadatetime_init%datetime=datetime_new()
1811 end function dbadatetime_init
1814 type(dbadatetime) function dbadatetime_contextana()
1816 dbadatetime_contextana%datetime=datetime_new()
1818 end function dbadatetime_contextana
1823 type(dbametadata) function dbametadata_init(level,timerange,ana,network,datetime)
1825 type(dbalevel),
intent(in),
optional :: level
1826 type(dbatimerange),
intent(in),
optional :: timerange
1827 type(dbaana),
intent(in),
optional :: ana
1828 type(dbanetwork),
intent(in),
optional :: network
1829 type(dbadatetime),
intent(in),
optional :: datetime
1831 if (
present(level))
then 1832 dbametadata_init%level=level
1837 if (
present(timerange))
then 1838 dbametadata_init%timerange=timerange
1843 if (
present(ana))
then 1844 dbametadata_init%ana=ana
1846 dbametadata_init%ana=
dbaana()
1849 if (
present(network))
then 1850 dbametadata_init%network=network
1855 if (
present(datetime))
then 1856 dbametadata_init%datetime=datetime
1861 end function dbametadata_init
1864 subroutine dbametadata_display(metadata)
1865 class(dbametadata),
intent(in) :: metadata
1866 call metadata%level%display()
1867 call metadata%timerange%display()
1868 call metadata%ana%display()
1869 call metadata%network%display()
1870 call metadata%datetime%display()
1872 end subroutine dbametadata_display
1875 subroutine dbametadata_set(metadata,session)
1876 class(dbametadata),
intent(in) :: metadata
1877 type(dbasession),
intent(in) :: session
1882 call metadata%ana%dbaset(session)
1883 call metadata%network%dbaset(session)
1885 if (c_e(metadata%datetime%datetime) .or. &
1886 c_e(metadata%level%vol7d_level) .or. &
1887 c_e(metadata%timerange%vol7d_timerange))
then 1889 call metadata%datetime%dbaset(session)
1890 call metadata%level%dbaset(session)
1891 call metadata%timerange%dbaset(session)
1894 call session%setcontextana()
1897 end subroutine dbametadata_set
1900 subroutine dbametadata_enq(metadata,session)
1904 call metadata%ana%dbaenq(session)
1905 call metadata%network%dbaenq(session)
1906 call metadata%datetime%dbaenq(session)
1907 call metadata%level%dbaenq(session)
1908 call metadata%timerange%dbaenq(session)
1910 end subroutine dbametadata_enq
1914 logical function dbafilter_equal_dbametadata(this,that)
1916 class(dbafilter),
intent(in) :: this
1917 class(dbametadata),
intent(in) :: that
1919 dbafilter_equal_dbametadata = .false.
1923 if (this%contextana .and. c_e(that%timerange%vol7d_timerange))
return 1924 if (this%contextana .and. c_e(that%datetime%datetime))
return 1925 if (this%contextana .and. c_e(that%level%vol7d_level))
return 1927 if (c_e(this%level%vol7d_level) .and. .not. this%level%vol7d_level == that%level%vol7d_level )
return 1928 if (c_e(this%timerange%vol7d_timerange) .and. .not. this%timerange%vol7d_timerange == that%timerange%vol7d_timerange )
return 1929 if (c_e(this%datetime%datetime) .and. .not. this%datetime%datetime == that%datetime%datetime )
return 1930 if (c_e(this%network%vol7d_network) .and. .not. this%network%vol7d_network == that%network%vol7d_network )
return 1931 if (c_e(this%ana%vol7d_ana) .and. .not. this%ana%vol7d_ana == that%ana%vol7d_ana )
return 1933 if ( c_e(this%datetimemin%datetime) .and. c_e(that%datetime%datetime) .and. &
1934 this%datetimemin%datetime > that%datetime%datetime )
return 1935 if ( c_e(this%datetimemax%datetime) .and. c_e(that%datetime%datetime) .and. &
1936 this%datetimemax%datetime < that%datetime%datetime )
return 1938 if (c_e(this%coordmin%geo_coord))
then 1939 if (geo_coord_ll(that%ana%vol7d_ana%coord, this%coordmin%geo_coord))
return 1942 if (c_e(this%coordmax%geo_coord))
then 1943 if (geo_coord_ur(that%ana%vol7d_ana%coord, this%coordmax%geo_coord))
return 1946 dbafilter_equal_dbametadata = .true.
1948 end function dbafilter_equal_dbametadata
1977 elemental logical function dbadcv_equal_dbadata(this,that)
1979 class(dbadcv),
intent(in) :: this
1980 class(dbadata),
intent(in) :: that
1987 if (
allocated(this%dcv))
then 1988 dbadcv_equal_dbadata=.false.
1989 do i=1,
size(this%dcv)
1990 dbadcv_equal_dbadata = this%dcv(i)%dat == that
1991 if (dbadcv_equal_dbadata)
exit 1994 dbadcv_equal_dbadata=.true.
1997 end function dbadcv_equal_dbadata
2001 elemental logical function dbametadata_equal(this,that)
2007 this%level%vol7d_level == that%level%vol7d_level .and. &
2008 this%timerange%vol7d_timerange == that%timerange%vol7d_timerange .and. &
2009 this%datetime%datetime == that%datetime%datetime .and. &
2010 this%network%vol7d_network == that%network%vol7d_network .and. &
2011 this%ana%vol7d_ana == that%ana%vol7d_ana &
2013 dbametadata_equal = .true.
2015 dbametadata_equal = .false.
2018 end function dbametadata_equal
2024 type(
dbafilter) function dbafilter_init(filter,ana,var,datetime,level,timerange,network,&
2025 datetimemin,datetimemax,coordmin,coordmax,limit,&
2026 ana_filter, data_filter, attr_filter, varlist, starvarlist, anavarlist, anastarvarlist ,&
2027 priority, priomin, priomax, contextana,&
2028 vars, starvars, anavars, anastarvars, query,anaonly,dataonly)
2030 type(
dbafilter),
intent(in),
optional :: filter
2031 type(
dbaana),
intent(in),
optional :: ana
2032 character(len=*),
intent(in),
optional :: var
2034 type(
dbalevel),
intent(in),
optional :: level
2036 type(
dbanetwork),
intent(in),
optional :: network
2037 type(
dbacoord),
intent(in),
optional :: coordmin
2038 type(
dbacoord),
intent(in),
optional :: coordmax
2039 type(
dbadatetime),
intent(in),
optional :: datetimemin
2040 type(
dbadatetime),
intent(in),
optional :: datetimemax
2041 integer,
intent(in),
optional :: limit
2042 character(len=*),
intent(in),
optional :: ana_filter
2043 character(len=*),
intent(in),
optional :: data_filter
2044 character(len=*),
intent(in),
optional :: attr_filter
2045 character(len=*),
intent(in),
optional :: varlist
2046 character(len=*),
intent(in),
optional :: starvarlist
2047 character(len=*),
intent(in),
optional :: anavarlist
2048 character(len=*),
intent(in),
optional :: anastarvarlist
2049 integer,
intent(in),
optional :: priority
2050 integer,
intent(in),
optional :: priomin
2051 integer,
intent(in),
optional :: priomax
2052 logical,
intent(in),
optional :: contextana
2053 class(
dbadcv),
intent(in),
optional :: vars
2054 class(
dbadcv),
intent(in),
optional :: starvars
2055 class(
dbadcv),
intent(in),
optional :: anavars
2056 class(
dbadcv),
intent(in),
optional :: anastarvars
2057 character(len=*),
intent(in),
optional :: query
2058 logical,
intent(in),
optional :: anaonly
2059 logical,
intent(in),
optional :: dataonly
2062 logical :: nopreserve
2065 if (
present(filter))
then 2066 dbafilter_init=filter
2104 if (
present(ana))
then 2105 dbafilter_init%ana=ana
2106 else if (nopreserve)
then 2107 dbafilter_init%ana=
dbaana()
2110 if (
present(var))
then 2111 dbafilter_init%var=var
2112 else if (nopreserve)
then 2113 dbafilter_init%var=cmiss
2116 if (
present(datetime))
then 2117 dbafilter_init%datetime=datetime
2118 else if (nopreserve)
then 2122 if (
present(level))
then 2123 dbafilter_init%level=level
2124 else if (nopreserve)
then 2128 if (
present(timerange))
then 2129 dbafilter_init%timerange=timerange
2130 else if (nopreserve)
then 2134 if (
present(network))
then 2135 dbafilter_init%network=network
2136 else if (nopreserve)
then 2140 if (
present(datetimemin))
then 2141 dbafilter_init%datetimemin=datetimemin
2142 else if (nopreserve)
then 2146 if (
present(datetimemax))
then 2147 dbafilter_init%datetimemax=datetimemax
2148 else if (nopreserve)
then 2152 if (
present(coordmin))
then 2153 dbafilter_init%coordmin=coordmin
2154 else if (nopreserve)
then 2158 if (
present(coordmax))
then 2159 dbafilter_init%coordmax=coordmax
2160 else if (nopreserve)
then 2164 if (
present(limit))
then 2165 dbafilter_init%limit=limit
2166 else if (nopreserve)
then 2167 dbafilter_init%limit=imiss
2170 if (
present(ana_filter))
then 2171 dbafilter_init%ana_filter=ana_filter
2172 else if (nopreserve)
then 2173 dbafilter_init%ana_filter=cmiss
2176 if (
present(data_filter))
then 2177 dbafilter_init%data_filter=data_filter
2178 else if (nopreserve)
then 2179 dbafilter_init%data_filter=cmiss
2182 if (
present(attr_filter))
then 2183 dbafilter_init%attr_filter=attr_filter
2184 else if (nopreserve)
then 2185 dbafilter_init%attr_filter=cmiss
2188 if (
present(varlist))
then 2189 dbafilter_init%varlist=varlist
2190 else if (nopreserve)
then 2191 dbafilter_init%varlist=cmiss
2194 if (
present(starvarlist))
then 2195 dbafilter_init%starvarlist=starvarlist
2196 else if (nopreserve)
then 2197 dbafilter_init%starvarlist=cmiss
2200 if (
present(anavarlist))
then 2201 dbafilter_init%anavarlist=anavarlist
2202 else if (nopreserve)
then 2203 dbafilter_init%anavarlist=cmiss
2206 if (
present(anastarvarlist))
then 2207 dbafilter_init%anastarvarlist=anastarvarlist
2208 else if (nopreserve)
then 2209 dbafilter_init%anastarvarlist=cmiss
2212 if (
present(vars))
then 2213 if (
allocated(vars%dcv))
then 2214 allocate(dbafilter_init%vars%dcv(
size(vars%dcv)))
2215 do i =1,
size(vars%dcv)
2216 allocate(dbafilter_init%vars%dcv(i)%dat,source=vars%dcv(i)%dat)
2219 dbafilter_init%varlist=
"" 2220 do i=1,
size(vars%dcv)
2221 dbafilter_init%varlist=trim(dbafilter_init%varlist)//vars%dcv(i)%dat%btable
2222 if (i /=
size(vars%dcv)) dbafilter_init%varlist=trim(dbafilter_init%varlist)//
"," 2227 if (
present(starvars))
then 2228 if (
allocated(starvars%dcv))
then 2229 allocate(dbafilter_init%starvars%dcv(
size(starvars%dcv)))
2230 do i =1,
size(starvars%dcv)
2231 allocate(dbafilter_init%starvars%dcv(i)%dat,source=starvars%dcv(i)%dat)
2234 dbafilter_init%starvarlist=
"" 2235 do i=1,
size(starvars%dcv)
2236 dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//starvars%dcv(i)%dat%btable
2237 if (i /=
size(starvars%dcv)) dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//
"," 2243 if (
present(anavars))
then 2244 if (
allocated(anavars%dcv))
then 2245 allocate(dbafilter_init%anavars%dcv(
size(anavars%dcv)))
2246 do i =1,
size(anavars%dcv)
2247 allocate(dbafilter_init%anavars%dcv(i)%dat,source=anavars%dcv(i)%dat)
2250 dbafilter_init%anavarlist=
"" 2251 do i=1,
size(anavars%dcv)
2252 dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//anavars%dcv(i)%dat%btable
2253 if (i /=
size(anavars%dcv)) dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//
"," 2258 if (
present(anastarvars))
then 2259 if (
allocated(anastarvars%dcv))
then 2260 allocate(dbafilter_init%anastarvars%dcv(
size(anastarvars%dcv)))
2261 do i =1,
size(anastarvars%dcv)
2262 allocate(dbafilter_init%anastarvars%dcv(i)%dat,source=anastarvars%dcv(i)%dat)
2265 dbafilter_init%anastarvarlist=
"" 2266 do i=1,
size(anastarvars%dcv)
2267 dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//anastarvars%dcv(i)%dat%btable
2268 if (i /=
size(anastarvars%dcv)) dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//
"," 2273 if (
present(priority))
then 2274 dbafilter_init%priority=priority
2275 else if (nopreserve)
then 2276 dbafilter_init%priority=imiss
2279 if (
present(priomin))
then 2280 dbafilter_init%priomin=priomax
2281 else if (nopreserve)
then 2282 dbafilter_init%priomin=imiss
2285 if (
present(priomax))
then 2286 dbafilter_init%priomax=priomax
2287 else if (nopreserve)
then 2288 dbafilter_init%priomax=imiss
2291 if (
present(contextana))
then 2292 dbafilter_init%contextana=contextana
2293 else if (nopreserve)
then 2294 dbafilter_init%contextana=.false.
2297 if (
present(anaonly))
then 2298 dbafilter_init%anaonly=anaonly
2299 else if (nopreserve)
then 2300 dbafilter_init%anaonly=.false.
2302 if (
present(dataonly))
then 2303 dbafilter_init%dataonly=dataonly
2304 else if (nopreserve)
then 2305 dbafilter_init%dataonly=.false.
2308 if (
present(query))
then 2309 dbafilter_init%query=query
2310 else if (nopreserve)
then 2311 dbafilter_init%query=cmiss
2314 end function dbafilter_init
2317 subroutine dbafilter_display(filter)
2320 print *,
"------------------ filter ---------------" 2321 call filter%ana%display()
2322 call filter%datetime%display()
2323 call filter%level%display()
2324 call filter%timerange%display()
2325 call filter%network%display()
2326 print *,
" >>>> minimum:" 2327 call filter%datetimemin%display()
2328 call filter%coordmin%display()
2329 print *,
" >>>> maximum:" 2330 call filter%datetimemax%display()
2331 call filter%coordmax%display()
2332 print *,
" >>>> vars:" 2333 call filter%vars%display()
2334 print *,
" >>>> starvars:" 2335 call filter%starvars%display()
2336 print *,
" >>>> anavars:" 2337 call filter%anavars%display()
2338 print *,
" >>>> anastarvars:" 2339 call filter%anastarvars%display()
2340 print *,
"var=",filter%var
2341 print *,
"limit=",filter%limit
2342 print *,
"ana_filter=",trim(filter%ana_filter)
2343 print *,
"data_filter=",trim(filter%data_filter)
2344 print *,
"attr_filter=",trim(filter%attr_filter)
2345 print *,
"varlist=",trim(filter%varlist)
2346 print *,
"*varlist=",trim(filter%starvarlist)
2347 print *,
"anavarlist=",trim(filter%anavarlist)
2348 print *,
"ana*varlist=",trim(filter%anastarvarlist)
2349 print *,
"priority=",filter%priority
2350 print *,
"priomin=",filter%priomin
2351 print *,
"priomax=",filter%priomax
2352 print *,
"contextana=",filter%contextana
2353 print *,
"anaonly=",filter%anaonly
2354 print *,
"dataonly=",filter%dataonly
2355 print *,
"query=",trim(filter%query)
2357 print *,
"-----------------------------------------" 2359 end subroutine dbafilter_display
2362 subroutine dbafilter_set(filter,session)
2366 integer :: ier,year,month,day,hour,minute,sec,msec
2368 call session%unsetall()
2370 call filter%ana%dbaset(session)
2371 call filter%network%dbaset(session)
2372 ier = idba_set(session%sehandle,
"var",filter%var)
2374 ier = idba_set(session%sehandle,
"limit",filter%limit)
2375 ier = idba_set(session%sehandle,
"priority",filter%priority)
2376 ier = idba_set(session%sehandle,
"priomin",filter%priomin)
2377 ier = idba_set(session%sehandle,
"priomax",filter%priomax)
2379 ier = idba_set(session%sehandle,
"latmin",getilat(filter%coordmin%geo_coord))
2380 ier = idba_set(session%sehandle,
"lonmin",getilon(filter%coordmin%geo_coord))
2381 ier = idba_set(session%sehandle,
"latmax",getilat(filter%coordmax%geo_coord))
2382 ier = idba_set(session%sehandle,
"lonmax",getilon(filter%coordmax%geo_coord))
2384 ier = idba_set(session%sehandle,
"ana_filter",filter%ana_filter)
2385 ier = idba_set(session%sehandle,
"data_filter",filter%data_filter)
2386 ier = idba_set(session%sehandle,
"attr_filter",filter%attr_filter)
2388 ier = idba_set(session%sehandle,
"query",filter%query)
2390 if (filter%contextana)
then 2392 call session%setcontextana()
2394 ier = idba_set(session%sehandle,
"varlist",filter%anavarlist)
2395 ier = idba_set(session%sehandle,
"*varlist",filter%anastarvarlist)
2399 if (c_e(filter%datetime%datetime))
call filter%datetime%dbaset(session)
2400 if (c_e(filter%level%vol7d_level))
call filter%level%dbaset(session)
2401 if (c_e(filter%timerange%vol7d_timerange))
call filter%timerange%dbaset(session)
2403 CALL getval(filter%datetimemin%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2405 sec=nint(float(msec)/1000.)
2410 ier = idba_set(session%sehandle,
"yearmin",year)
2411 ier = idba_set(session%sehandle,
"monthmin",month)
2412 ier = idba_set(session%sehandle,
"daymin",day)
2413 ier = idba_set(session%sehandle,
"hourmin",hour)
2414 ier = idba_set(session%sehandle,
"minumin",minute)
2415 ier = idba_set(session%sehandle,
"secmin",sec)
2417 CALL getval(filter%datetimemax%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2420 sec=nint(float(msec)/1000.)
2425 ier = idba_set(session%sehandle,
"yearmax",year)
2426 ier = idba_set(session%sehandle,
"monthmax",month)
2427 ier = idba_set(session%sehandle,
"daymax",day)
2428 ier = idba_set(session%sehandle,
"hourmax",hour)
2429 ier = idba_set(session%sehandle,
"minumax",minute)
2430 ier = idba_set(session%sehandle,
"secmax",sec)
2433 ier = idba_set(session%sehandle,
"varlist",filter%varlist)
2434 ier = idba_set(session%sehandle,
"*varlist",filter%starvarlist)
2437 end subroutine dbafilter_set
2441 type(
dbametadata) function dbametadata_contextana(metadata)
2448 select type(metadata)
2450 dbametadata_contextana=metadata
2453 dbametadata_contextana%datetime=datetime%dbacontextana()
2454 dbametadata_contextana%level=level%dbacontextana()
2455 dbametadata_contextana%timerange=timerange%dbacontextana()
2457 end function dbametadata_contextana
2461 subroutine dbametaanddata_display(metaanddata)
2464 call metaanddata%metadata%display()
2465 call metaanddata%dataattrv%display()
2467 end subroutine dbametaanddata_display
2470 subroutine dbametaanddata_extrude(metaanddata,session,noattr,filter,attronly,template)
2473 logical,
intent(in),
optional :: noattr
2474 type(
dbafilter),
intent(in),
optional :: filter
2475 logical,
intent(in),
optional :: attronly
2476 character(len=*),
intent(in),
optional :: template
2484 myfilter=
dbafilter(filter=filter,contextana=.false.)
2485 call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2488 myfilter=
dbafilter(filter=filter,contextana=.true.)
2489 call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2493 subroutine extrude(metaanddata,session,noattr,filter,attronly,template)
2496 logical,
intent(in),
optional :: noattr
2498 logical,
intent(in),
optional :: attronly
2499 character(len=*),
intent(in),
optional :: template
2501 if (.not. filter == metaanddata%metadata)
return 2503 call session%unsetall()
2505 call session%set(metadata=metaanddata%metadata)
2509 call metaanddata%dataattrv%extrude(session,noattr,filter,attronly)
2512 call session%close_message(template)
2514 end subroutine extrude
2515 end subroutine dbametaanddata_extrude
2519 subroutine dbametaanddatav_display(metaanddatav)
2520 class(dbametaanddatav),
intent(in) :: metaanddatav
2522 call metaanddatav%metadata%display()
2523 call metaanddatav%datav%display()
2525 end subroutine dbametaanddatav_display
2528 subroutine dbametaanddatav_extrude(metaanddatav,session,noattr,filter,template)
2529 class(dbametaanddatav),
intent(in) :: metaanddatav
2530 type(dbasession),
intent(in) :: session
2531 logical,
intent(in),
optional :: noattr
2532 type(dbafilter),
intent(in),
optional :: filter
2533 character(len=*),
intent(in),
optional :: template
2535 type(dbafilter) :: myfilter
2537 myfilter=
dbafilter(filter=filter,contextana=.false.)
2538 call extrude(metaanddatav,session,noattr,myfilter,template)
2540 myfilter=
dbafilter(filter=filter,contextana=.true.)
2541 call extrude(metaanddatav,session,noattr,myfilter,template)
2545 subroutine extrude(metaanddatav,session,noattr,filter,template)
2546 class(dbametaanddatav),
intent(in) :: metaanddatav
2547 type(dbasession),
intent(in) :: session
2548 logical,
intent(in),
optional :: noattr
2549 type(dbafilter),
intent(in) :: filter
2550 character(len=*),
intent(in),
optional :: template
2552 if (.not. filter == metaanddatav%metadata)
return 2554 call session%set(metadata=metaanddatav%metadata)
2558 call metaanddatav%datav%extrude(session,noattr,filter,template)
2560 print*,
"dbaana_metaanddatav" 2562 call session%close_message(template)
2564 end subroutine extrude
2565 end subroutine dbametaanddatav_extrude
2569 subroutine dbametaanddatal_extrude(metaanddatal,session,noattr,filter,attronly,template)
2570 class(dbametaanddatalist),
intent(inout) :: metaanddatal
2571 class(dbasession),
intent(in) :: session
2572 logical,
intent(in),
optional :: noattr
2573 type(dbafilter),
intent(in),
optional :: filter
2574 type(dbametaanddata) :: metaanddata
2575 logical,
intent(in),
optional :: attronly
2576 character(len=*),
intent(in),
optional :: template
2578 call metaanddatal%rewind()
2579 do while(metaanddatal%element())
2581 metaanddata=metaanddatal%current()
2582 call metaanddata%extrude(session,noattr,filter,attronly,template)
2583 call metaanddatal%next()
2586 end subroutine dbametaanddatal_extrude
2590 subroutine displaydbametaanddatai(this)
2591 class(dbametaanddataiList),
intent(inout) :: this
2592 type(dbametaanddatai) :: element
2595 do while(this%element())
2596 print *,
"index:",this%currentindex(),
" value:" 2597 element=this%current()
2598 call element%display()
2601 end subroutine displaydbametaanddatai
2604 type(dbametaanddatai) function currentdbametaanddatai(this)
2605 class(dbametaanddataiList) :: this
2606 class(*),
pointer :: v
2608 v => this%currentpoli()
2611 currentdbametaanddatai = v
2613 end function currentdbametaanddatai
2617 subroutine dbasession_ingest_metaanddatail(session,metaanddatal,filter)
2618 class(dbasession),
intent(inout) :: session
2619 type(dbametaanddatailist),
intent(inout) :: metaanddatal
2620 type(dbafilter),
intent(in),
optional :: filter
2622 type(dbametaanddatai) :: element
2625 if (session%memdb .and. .not. session%loadfile)
then 2627 do while (session%messages_read_next())
2628 call session%set(filter=filter)
2629 call session%ingest_metaanddatai()
2630 call session%ingest_metaanddatai(element)
2631 call metaanddatal%append(element)
2632 call session%remove_all()
2637 call session%set(filter=filter)
2638 call session%ingest_metaanddatai()
2639 do while (c_e(session%count) .and. session%count >0)
2640 call session%ingest_metaanddatai(element)
2641 call metaanddatal%append(element)
2642 if (session%file)
call session%ingest()
2647 end subroutine dbasession_ingest_metaanddatail
2650 function toarray_dbametaanddatai(this)
2656 allocate (toarray_dbametaanddatai(this%countelements()))
2660 do while(this%element())
2662 toarray_dbametaanddatai(i) =this%current()
2665 end function toarray_dbametaanddatai
2669 subroutine displaydbametaanddatar(this)
2670 class(dbametaanddatarList),
intent(inout) :: this
2671 type(dbametaanddatar) :: element
2674 do while(this%element())
2675 print *,
"index:",this%currentindex(),
" value:" 2676 element=this%current()
2677 call element%display()
2680 end subroutine displaydbametaanddatar
2683 type(dbametaanddatar) function currentdbametaanddatar(this)
2684 class(dbametaanddatarList) :: this
2685 class(*),
pointer :: v
2687 v => this%currentpoli()
2690 currentdbametaanddatar = v
2692 end function currentdbametaanddatar
2696 subroutine dbasession_ingest_metaanddatarl(session,metaanddatal,filter)
2697 class(dbasession),
intent(inout) :: session
2698 type(dbametaanddatarlist),
intent(inout) :: metaanddatal
2699 type(dbafilter),
intent(in),
optional :: filter
2701 type(dbametaanddatar) :: element
2703 if (session%memdb .and. .not. session%loadfile)
then 2705 do while (session%messages_read_next())
2706 call session%set(filter=filter)
2707 call session%ingest_metaanddatar()
2708 call session%ingest_metaanddatar(element)
2709 call metaanddatal%append(element)
2710 call session%remove_all()
2715 call session%set(filter=filter)
2716 call session%ingest_metaanddatar()
2717 do while (c_e(session%count) .and. session%count >0)
2718 call session%ingest_metaanddatar(element)
2719 call metaanddatal%append(element)
2720 if (session%file)
call session%ingest()
2726 end subroutine dbasession_ingest_metaanddatarl
2730 function toarray_dbametaanddatar(this)
2731 type(dbametaanddatar),
allocatable :: toarray_dbametaanddatar(:)
2732 class(dbametaanddatarList) :: this
2735 i=this%countelements()
2737 allocate (toarray_dbametaanddatar(this%countelements()))
2741 do while(this%element())
2743 toarray_dbametaanddatar(i) =this%current()
2746 end function toarray_dbametaanddatar
2750 subroutine displaydbametaanddatad(this)
2751 class(dbametaanddatadList),
intent(inout) :: this
2752 type(dbametaanddatad) :: element
2755 do while(this%element())
2756 print *,
"index:",this%currentindex(),
" value:" 2757 element=this%current()
2758 call element%display()
2761 end subroutine displaydbametaanddatad
2764 type(dbametaanddatad) function currentdbametaanddatad(this)
2765 class(dbametaanddatadList) :: this
2766 class(*),
pointer :: v
2768 v => this%currentpoli()
2771 currentdbametaanddatad = v
2773 end function currentdbametaanddatad
2776 subroutine dbasession_ingest_metaanddatadl(session,metaanddatal,filter)
2777 class(dbasession),
intent(inout) :: session
2778 type(dbametaanddatadlist),
intent(inout) :: metaanddatal
2779 type(dbafilter),
intent(in),
optional :: filter
2781 type(dbametaanddatad) :: element
2783 if (session%memdb .and. .not. session%loadfile)
then 2785 do while (session%messages_read_next())
2786 call session%set(filter=filter)
2787 call session%ingest_metaanddatad()
2788 call session%ingest_metaanddatad(element)
2789 call metaanddatal%append(element)
2790 call session%remove_all()
2795 call session%set(filter=filter)
2796 call session%ingest_metaanddatad()
2797 do while (c_e(session%count) .and. session%count >0)
2798 call session%ingest_metaanddatad(element)
2799 call metaanddatal%append(element)
2800 if (session%file)
call session%ingest()
2805 end subroutine dbasession_ingest_metaanddatadl
2809 function toarray_dbametaanddatad(this)
2815 allocate (toarray_dbametaanddatad(this%countelements()))
2819 do while(this%element())
2821 toarray_dbametaanddatad(i) =this%current()
2824 end function toarray_dbametaanddatad
2828 subroutine displaydbametaanddatab(this)
2829 class(dbametaanddatabList),
intent(inout) :: this
2830 type(dbametaanddatab) :: element
2833 do while(this%element())
2834 print *,
"index:",this%currentindex(),
" value:" 2835 element=this%current()
2836 call element%display()
2839 end subroutine displaydbametaanddatab
2842 type(dbametaanddatab) function currentdbametaanddatab(this)
2843 class(dbametaanddatabList) :: this
2844 class(*),
pointer :: v
2846 v => this%currentpoli()
2849 currentdbametaanddatab = v
2851 end function currentdbametaanddatab
2855 subroutine dbasession_ingest_metaanddatabl(session,metaanddatal,filter)
2858 type(
dbafilter),
intent(in),
optional :: filter
2862 if (session%memdb .and. .not. session%loadfile)
then 2864 do while (session%messages_read_next())
2865 call session%set(filter=filter)
2866 call session%ingest_metaanddatab()
2867 call session%ingest_metaanddatab(element)
2868 call metaanddatal%append(element)
2869 call session%remove_all()
2874 call session%set(filter=filter)
2875 call session%ingest_metaanddatab()
2876 do while (c_e(session%count) .and. session%count >0)
2877 call session%ingest_metaanddatab(element)
2878 call metaanddatal%append(element)
2879 if (session%file)
call session%ingest()
2884 end subroutine dbasession_ingest_metaanddatabl
2888 function toarray_dbametaanddatab(this)
2894 allocate (toarray_dbametaanddatab(this%countelements()))
2898 do while(this%element())
2900 toarray_dbametaanddatab(i) =this%current()
2903 end function toarray_dbametaanddatab
2907 subroutine displaydbametaanddatac(this)
2908 class(dbametaanddatacList),
intent(inout) :: this
2909 type(dbametaanddatac) :: element
2912 do while(this%element())
2913 print *,
"index:",this%currentindex(),
" value:" 2914 element=this%current()
2915 call element%display()
2918 end subroutine displaydbametaanddatac
2921 type(dbametaanddatac) function currentdbametaanddatac(this)
2922 class(dbametaanddatacList) :: this
2923 class(*),
pointer :: v
2925 v => this%currentpoli()
2928 currentdbametaanddatac = v
2930 end function currentdbametaanddatac
2934 subroutine dbasession_ingest_metaanddatacl(session,metaanddatal,filter)
2937 type(
dbafilter),
intent(in),
optional :: filter
2941 if (session%memdb .and. .not. session%loadfile)
then 2943 do while (session%messages_read_next())
2944 call session%set(filter=filter)
2945 call session%ingest_metaanddatac()
2946 call session%ingest_metaanddatac(element)
2947 call metaanddatal%append(element)
2948 call session%remove_all()
2953 call session%set(filter=filter)
2954 call session%ingest_metaanddatac()
2955 do while (c_e(session%count) .and. session%count >0)
2956 call session%ingest_metaanddatac(element)
2957 call metaanddatal%append(element)
2958 if (session%file)
call session%ingest()
2963 end subroutine dbasession_ingest_metaanddatacl
2967 function toarray_dbametaanddatac(this)
2973 allocate (toarray_dbametaanddatac(this%countelements()))
2977 do while(this%element())
2979 toarray_dbametaanddatac(i) =this%current()
2982 end function toarray_dbametaanddatac
2986 subroutine dbametaanddatai_display(data)
2987 class(dbametaanddatai),
intent(in) :: data
2989 call data%metadata%display()
2990 call data%dbadatai%display()
2992 end subroutine dbametaanddatai_display
2995 subroutine dbametaanddatab_display(data)
2996 class(dbametaanddatab),
intent(in) :: data
2998 call data%metadata%display()
2999 call data%dbadatab%display()
3001 end subroutine dbametaanddatab_display
3004 subroutine dbametaanddatad_display(data)
3005 class(dbametaanddatad),
intent(in) :: data
3007 call data%metadata%display()
3008 call data%dbadatad%display()
3010 end subroutine dbametaanddatad_display
3013 subroutine dbametaanddatar_display(data)
3016 call data%metadata%display()
3017 call data%dbadatar%display()
3019 end subroutine dbametaanddatar_display
3023 subroutine dbametaanddatac_display(data)
3026 call data%metadata%display()
3027 call data%dbadatac%display()
3029 end subroutine dbametaanddatac_display
3033 subroutine dbametaanddatai_extrude(metaanddatai,session)
3034 class(dbametaanddatai),
intent(in) :: metaanddatai
3035 type(dbasession),
intent(in) :: session
3037 call session%unsetall()
3039 call session%set(metadata=metaanddatai%metadata)
3041 call session%set(data=metaanddatai%dbadatai)
3043 if (metaanddatai%dbadatai%c_e())
then 3044 call session%prendilo()
3046 call session%dimenticami()
3049 end subroutine dbametaanddatai_extrude
3052 subroutine dbametaanddatab_extrude(metaanddatab,session)
3054 type(dbasession),
intent(in) :: session
3056 call session%unsetall()
3058 call session%set(metadata=metaanddatab%metadata)
3060 call session%set(data=metaanddatab%dbadatab)
3062 if (metaanddatab%dbadatab%c_e())
then 3063 call session%prendilo()
3065 call session%dimenticami()
3068 end subroutine dbametaanddatab_extrude
3071 subroutine dbametaanddatad_extrude(metaanddatad,session)
3072 class(dbametaanddatad),
intent(in) :: metaanddatad
3073 type(dbasession),
intent(in) :: session
3075 call session%unsetall()
3077 call session%set(metadata=metaanddatad%metadata)
3079 call session%set(data=metaanddatad%dbadatad)
3081 if (metaanddatad%dbadatad%c_e())
then 3082 call session%prendilo()
3084 call session%dimenticami()
3087 end subroutine dbametaanddatad_extrude
3090 subroutine dbametaanddatar_extrude(metaanddatar,session)
3094 call session%unsetall()
3096 call session%set(metadata=metaanddatar%metadata)
3098 call session%set(data=metaanddatar%dbadatar)
3100 if (metaanddatar%dbadatar%c_e())
then 3101 call session%prendilo()
3103 call session%dimenticami()
3106 end subroutine dbametaanddatar_extrude
3109 subroutine dbametaanddatac_extrude(metaanddatac,session)
3110 class(dbametaanddatac),
intent(in) :: metaanddatac
3111 type(dbasession),
intent(in) :: session
3113 call session%unsetall()
3115 call session%set(metadata=metaanddatac%metadata)
3117 call session%set(data=metaanddatac%dbadatac)
3119 if (metaanddatac%dbadatac%c_e())
then 3120 call session%prendilo()
3122 call session%dimenticami()
3125 end subroutine dbametaanddatac_extrude
3128 subroutine dbasession_ingest_ana(session,ana)
3130 type(
dbaana),
intent(out),
optional :: ana
3134 if (.not.
present(ana))
then 3135 ier = idba_quantesono(session%sehandle, session%count)
3138 ier = idba_elencamele(session%sehandle)
3139 call ana%dbaenq(session)
3140 session%count=session%count-1
3143 end subroutine dbasession_ingest_ana
3147 subroutine dbasession_ingest_anav(session,anav)
3148 class(dbasession),
intent(inout) :: session
3149 type(dbaana),
intent(out),
allocatable :: anav(:)
3152 call session%ingest_ana()
3154 if (c_e(session%count))
then 3155 allocate(anav(session%count))
3157 do while (session%count >0)
3159 call session%ingest_ana(anav(i))
3165 end subroutine dbasession_ingest_anav
3169 subroutine dbasession_ingest_anal(session,anal)
3174 call session%ingest_ana()
3175 do while (c_e(session%count) .and. session%count >0)
3176 call session%ingest_ana(element)
3177 call anal%append(element)
3178 call session%ingest_ana()
3180 end subroutine dbasession_ingest_anal
3184 subroutine dbasession_ingest_metaanddata(session,metaanddata,noattr,filter)
3185 class(dbasession),
intent(inout) :: session
3186 type(dbametaanddata),
intent(inout),
optional :: metaanddata
3187 logical,
intent(in),
optional :: noattr
3188 type(dbafilter),
intent(in),
optional :: filter
3190 type(dbametadata) :: metadata
3191 integer :: ier,acount,i,j,k
3192 character(len=9) :: btable
3193 character(255) :: value
3194 logical :: lvars,lstarvars
3195 type(dbadcv) :: vars,starvars
3199 if (.not.
present(metaanddata))
then 3200 ier = idba_voglioquesto(session%sehandle, session%count)
3203 if (c_e(session%count) .and. session%count > 0)
then 3204 ier = idba_dammelo(session%sehandle, btable)
3211 if (
allocated(metaanddata%dataattrv%dataattr))
then 3212 deallocate (metaanddata%dataattrv%dataattr)
3217 if (
present(filter))
then 3219 if (filter%contextana)
then 3222 if (
allocated(filter%anavars%dcv))
then 3224 allocate(vars%dcv(
size(filter%anavars%dcv)))
3225 do i =1,
size(filter%anavars%dcv)
3226 allocate(vars%dcv(i)%dat,source=filter%anavars%dcv(i)%dat)
3230 if (
allocated(filter%anastarvars%dcv))
then 3232 allocate(starvars%dcv(
size(filter%anastarvars%dcv)))
3233 do i =1,
size(filter%anastarvars%dcv)
3234 allocate(starvars%dcv(i)%dat,source=filter%anastarvars%dcv(i)%dat)
3240 if (
allocated(filter%vars%dcv))
then 3242 allocate(vars%dcv(
size(filter%vars%dcv)))
3243 do i =1,
size(filter%vars%dcv)
3244 allocate(vars%dcv(i)%dat,source=filter%vars%dcv(i)%dat)
3248 if (
allocated(filter%starvars%dcv))
then 3250 allocate(starvars%dcv(
size(filter%starvars%dcv)))
3251 do i =1,
size(filter%starvars%dcv)
3252 allocate(starvars%dcv(i)%dat,source=filter%starvars%dcv(i)%dat)
3263 allocate (metaanddata%dataattrv%dataattr(
size(vars%dcv)))
3264 do i = 1,
size(vars%dcv)
3265 allocate (metaanddata%dataattrv%dataattr(i)%dat,source=vars%dcv(i)%dat)
3269 call metaanddata%metadata%dbaenq(session)
3271 call metadata%dbaenq(session)
3274 do while ( metaanddata%metadata == metadata )
3275 ier = idba_enq(session%sehandle,
"var",btable)
3276 do i=1,
size(metaanddata%dataattrv%dataattr)
3277 if (metaanddata%dataattrv%dataattr(i)%dat%btable == btable)
then 3279 select type ( dat => metaanddata%dataattrv%dataattr(i)%dat )
3281 ier = idba_enq(session%sehandle, btable,dat%value)
3283 ier = idba_enq(session%sehandle, btable,dat%value)
3285 ier = idba_enq(session%sehandle, btable,dat%value)
3287 ier = idba_enq(session%sehandle, btable,dat%value)
3289 ier = idba_enq(session%sehandle, btable,dat%value)
3292 if (optio_log(noattr))
then 3294 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3300 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(
size(starvars%dcv)))
3301 do j = 1,
size(starvars%dcv)
3302 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
3305 if (c_e(session%count) .and. session%count > 0)
then 3307 ier = idba_voglioancora(session%sehandle, acount)
3309 ier = idba_ancora(session%sehandle, btable)
3310 ier = idba_enq(session%sehandle, btable,
value)
3312 do j=1,
size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
3314 if (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat%btable == btable)
then 3316 select type ( dat => metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat )
3318 ier = idba_enq(session%sehandle, btable,dat%value)
3320 ier = idba_enq(session%sehandle, btable,dat%value)
3322 ier = idba_enq(session%sehandle, btable,dat%value)
3324 ier = idba_enq(session%sehandle, btable,dat%value)
3326 ier = idba_enq(session%sehandle, btable,dat%value)
3334 if (c_e(session%count) .and. session%count > 0)
then 3335 ier = idba_voglioancora(session%sehandle, acount)
3337 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(acount))
3339 ier = idba_ancora(session%sehandle, btable)
3340 ier = idba_enq(session%sehandle, btable,
value)
3341 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatac(btable,
value))
3344 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3351 if (c_e(session%count)) session%count=session%count-1
3353 if (c_e(session%count) .and. session%count > 0 )
then 3354 ier = idba_dammelo(session%sehandle, btable)
3355 call metadata%dbaenq(session)
3362 allocate (metaanddata%dataattrv%dataattr(1))
3363 ier = idba_enq(session%sehandle,
"var",btable)
3364 ier = idba_enq(session%sehandle, btable,
value)
3365 allocate (metaanddata%dataattrv%dataattr(1)%dat,source=
dbadatac(btable,
value))
3366 call metaanddata%metadata%dbaenq(session)
3369 if (optio_log(noattr))
then 3371 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
3377 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(
size(starvars%dcv)))
3378 do j = 1,
size(starvars%dcv)
3379 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
3382 if (c_e(session%count) .and. session%count > 0)
then 3384 ier = idba_voglioancora(session%sehandle, acount)
3386 ier = idba_ancora(session%sehandle, btable)
3387 ier = idba_enq(session%sehandle, btable,
value)
3389 do j=1,
size(metaanddata%dataattrv%dataattr(1)%attrv%dcv)
3391 if (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat%btable == btable)
then 3393 select type ( dat => metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat )
3395 ier = idba_enq(session%sehandle, btable,dat%value)
3397 ier = idba_enq(session%sehandle, btable,dat%value)
3399 ier = idba_enq(session%sehandle, btable,dat%value)
3401 ier = idba_enq(session%sehandle, btable,dat%value)
3403 ier = idba_enq(session%sehandle, btable,dat%value)
3411 if (c_e(session%count) .and. session%count > 0)
then 3412 ier = idba_voglioancora(session%sehandle, acount)
3414 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(acount))
3416 ier = idba_ancora(session%sehandle, btable)
3417 ier = idba_enq(session%sehandle, btable,
value)
3418 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=
dbadatac(btable,
value))
3421 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
3426 if (c_e(session%count))
then 3427 session%count=session%count-1
3429 if (session%count > 0 )
then 3430 ier = idba_dammelo(session%sehandle, btable)
3436 do i=1,
size(metaanddata%dataattrv%dataattr)
3437 if (.not.
allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv))
then 3438 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3444 end subroutine dbasession_ingest_metaanddata
3448 subroutine dbasession_ingest_metaanddatav(session,metaanddatav,noattr,filter)
3449 class(dbasession),
intent(inout) :: session
3450 type(dbametaanddata),
intent(inout),
allocatable :: metaanddatav(:)
3451 logical,
intent(in),
optional :: noattr
3452 type(dbafilter),
intent(in),
optional :: filter
3454 type(dbametaanddata),
allocatable :: metaanddatavbuf(:)
3458 if (
present(filter))
then 3459 call filter%dbaset(session)
3461 call session%unsetall()
3464 call session%ingest()
3467 if (c_e(session%count))
then 3469 allocate(metaanddatavbuf(session%count))
3471 do while (session%count >0)
3473 call session%ingest(metaanddatavbuf(i),noattr=noattr,filter=filter)
3477 IF (
SIZE(metaanddatavbuf) == i)
THEN 3479 CALL move_alloc(metaanddatavbuf, metaanddatav)
3482 metaanddatav=metaanddatavbuf(:i)
3483 DEALLOCATE(metaanddatavbuf)
3487 if (
allocated(metaanddatav))
deallocate(metaanddatav)
3488 allocate(metaanddatav(0))
3492 end subroutine dbasession_ingest_metaanddatav
3496 subroutine dbasession_ingest_metaanddatal(session,metaanddatal,noattr,filter)
3497 class(dbasession),
intent(inout) :: session
3498 type(dbametaanddatalist),
intent(out) :: metaanddatal
3499 logical,
intent(in),
optional :: noattr
3500 type(dbafilter),
intent(in),
optional :: filter
3502 type(dbametaanddata),
allocatable :: metaanddatavbuf(:)
3505 if (session%memdb .and. .not. session%loadfile)
then 3507 do while (session%messages_read_next())
3508 call session%set(filter=filter)
3509 call session%ingest()
3510 call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
3511 do i=1,
size(metaanddatavbuf)
3512 call metaanddatal%append(metaanddatavbuf(i))
3515 call session%remove_all()
3516 deallocate (metaanddatavbuf)
3521 call session%ingest()
3523 do while (c_e(session%count) .and. session%count >0)
3524 call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
3525 do i=1,
size(metaanddatavbuf)
3526 if (
present(filter))
then 3528 if (filter%contextana)
then 3529 if (datetime_new() /= metaanddatavbuf(i)%metadata%datetime%datetime) cycle
3532 call metaanddatal%append(metaanddatavbuf(i))
3534 if (session%file)
call session%ingest()
3535 deallocate (metaanddatavbuf)
3539 end subroutine dbasession_ingest_metaanddatal
3542 subroutine dbasession_ingest_metaanddatai(session,metaanddata)
3543 class(dbasession),
intent(inout) :: session
3544 type(dbametaanddatai),
intent(inout),
optional :: metaanddata
3547 character(len=9) :: btable
3550 if (.not.
present(metaanddata))
then 3551 ier = idba_voglioquesto(session%sehandle, session%count)
3553 ier = idba_dammelo(session%sehandle, btable)
3554 ier = idba_enq(session%sehandle, btable,
value)
3555 metaanddata%dbadatai=
dbadatai(btable,
value)
3556 call metaanddata%metadata%dbaenq(session)
3557 session%count=session%count-1
3559 end subroutine dbasession_ingest_metaanddatai
3563 subroutine dbasession_ingest_metaanddataiv(session,metaanddatav)
3564 class(dbasession),
intent(inout) :: session
3565 type(dbametaanddatai),
intent(inout),
allocatable :: metaanddatav(:)
3569 call session%ingest_metaanddatai()
3570 if (c_e(session%count))
then 3571 allocate(metaanddatav(session%count))
3573 do while (session%count >0)
3575 call session%ingest_metaanddatai(metaanddatav(i))
3578 allocate(metaanddatav(0))
3581 end subroutine dbasession_ingest_metaanddataiv
3585 subroutine dbasession_ingest_metaanddatab(session,metaanddata)
3586 class(dbasession),
intent(inout) :: session
3587 type(dbametaanddatab),
intent(inout),
optional :: metaanddata
3590 character(len=9) :: btable
3591 integer(kind=int_b) :: value
3593 if (.not.
present(metaanddata))
then 3594 ier = idba_voglioquesto(session%sehandle, session%count)
3596 ier = idba_dammelo(session%sehandle, btable)
3597 ier = idba_enq(session%sehandle, btable,
value)
3598 metaanddata%dbadatab=
dbadatab(btable,
value)
3599 call metaanddata%metadata%dbaenq(session)
3600 session%count=session%count-1
3602 end subroutine dbasession_ingest_metaanddatab
3606 subroutine dbasession_ingest_metaanddatabv(session,metaanddatav)
3607 class(dbasession),
intent(inout) :: session
3608 type(dbametaanddatab),
intent(inout),
allocatable :: metaanddatav(:)
3612 call session%ingest_metaanddatab()
3613 if (c_e(session%count))
then 3614 allocate(metaanddatav(session%count))
3616 do while (session%count >0)
3618 call session%ingest_metaanddatab(metaanddatav(i))
3621 allocate(metaanddatav(0))
3624 end subroutine dbasession_ingest_metaanddatabv
3628 subroutine dbasession_ingest_metaanddatad(session,metaanddata)
3629 class(dbasession),
intent(inout) :: session
3630 type(dbametaanddatad),
intent(inout),
optional :: metaanddata
3633 character(len=9) :: btable
3634 doubleprecision :: value
3636 if (.not.
present(metaanddata))
then 3637 ier = idba_voglioquesto(session%sehandle, session%count)
3639 ier = idba_dammelo(session%sehandle, btable)
3640 ier = idba_enq(session%sehandle, btable,
value)
3641 metaanddata%dbadatad=
dbadatad(btable,
value)
3642 call metaanddata%metadata%dbaenq(session)
3643 session%count=session%count-1
3645 end subroutine dbasession_ingest_metaanddatad
3649 subroutine dbasession_ingest_metaanddatadv(session,metaanddatav)
3650 class(dbasession),
intent(inout) :: session
3651 type(dbametaanddatad),
intent(inout),
allocatable :: metaanddatav(:)
3655 call session%ingest_metaanddatad()
3656 if (c_e(session%count))
then 3657 allocate(metaanddatav(session%count))
3659 do while (session%count >0)
3661 call session%ingest_metaanddatad(metaanddatav(i))
3664 allocate(metaanddatav(0))
3666 end subroutine dbasession_ingest_metaanddatadv
3670 subroutine dbasession_ingest_metaanddatar(session,metaanddata)
3671 class(dbasession),
intent(inout) :: session
3672 type(dbametaanddatar),
intent(inout),
optional :: metaanddata
3675 character(len=9) :: btable
3678 if (.not.
present(metaanddata))
then 3679 ier = idba_voglioquesto(session%sehandle, session%count)
3681 ier = idba_dammelo(session%sehandle, btable)
3682 ier = idba_enq(session%sehandle, btable,
value)
3683 metaanddata%dbadatar=
dbadatar(btable,
value)
3684 call metaanddata%metadata%dbaenq(session)
3685 session%count=session%count-1
3687 end subroutine dbasession_ingest_metaanddatar
3691 subroutine dbasession_ingest_metaanddatarv(session,metaanddatav)
3692 class(dbasession),
intent(inout) :: session
3693 type(dbametaanddatar),
intent(inout),
allocatable :: metaanddatav(:)
3697 call session%ingest_metaanddatar()
3698 if (c_e(session%count))
then 3699 allocate(metaanddatav(session%count))
3701 do while (session%count >0)
3703 call session%ingest_metaanddatar(metaanddatav(i))
3706 allocate(metaanddatav(0))
3708 end subroutine dbasession_ingest_metaanddatarv
3713 subroutine dbasession_ingest_metaanddatac(session,metaanddata)
3714 class(dbasession),
intent(inout) :: session
3715 type(dbametaanddatac),
intent(inout),
optional :: metaanddata
3718 character(len=9) :: btable
3719 character(len=255) :: value
3721 if (.not.
present(metaanddata))
then 3722 ier = idba_voglioquesto(session%sehandle, session%count)
3724 ier = idba_dammelo(session%sehandle, btable)
3725 ier = idba_enq(session%sehandle, btable,
value)
3726 metaanddata%dbadatac=
dbadatac(btable,
value)
3727 call metaanddata%metadata%dbaenq(session)
3728 session%count=session%count-1
3730 end subroutine dbasession_ingest_metaanddatac
3734 subroutine dbasession_ingest_metaanddatacv(session,metaanddatav)
3735 class(dbasession),
intent(inout) :: session
3736 type(dbametaanddatac),
intent(inout),
allocatable :: metaanddatav(:)
3740 call session%ingest_metaanddatac()
3741 if (c_e(session%count))
then 3742 allocate(metaanddatav(session%count))
3744 do while (session%count >0)
3746 call session%ingest_metaanddatac(metaanddatav(i))
3749 allocate(metaanddatav(session%count))
3751 end subroutine dbasession_ingest_metaanddatacv
3755 type(dbaconnection) function dbaconnection_init(dsn, user, password,categoryappend,idbhandle)
3756 character (len=*),
intent(in),
optional :: dsn
3757 character (len=*),
intent(in),
optional :: user
3758 character (len=*),
intent(in),
optional :: password
3759 character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
3760 integer,
INTENT(in),
OPTIONAL :: idbhandle
3763 character(len=512) :: a_name,quidsn
3765 if (
present(categoryappend))
then 3766 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
3768 call l4f_launcher(a_name,a_name_append=trim(subcategory))
3770 dbaconnection_init%category=l4f_category_get(a_name)
3773 ier=idba_error_set_callback(0,c_funloc(dballe_error_handler), &
3774 dbaconnection_init%category,dbaconnection_init%handle_err)
3775 if (.not. c_e(optio_i(idbhandle)))
then 3778 IF (
PRESENT(dsn))
THEN 3779 IF (c_e(dsn)) quidsn = dsn
3782 ier=idba_presentati(dbaconnection_init%dbhandle,quidsn)
3784 dbaconnection_init%dbhandle=optio_i(idbhandle)
3787 end function dbaconnection_init
3790 subroutine dbaconnection_delete(handle)
3791 #ifdef F2003_FULL_FEATURES 3799 if (c_e(handle%dbhandle))
then 3800 ier = idba_arrivederci(handle%dbhandle)
3801 ier = idba_error_remove_callback(handle%handle_err)
3804 end subroutine dbaconnection_delete
3808 recursive type(dbasession) function dbasession_init(connection,anaflag, dataflag, attrflag,&
3809 filename,mode,format,template,write,wipe,repinfo,simplified,memdb,loadfile,categoryappend)
3810 type(dbaconnection),
intent(in),
optional :: connection
3811 character (len=*),
intent(in),
optional :: anaflag
3812 character (len=*),
intent(in),
optional :: dataflag
3813 character (len=*),
intent(in),
optional :: attrflag
3814 character (len=*),
intent(in),
optional :: filename
3815 character (len=*),
intent(in),
optional :: mode
3816 character (len=*),
intent(in),
optional :: template
3817 logical,
INTENT(in),
OPTIONAL :: write
3818 logical,
INTENT(in),
OPTIONAL :: wipe
3819 character(len=*),
INTENT(in),
OPTIONAL :: repinfo
3820 character(len=*),
intent(in),
optional :: format
3821 logical,
intent(in),
optional :: simplified
3822 logical,
intent(in),
optional :: memdb
3823 logical,
intent(in),
optional :: loadfile
3824 character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
3827 character (len=5) :: lanaflag,ldataflag,lattrflag
3828 character (len=1) :: lmode
3829 logical :: lwrite,lwipe
3830 character(len=255) :: lrepinfo
3831 character(len=40) :: lformat
3832 logical :: exist,lsimplified,read_next,lfile,lmemdb,lloadfile
3833 character(len=512) :: a_name
3834 character(len=40) :: ltemplate
3842 if (
present(categoryappend))
then 3843 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
3845 call l4f_launcher(a_name,a_name_append=trim(subcategory))
3847 dbasession_init%category=l4f_category_get(a_name)
3851 if (
present(write))
then 3857 if (
present(wipe))
then 3859 if (
present(repinfo))
then 3868 if (
present(template))
then 3875 if (
present(simplified))
then 3876 lsimplified=simplified
3880 if (
present(format))
then 3886 if (
present(filename))
then 3890 IF (filename ==
'')
THEN 3894 INQUIRE(file=filename,exist=exist)
3898 if (lwipe.or..not.exist)
then 3902 call l4f_category_log(dbasession_init%category,l4f_info,
"file exists; appending data to file")
3905 if (.not.exist)
then 3906 call l4f_category_log(dbasession_init%category,l4f_error,
"file does not exist; cannot open file for read")
3907 CALL raise_fatal_error()
3911 if (
present(mode)) lmode = mode
3913 if (.not.
present(memdb))
then 3914 dbasession_init%memdb=.true.
3917 if (.not.
present(loadfile))
then 3918 dbasession_init%loadfile=.true.
3923 if (
present(memdb))
then 3927 if (
present(loadfile))
then 3932 call optio(anaflag,lanaflag)
3933 if (.not. c_e(lanaflag))
then 3941 call optio(dataflag,ldataflag)
3942 if (.not. c_e(ldataflag))
then 3950 call optio(attrflag,lattrflag)
3951 if (.not. c_e(lattrflag))
then 3967 if (
present(anaflag).or.
present(dataflag).or.
present( attrflag))
then 3968 call l4f_category_log(dbasession_init%category,l4f_error,
"option anaflag, dataflag, attrflag defined with filename access")
3974 if(.not.
present(connection))
then 3975 call l4f_category_log(dbasession_init%category,l4f_error,
"connection not present accessing DBA")
3979 if (
present(mode).or.
present(format).or.
present(template).or.
present(simplified))
then 3980 call l4f_category_log(dbasession_init%category,l4f_error,&
3981 "option mode or format or template or simplified defined without filename")
3989 if (
present(filename))
then 3991 if (.not.
present(connection))
then 3995 dbasession_init=
dbasession(dbasession_init%memconnection,&
3996 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
3997 memdb=lmemdb,loadfile=lloadfile)
4000 dbasession_init%memconnection=connection
4002 dbasession_init=
dbasession(dbasession_init%memconnection,&
4003 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
4004 memdb=lmemdb,loadfile=lloadfile)
4008 if (lmode ==
"r")
then 4009 call dbasession_init%messages_open_input(filename=filename,mode=lmode,&
4010 format=lformat,simplified=lsimplified)
4013 read_next = dbasession_init%messages_read_next()
4014 do while (read_next)
4015 read_next = dbasession_init%messages_read_next()
4020 call dbasession_init%messages_open_output(filename=filename,&
4021 mode=lmode,format=lformat)
4027 ier = idba_messaggi(dbasession_init%sehandle,filename, lmode, lformat)
4033 ier = idba_preparati(connection%dbhandle,dbasession_init%sehandle, lanaflag, ldataflag, lattrflag)
4034 if (lwipe)ier=idba_scopa(dbasession_init%sehandle,lrepinfo)
4038 dbasession_init%file=lfile
4039 if (dbasession_init%file) dbasession_init%filename=filename
4040 dbasession_init%mode=lmode
4041 dbasession_init%format=lformat
4042 dbasession_init%simplified=lsimplified
4043 dbasession_init%memdb=lmemdb
4044 dbasession_init%loadfile=lloadfile
4045 dbasession_init%template=ltemplate
4058 end function dbasession_init
4062 subroutine dbasession_unsetall(session)
4066 if (c_e(session%sehandle))
then 4067 ier = idba_unsetall(session%sehandle)
4070 end subroutine dbasession_unsetall
4074 subroutine dbasession_remove_all(session)
4078 if (c_e(session%sehandle))
then 4079 ier = idba_remove_all(session%sehandle)
4082 end subroutine dbasession_remove_all
4086 subroutine dbasession_prendilo(session)
4090 if (c_e(session%sehandle))
then 4091 ier = idba_prendilo(session%sehandle)
4094 end subroutine dbasession_prendilo
4097 subroutine dbasession_var_related(session,btable)
4099 character(len=*),
INTENT(IN) :: btable
4102 if (c_e(session%sehandle))
then 4103 ier = idba_set(session%sehandle,
"*var_related",btable)
4106 end subroutine dbasession_var_related
4109 subroutine dbasession_setcontextana(session)
4113 if (c_e(session%sehandle))
then 4114 ier = idba_setcontextana(session%sehandle)
4117 end subroutine dbasession_setcontextana
4120 subroutine dbasession_dimenticami(session)
4124 if (c_e(session%sehandle))
then 4125 ier = idba_dimenticami(session%sehandle)
4128 end subroutine dbasession_dimenticami
4131 subroutine dbasession_critica(session)
4135 if (c_e(session%sehandle))
then 4136 ier = idba_critica(session%sehandle)
4139 end subroutine dbasession_critica
4142 subroutine dbasession_scusa(session)
4146 if (c_e(session%sehandle))
then 4147 ier = idba_scusa(session%sehandle)
4150 end subroutine dbasession_scusa
4153 subroutine dbasession_set(session,metadata,datav,data,datetime,ana,network,level,timerange,filter)
4156 class(
dbadcv),
optional :: datav
4157 class(
dbadata),
optional :: data
4159 type(
dbaana),
optional :: ana
4165 if (
present(metadata))
then 4166 call metadata%dbaset(session)
4169 if (
present(datetime))
then 4170 call datetime%dbaset(session)
4173 if (
present(ana))
then 4174 call ana%dbaset(session)
4177 if (
present(network))
then 4178 call network%dbaset(session)
4181 if (
present(level))
then 4182 call level%dbaset(session)
4185 if (
present(timerange))
then 4186 call timerange%dbaset(session)
4189 if (
present(datav))
then 4190 call datav%dbaset(session)
4193 if (
present(data))
then 4194 call data%dbaset(session)
4197 if (
present(filter))
then 4198 call filter%dbaset(session)
4201 end subroutine dbasession_set
4359 # ifndef F2003_FULL_FEATURES 4361 subroutine dbasession_delete(session)
4364 type(dbasession) :: defsession
4366 if (c_e(session%sehandle))
then 4367 ier = idba_fatto(session%sehandle)
4370 call session%memconnection%delete()
4372 select type (session)
4374 session = defsession
4388 end subroutine dbasession_delete
4393 subroutine dbasession_delete(session)
4397 if (c_e(session%sehandle))
then 4398 ier = idba_fatto(session%sehandle)
4412 end subroutine dbasession_delete
4419 subroutine dbasession_filerewind(session)
4423 if (c_e(session%sehandle).and. session%file)
then 4424 ier = idba_fatto(session%sehandle)
4425 ier = idba_messaggi(session%sehandle,session%filename,session%mode,session%format)
4435 end subroutine dbasession_filerewind
4438 FUNCTION dballe_error_handler(category)
4439 INTEGER :: category, code, l4f_level
4440 INTEGER :: dballe_error_handler
4442 CHARACTER(len=1000) :: message, buf
4444 code = idba_error_code()
4447 if (code == 13 )
then 4453 call idba_error_message(message)
4454 call l4f_category_log(category,l4f_level,trim(message))
4456 call idba_error_context(buf)
4458 call l4f_category_log(category,l4f_level,trim(buf))
4460 call idba_error_details(buf)
4461 call l4f_category_log(category,l4f_info,trim(buf))
4465 if (l4f_level == l4f_error )
CALL raise_fatal_error(
"dballe: "//message)
4467 dballe_error_handler = 0
4470 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