62character (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
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
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
352 procedure ::
display => dbadatai_display
357 procedure :: dbadatai_init
364 procedure :: dbadata_getr => dbadatar_getr
365 procedure :: dbaset => dbadatar_set
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
396 procedure ::
display => dbadatab_display
401 procedure :: dbadatab_init
409character(vol7d_cdatalen) :: value
412 procedure :: dbadata_getc => dbadatac_getc
413 procedure :: dbaset => dbadatac_set
414 procedure ::
display => dbadatac_display
419 procedure :: dbadatac_init
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
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
473 procedure ::
display => dbadataattr_display
474 procedure :: extrude => dbadataattr_extrude
479 class(dbadataattr),
allocatable :: dataattr(:)
481 procedure :: display => dbadataattrv_display
482 procedure :: extrude => dbadataattrv_extrude
490 procedure ::
display => dbametaanddata_display
491 procedure :: extrude => dbametaanddata_extrude
499 procedure :: display => dbametaanddatav_display
500 procedure :: extrude => dbametaanddatav_extrude
506 procedure :: current => currentdbametaanddata
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
529 type(dbametadata) :: metadata
531 procedure :: display => dbametaanddatab_display
532 procedure :: extrude => dbametaanddatab_extrude
538 procedure :: current => currentdbametaanddatab
539 procedure ::
display => displaydbametaanddatab
540 procedure :: toarray => toarray_dbametaanddatab
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
595 type(dbadatetime) :: datetime
596 type(dbalevel) :: level
597 type(dbatimerange) :: timerange
598 type(dbanetwork) :: network
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
610 type(
dbadcv) :: anavars,anastarvars
612 procedure :: display => dbafilter_display
613 procedure :: dbaset => dbafilter_set
614 procedure :: equalmetadata => dbafilter_equal_dbametadata
617 generic ::
operator (==) => equalmetadata
622 procedure dbafilter_init
628subroutine displaydbametaanddata(this)
633do while(this%element())
634 print *,
"index:",this%currentindex(),
" value:"
635 element=this%current()
636 call element%display()
639end subroutine displaydbametaanddata
644class(*),
pointer :: v
646v => this%currentpoli()
649 currentdbametaanddata = v
651end function currentdbametaanddata
655elemental logical function dbadata_equal(this,that)
657class(
dbadata),
intent(in) :: this
658class(dbadata),
intent(in) :: that
660if ( this%btable == that%btable )
then
661 dbadata_equal = .true.
663 dbadata_equal = .false.
666end function dbadata_equal
670subroutine dbadata_geti(data,value)
671class(
dbadata),
intent(in) :: data
672integer,
intent(out) ::
value
680end subroutine dbadata_geti
684logical function dbadata_c_e_i(data)
685class(
dbadata),
intent(in) :: data
691 dbadata_c_e_i = c_e(data%value)
694end function dbadata_c_e_i
697subroutine dbadata_getr(data,value)
698class(
dbadata),
intent(in) :: data
699real,
intent(out) ::
value
707end subroutine dbadata_getr
710logical function dbadata_c_e_r(data)
717 dbadata_c_e_r = c_e(data%value)
720end function dbadata_c_e_r
723subroutine dbadata_getd(data,value)
724class(dbadata),
intent(in) :: data
725doubleprecision,
intent(out) ::
value
733end subroutine dbadata_getd
736logical function dbadata_c_e_d(data)
737class(
dbadata),
intent(in) :: data
743 dbadata_c_e_d = c_e(data%value)
746end function dbadata_c_e_d
750subroutine dbadata_getb(data,value)
752INTEGER(kind=int_b),
intent(out) ::
value
760end subroutine dbadata_getb
763logical function dbadata_c_e_b(data)
764class(dbadata),
intent(in) :: data
770 dbadata_c_e_b = c_e(data%value)
773end function dbadata_c_e_b
776subroutine dbadata_getc(data,value)
777class(
dbadata),
intent(in) :: data
778character(len=*),
intent(out) ::
value
786end subroutine dbadata_getc
790logical function dbadata_c_e_c(data)
791class(dbadata),
intent(in) :: data
797 dbadata_c_e_c = c_e(data%value)
800end function dbadata_c_e_c
804logical function dbadata_c_e(data)
807dbadata_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()
810end function dbadata_c_e
814subroutine dbalevel_display(level)
816call display (level%vol7d_level)
817end subroutine dbalevel_display
821type(
dbalevel) function dbalevel_init(level1, l1, level2, l2)
823INTEGER,
INTENT(IN),
OPTIONAL :: level1
824INTEGER,
INTENT(IN),
OPTIONAL :: l1
825INTEGER,
INTENT(IN),
OPTIONAL :: level2
826INTEGER,
INTENT(IN),
OPTIONAL :: l2
828call init (dbalevel_init%vol7d_level,level1, l1, level2, l2)
829end function dbalevel_init
832subroutine dbalevel_set(level,session)
838ier = idba_setlevel(session%sehandle,&
839 level%level1, level%l1, level%level2, level%l2)
842if (.not. c_e(level%vol7d_level))
then
843 call session%setcontextana
846end subroutine dbalevel_set
849subroutine dbalevel_enq(level,session)
850class(
dbalevel),
intent(out) :: level
854ier = idba_enqlevel(session%sehandle,&
855 level%level1, level%l1, level%level2, level%l2)
857end subroutine dbalevel_enq
860type(
dbalevel) function dbalevel_contextana()
864end function dbalevel_contextana
868subroutine dbaana_display(ana)
869class(
dbaana),
intent(in) :: ana
870call display (ana%vol7d_ana)
871end subroutine dbaana_display
876type(
dbacoord) function dbacoord_init(lon, lat, ilon, ilat)
877REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lon
878REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lat
879INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilon
880INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilat
882CALL init(dbacoord_init%geo_coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
884end function dbacoord_init
887subroutine dbacoord_display(coord)
889call display (coord%geo_coord)
890end subroutine dbacoord_display
894type(
dbaana) function dbaana_init(coord,ident,lon, lat, ilon, ilat)
895CHARACTER(len=*),
INTENT(in),
OPTIONAL :: ident
896TYPE(
dbacoord),
INTENT(IN),
optional :: coord
897REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lon
898REAL(kind=fp_geo),
INTENT(in),
OPTIONAL :: lat
899INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilon
900INTEGER(kind=int_l),
INTENT(in),
OPTIONAL :: ilat
902if (
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)
908end function dbaana_init
911subroutine dbaana_set(ana,session)
912class(
dbaana),
intent(in) :: ana
917ier = idba_set(session%sehandle,
"lat",getilat(ana%vol7d_ana%coord))
918ier = idba_set(session%sehandle,
"lon",getilon(ana%vol7d_ana%coord))
919if (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)
927end subroutine dbaana_set
930subroutine dbaana_enq(ana,session)
931class(
dbaana),
intent(out) :: ana
933integer :: ier,ilat,ilon
936ier = idba_enq(session%sehandle,
"lat",ilat)
937ier = idba_enq(session%sehandle,
"lon",ilon)
939call init(ana%vol7d_ana%coord,ilon=ilon,ilat=ilat)
940ier = idba_enq(session%sehandle,
"ident",ana%vol7d_ana%ident)
942end subroutine dbaana_enq
946subroutine dbaana_extrude(ana,session)
947class(
dbaana),
intent(in) :: ana
950call session%unsetall()
952call session%set(ana=ana)
953call session%prendilo()
956call session%close_message()
958end subroutine dbaana_extrude
962subroutine displaydbaana(this)
967do while(this%element())
968 print *,
"index:",this%currentindex(),
" value:"
969 element=this%current()
970 call element%display()
973end subroutine displaydbaana
976type(
dbaana) function currentdbaana(this)
978class(*),
pointer :: v
980v => this%currentpoli()
985end function currentdbaana
989subroutine dbadc_set(dc,session)
990class(
dbadc),
intent(in) :: dc
993call dc%dat%dbaset(session)
995end subroutine dbadc_set
998subroutine dbadc_display(dc)
999class(
dbadc),
intent(in) :: dc
1001call dc%dat%display()
1003end subroutine dbadc_display
1006subroutine dbadcv_set(dcv,session)
1007class(
dbadcv),
intent(in) :: dcv
1011do i=1,
size(dcv%dcv)
1012 call dcv%dcv(i)%dbaset(session)
1015end subroutine dbadcv_set
1020subroutine dbadcv_extrude(dcv,session,noattr,filter,template)
1021class(
dbadcv),
intent(in) :: dcv
1023logical,
intent(in),
optional :: noattr
1024type(
dbafilter),
intent(in),
optional :: filter
1025character(len=*),
intent(in),
optional :: template
1028do i=1,
size(dcv%dcv)
1029 call dcv%dcv(i)%extrude(session,noattr,filter,template=template)
1032end subroutine dbadcv_extrude
1035subroutine dbadc_extrude(data,session,noattr,filter,attronly,template)
1036class(
dbadc),
intent(in) :: data
1038logical,
intent(in),
optional :: noattr
1039type(
dbafilter),
intent(in),
optional :: filter
1040logical,
intent(in),
optional :: attronly
1041character(len=*),
intent(in),
optional :: template
1043call data%extrude(session,noattr,filter,attronly,template)
1045end subroutine dbadc_extrude
1049subroutine dbadcv_display(dcv)
1050class(
dbadcv),
intent(in) :: dcv
1053if (
allocated(dcv%dcv))
then
1054 do i=1,
size(dcv%dcv)
1055 call dcv%dcv(i)%display()
1058end subroutine dbadcv_display
1084subroutine dbasession_unsetb(session)
1089ier=idba_unsetb(session%sehandle)
1091end subroutine dbasession_unsetb
1094subroutine dbasession_close_message(session,template)
1096character(len=*),
intent(in),
optional :: template
1098character(len=40) :: ltemplate
1101ltemplate=session%template
1102if (
present(template)) ltemplate=template
1115if (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()
1135end subroutine dbasession_close_message
1139subroutine dbasession_messages_open_input(session,filename,mode,format,simplified)
1141character (len=*),
intent(in) :: filename
1142character (len=*),
intent(in),
optional :: mode
1143character (len=*),
intent(in),
optional :: format
1144logical,
intent(in),
optional :: simplified
1147character (len=40) :: lmode, lformat
1148logical :: lsimplified
1151if (
present(mode)) lmode=mode
1154if (
present(format)) lformat=
format
1157if (
present(simplified)) lsimplified=simplified
1159ier = idba_messages_open_input(session%sehandle, filename, lmode, lformat, lsimplified)
1161end subroutine dbasession_messages_open_input
1165subroutine dbasession_messages_open_output(session,filename,mode,format)
1167character (len=*),
intent(in) :: filename
1168character (len=*),
intent(in),
optional :: mode
1169character (len=*),
intent(in),
optional :: format
1172character (len=40) :: lmode, lformat
1175if (
present(mode)) lmode=mode
1178if (
present(format)) lformat=
format
1180ier = idba_messages_open_output(session%sehandle, filename, lmode, lformat)
1182end subroutine dbasession_messages_open_output
1186logical function dbasession_messages_read_next(session)
1191ier = idba_messages_read_next(session%sehandle, dbasession_messages_read_next)
1193end function dbasession_messages_read_next
1196subroutine dbasession_messages_write_next(session,template)
1198character(len=*),
optional :: template
1199character(len=40) :: ltemplate
1206ltemplate=session%template
1207if (
present(template)) ltemplate=template
1209ier = idba_messages_write_next(session%sehandle,ltemplate)
1211end subroutine dbasession_messages_write_next
1215subroutine dbasession_dissolve_metadata(session,metadata)
1221do i =1,
size (metadata)
1223 call metadata(i)%dbaset(session)
1224 call session%dissolve()
1228end subroutine dbasession_dissolve_metadata
1233subroutine dbasession_dissolveattr_metadata(session,metadata)
1235type(
dbametadata),
intent(in),
optional :: metadata(:)
1237character(len=9) :: btable
1238integer :: i,ii,count,ier
1240if (
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()
1267end subroutine dbasession_dissolveattr_metadata
1271subroutine dbadataattr_extrude(data,session,noattr,filter,attronly,template)
1274logical,
intent(in),
optional :: noattr
1275type(
dbafilter),
intent(in),
optional :: filter
1276logical,
intent(in),
optional :: attronly
1277character(len=*),
intent(in),
optional :: template
1278integer :: i,ierr,count,code
1280character(len=9) :: btable
1283if (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()
1288if (
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
1302if (.not. data%dbadc%dat%c_e() .and. session%file)
return
1304call data%dbadc%dbaset(session)
1306code = idba_error_code()
1308if (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)
1335if (optio_log(noattr))
return
1338if (
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()
1378end subroutine dbadataattr_extrude
1381subroutine dbadataattr_display(dc)
1385call dc%dbadc%display()
1387call dc%attrv%display()
1389end subroutine dbadataattr_display
1393subroutine dbadataattrv_extrude(dataattr,session,noattr,filter,attronly,template)
1396logical,
intent(in),
optional :: noattr
1397type(
dbafilter),
intent(in),
optional :: filter
1398logical,
intent(in),
optional :: attronly
1399character(len=*),
intent(in),
optional :: template
1403if(.not.
allocated(dataattr%dataattr))
return
1404do i=1,
size(dataattr%dataattr)
1405 call dataattr%dataattr(i)%extrude(session,noattr,filter,attronly,template)
1412end subroutine dbadataattrv_extrude
1415subroutine dbadataattrv_display(dataattr)
1419do i=1,
size(dataattr%dataattr)
1420 call dataattr%dataattr(i)%display()
1423end subroutine dbadataattrv_display
1426subroutine dbadatai_geti(data,value)
1428integer,
intent(out) ::
value
1430end subroutine dbadatai_geti
1433subroutine dbadatar_getr(data,value)
1435real,
intent(out) ::
value
1437end subroutine dbadatar_getr
1440subroutine dbadatad_getd(data,value)
1442doubleprecision,
intent(out) ::
value
1444end subroutine dbadatad_getd
1447subroutine dbadatab_getb(data,value)
1449integer(kind=int_b),
intent(out) ::
value
1451end subroutine dbadatab_getb
1454subroutine dbadatac_getc(data,value)
1456character(len=*),
intent(out) ::
value
1458end subroutine dbadatac_getc
1463type(
dbadatai)
elemental function dbadatai_init(btable,value)
1465character(len=*),
INTENT(IN),
OPTIONAL :: btable
1466INTEGER,
INTENT(IN),
OPTIONAL ::
value
1468if (
present(btable))
then
1469 dbadatai_init%btable=btable
1471 dbadatai_init%btable=cmiss
1474if (
present(
value))
then
1475 dbadatai_init%value=
value
1477 dbadatai_init%value=imiss
1480end function dbadatai_init
1484type(
dbadatar)
elemental function dbadatar_init(btable,value)
1486character(len=*),
INTENT(IN),
OPTIONAL :: btable
1487real,
INTENT(IN),
OPTIONAL ::
value
1489if (
present(btable))
then
1490 dbadatar_init%btable=btable
1492 dbadatar_init%btable=cmiss
1495if (
present(
value))
then
1496 dbadatar_init%value=
value
1498 dbadatar_init%value=rmiss
1501end function dbadatar_init
1505type(
dbadatad)
elemental function dbadatad_init(btable,value)
1507character(len=*),
INTENT(IN),
OPTIONAL :: btable
1508double precision,
INTENT(IN),
OPTIONAL ::
value
1510if (
present(btable))
then
1511 dbadatad_init%btable=btable
1513 dbadatad_init%btable=cmiss
1516if (
present(
value))
then
1517 dbadatad_init%value=
value
1519 dbadatad_init%value=dmiss
1522end function dbadatad_init
1527type(
dbadatab)
elemental function dbadatab_init(btable,value)
1529character(len=*),
INTENT(IN),
OPTIONAL :: btable
1530INTEGER(kind=int_b) ,
INTENT(IN),
OPTIONAL ::
value
1532if (
present(btable))
then
1533 dbadatab_init%btable=btable
1535 dbadatab_init%btable=cmiss
1538if (
present(
value))
then
1539 dbadatab_init%value=
value
1541 dbadatab_init%value=bmiss
1544end function dbadatab_init
1548type(
dbadatac)
elemental function dbadatac_init(btable,value)
1550character(len=*),
INTENT(IN),
OPTIONAL :: btable
1551character(len=*),
INTENT(IN),
OPTIONAL ::
value
1553if (
present(btable))
then
1554 dbadatac_init%btable=btable
1556 dbadatac_init%btable=cmiss
1559if (
present(
value))
then
1560 dbadatac_init%value=
value
1562 dbadatac_init%value=cmiss
1565end function dbadatac_init
1569subroutine dbadatai_set(data,session)
1573if (.not. c_e(data%btable))
return
1574ier = idba_set(session%sehandle,data%btable,data%value)
1575end subroutine dbadatai_set
1578subroutine dbadatai_display(data)
1580print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1581end subroutine dbadatai_display
1584subroutine dbadatar_set(data,session)
1588if (.not. c_e(data%btable))
return
1589ier = idba_set(session%sehandle,data%btable,data%value)
1590end subroutine dbadatar_set
1593subroutine dbadatar_display(data)
1595print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1596end subroutine dbadatar_display
1600subroutine dbadatad_set(data,session)
1604if (.not. c_e(data%btable))
return
1605ier = idba_set(session%sehandle,data%btable,data%value)
1606end subroutine dbadatad_set
1609subroutine dbadatad_display(data)
1611print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1612end subroutine dbadatad_display
1615subroutine dbadatab_set(data,session)
1619if (.not. c_e(data%btable))
return
1620ier = idba_set(session%sehandle,data%btable,data%value)
1621end subroutine dbadatab_set
1624subroutine dbadatab_display(data)
1626print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1627end subroutine dbadatab_display
1630subroutine dbadatac_set(data,session)
1634if (.not. c_e(data%btable))
return
1635ier = idba_set(session%sehandle,data%btable,data%value)
1636end subroutine dbadatac_set
1639subroutine dbadatac_display(data)
1641print *,
"Btable: ", t2c(data%btable,miss=
"Missing"),
" Value: ", t2c(data%value,miss=
"Missing value")
1642end subroutine dbadatac_display
1658subroutine dbatimerange_display(timerange)
1660call display (timerange%vol7d_timerange)
1661end subroutine dbatimerange_display
1664subroutine dbatimerange_set(timerange,session)
1669ier = idba_settimerange(session%sehandle,&
1670 timerange%timerange, timerange%p1, timerange%p2)
1673if (.not. c_e(timerange%vol7d_timerange))
then
1674 call session%setcontextana
1677end subroutine dbatimerange_set
1680subroutine dbatimerange_enq(timerange,session)
1685ier = idba_enqtimerange(session%sehandle,&
1686 timerange%timerange, timerange%p1, timerange%p2)
1688end subroutine dbatimerange_enq
1692type(
dbatimerange) function dbatimerange_init(timerange, p1, p2)
1693INTEGER,
INTENT(IN),
OPTIONAL :: timerange
1694INTEGER,
INTENT(IN),
OPTIONAL :: p1
1695INTEGER,
INTENT(IN),
OPTIONAL :: p2
1697call init (dbatimerange_init%vol7d_timerange,timerange, p1, p2)
1698end function dbatimerange_init
1705end function dbatimerange_contextana
1709subroutine dbanetwork_display(network)
1711call display (network%vol7d_network)
1712print *,
"Priority=",network%priority
1713end subroutine dbanetwork_display
1716subroutine dbanetwork_set(network,session)
1721ier = idba_set(session%sehandle,
"rep_memo", network%name)
1723end subroutine dbanetwork_set
1726subroutine dbanetwork_enq(network,session)
1731ier = idba_enq(session%sehandle,
"rep_memo", network%name)
1732ier = idba_enq(session%sehandle,
"priority", network%priority)
1734end subroutine dbanetwork_enq
1738type(
dbanetwork) function dbanetwork_init(name)
1739CHARACTER(len=*),
INTENT(in),
OPTIONAL :: name
1741call init (dbanetwork_init%vol7d_network,name)
1742dbanetwork_init%priority=imiss
1743end function dbanetwork_init
1747subroutine dbadatetime_display(datetime)
1749call display (datetime%datetime)
1750end subroutine dbadatetime_display
1753subroutine dbadatetime_set(datetime,session)
1756integer :: ier,year,month,day,hour,minute,sec,msec
1758CALL getval(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1761 sec=nint(float(msec)/1000.)
1766ier = idba_setdate(session%sehandle,year,month,day,hour,minute,sec)
1769if (.not. c_e(datetime%datetime))
then
1770 call session%setcontextana
1773end subroutine dbadatetime_set
1776subroutine dbadatetime_enq(datetime,session)
1780integer :: ier,year,month,day,hour,minute,sec,msec
1782ier = idba_enqdate(session%sehandle,year,month,day,hour,minute,sec)
1793 datetime%datetime=datetime_new()
1795 CALL init(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
1798end subroutine dbadatetime_enq
1803type(datetime),
INTENT(in),
OPTIONAL :: dt
1805if (
present(dt))
then
1806 dbadatetime_init%datetime=dt
1808 dbadatetime_init%datetime=datetime_new()
1811end function dbadatetime_init
1814type(
dbadatetime) function dbadatetime_contextana()
1816dbadatetime_contextana%datetime=datetime_new()
1818end function dbadatetime_contextana
1823type(
dbametadata) function dbametadata_init(level,timerange,ana,network,datetime)
1825type(
dbalevel),
intent(in),
optional :: level
1828type(
dbanetwork),
intent(in),
optional :: network
1829type(
dbadatetime),
intent(in),
optional :: datetime
1831if (
present(level))
then
1832 dbametadata_init%level=level
1837if (
present(timerange))
then
1838 dbametadata_init%timerange=timerange
1843if (
present(ana))
then
1844 dbametadata_init%ana=ana
1849if (
present(network))
then
1850 dbametadata_init%network=network
1855if (
present(datetime))
then
1856 dbametadata_init%datetime=datetime
1861end function dbametadata_init
1864subroutine dbametadata_display(metadata)
1866call metadata%level%display()
1867call metadata%timerange%display()
1868call metadata%ana%display()
1869call metadata%network%display()
1870call metadata%datetime%display()
1872end subroutine dbametadata_display
1875subroutine dbametadata_set(metadata,session)
1882call metadata%ana%dbaset(session)
1883call metadata%network%dbaset(session)
1885if (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()
1897end subroutine dbametadata_set
1900subroutine dbametadata_enq(metadata,session)
1904call metadata%ana%dbaenq(session)
1905call metadata%network%dbaenq(session)
1906call metadata%datetime%dbaenq(session)
1907call metadata%level%dbaenq(session)
1908call metadata%timerange%dbaenq(session)
1910end subroutine dbametadata_enq
1914logical function dbafilter_equal_dbametadata(this,that)
1919dbafilter_equal_dbametadata = .false.
1923if (this%contextana .and. c_e(that%timerange%vol7d_timerange))
return
1924if (this%contextana .and. c_e(that%datetime%datetime))
return
1925if (this%contextana .and. c_e(that%level%vol7d_level))
return
1927if (c_e(this%level%vol7d_level) .and. .not. this%level%vol7d_level == that%level%vol7d_level )
return
1928if (c_e(this%timerange%vol7d_timerange) .and. .not. this%timerange%vol7d_timerange == that%timerange%vol7d_timerange )
return
1929if (c_e(this%datetime%datetime) .and. .not. this%datetime%datetime == that%datetime%datetime )
return
1930if (c_e(this%network%vol7d_network) .and. .not. this%network%vol7d_network == that%network%vol7d_network )
return
1931if (c_e(this%ana%vol7d_ana) .and. .not. this%ana%vol7d_ana == that%ana%vol7d_ana )
return
1933if ( c_e(this%datetimemin%datetime) .and. c_e(that%datetime%datetime) .and. &
1934 this%datetimemin%datetime > that%datetime%datetime )
return
1935if ( c_e(this%datetimemax%datetime) .and. c_e(that%datetime%datetime) .and. &
1936 this%datetimemax%datetime < that%datetime%datetime )
return
1938if (c_e(this%coordmin%geo_coord))
then
1939 if (geo_coord_ll(that%ana%vol7d_ana%coord, this%coordmin%geo_coord))
return
1942if (c_e(this%coordmax%geo_coord))
then
1943 if (geo_coord_ur(that%ana%vol7d_ana%coord, this%coordmax%geo_coord))
return
1946dbafilter_equal_dbametadata = .true.
1948end function dbafilter_equal_dbametadata
1977elemental logical function dbadcv_equal_dbadata(this,that)
1979class(
dbadcv),
intent(in) :: this
1980class(
dbadata),
intent(in) :: that
1987if (
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.
1997end function dbadcv_equal_dbadata
2001elemental 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.
2018end function dbametadata_equal
2024type(
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)
2030type(
dbafilter),
intent(in),
optional :: filter
2031type(
dbaana),
intent(in),
optional :: ana
2032character(len=*),
intent(in),
optional :: var
2034type(
dbalevel),
intent(in),
optional :: level
2036type(
dbanetwork),
intent(in),
optional :: network
2037type(
dbacoord),
intent(in),
optional :: coordmin
2038type(
dbacoord),
intent(in),
optional :: coordmax
2039type(
dbadatetime),
intent(in),
optional :: datetimemin
2040type(
dbadatetime),
intent(in),
optional :: datetimemax
2041integer,
intent(in),
optional :: limit
2042character(len=*),
intent(in),
optional :: ana_filter
2043character(len=*),
intent(in),
optional :: data_filter
2044character(len=*),
intent(in),
optional :: attr_filter
2045character(len=*),
intent(in),
optional :: varlist
2046character(len=*),
intent(in),
optional :: starvarlist
2047character(len=*),
intent(in),
optional :: anavarlist
2048character(len=*),
intent(in),
optional :: anastarvarlist
2049integer,
intent(in),
optional :: priority
2050integer,
intent(in),
optional :: priomin
2051integer,
intent(in),
optional :: priomax
2052logical,
intent(in),
optional :: contextana
2053class(
dbadcv),
intent(in),
optional :: vars
2054class(
dbadcv),
intent(in),
optional :: starvars
2055class(
dbadcv),
intent(in),
optional :: anavars
2056class(
dbadcv),
intent(in),
optional :: anastarvars
2057character(len=*),
intent(in),
optional :: query
2058logical,
intent(in),
optional :: anaonly
2059logical,
intent(in),
optional :: dataonly
2062logical :: nopreserve
2065if (
present(filter))
then
2066 dbafilter_init=filter
2104if (
present(ana))
then
2105 dbafilter_init%ana=ana
2106else if (nopreserve)
then
2107 dbafilter_init%ana=
dbaana()
2110if (
present(var))
then
2111 dbafilter_init%var=var
2112else if (nopreserve)
then
2113 dbafilter_init%var=cmiss
2116if (
present(datetime))
then
2117 dbafilter_init%datetime=datetime
2118else if (nopreserve)
then
2122if (
present(level))
then
2123 dbafilter_init%level=level
2124else if (nopreserve)
then
2128if (
present(timerange))
then
2129 dbafilter_init%timerange=timerange
2130else if (nopreserve)
then
2134if (
present(network))
then
2135 dbafilter_init%network=network
2136else if (nopreserve)
then
2140if (
present(datetimemin))
then
2141 dbafilter_init%datetimemin=datetimemin
2142else if (nopreserve)
then
2146if (
present(datetimemax))
then
2147 dbafilter_init%datetimemax=datetimemax
2148else if (nopreserve)
then
2152if (
present(coordmin))
then
2153 dbafilter_init%coordmin=coordmin
2154else if (nopreserve)
then
2158if (
present(coordmax))
then
2159 dbafilter_init%coordmax=coordmax
2160else if (nopreserve)
then
2164if (
present(limit))
then
2165 dbafilter_init%limit=limit
2166else if (nopreserve)
then
2167 dbafilter_init%limit=imiss
2170if (
present(ana_filter))
then
2171 dbafilter_init%ana_filter=ana_filter
2172else if (nopreserve)
then
2173 dbafilter_init%ana_filter=cmiss
2176if (
present(data_filter))
then
2177 dbafilter_init%data_filter=data_filter
2178else if (nopreserve)
then
2179 dbafilter_init%data_filter=cmiss
2182if (
present(attr_filter))
then
2183 dbafilter_init%attr_filter=attr_filter
2184else if (nopreserve)
then
2185 dbafilter_init%attr_filter=cmiss
2188if (
present(varlist))
then
2189 dbafilter_init%varlist=varlist
2190else if (nopreserve)
then
2191 dbafilter_init%varlist=cmiss
2194if (
present(starvarlist))
then
2195 dbafilter_init%starvarlist=starvarlist
2196else if (nopreserve)
then
2197 dbafilter_init%starvarlist=cmiss
2200if (
present(anavarlist))
then
2201 dbafilter_init%anavarlist=anavarlist
2202else if (nopreserve)
then
2203 dbafilter_init%anavarlist=cmiss
2206if (
present(anastarvarlist))
then
2207 dbafilter_init%anastarvarlist=anastarvarlist
2208else if (nopreserve)
then
2209 dbafilter_init%anastarvarlist=cmiss
2212if (
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)//
","
2227if (
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)//
","
2243if (
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)//
","
2258if (
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)//
","
2273if (
present(priority))
then
2274 dbafilter_init%priority=priority
2275else if (nopreserve)
then
2276 dbafilter_init%priority=imiss
2279if (
present(priomin))
then
2280 dbafilter_init%priomin=priomax
2281else if (nopreserve)
then
2282 dbafilter_init%priomin=imiss
2285if (
present(priomax))
then
2286 dbafilter_init%priomax=priomax
2287else if (nopreserve)
then
2288 dbafilter_init%priomax=imiss
2291if (
present(contextana))
then
2292 dbafilter_init%contextana=contextana
2293else if (nopreserve)
then
2294 dbafilter_init%contextana=.false.
2297if (
present(anaonly))
then
2298 dbafilter_init%anaonly=anaonly
2299else if (nopreserve)
then
2300 dbafilter_init%anaonly=.false.
2302if (
present(dataonly))
then
2303 dbafilter_init%dataonly=dataonly
2304else if (nopreserve)
then
2305 dbafilter_init%dataonly=.false.
2308if (
present(query))
then
2309 dbafilter_init%query=query
2310else if (nopreserve)
then
2311 dbafilter_init%query=cmiss
2314end function dbafilter_init
2317subroutine dbafilter_display(filter)
2320print *,
"------------------ filter ---------------"
2321call filter%ana%display()
2322call filter%datetime%display()
2323call filter%level%display()
2324call filter%timerange%display()
2325call filter%network%display()
2326print *,
" >>>> minimum:"
2327call filter%datetimemin%display()
2328call filter%coordmin%display()
2329print *,
" >>>> maximum:"
2330call filter%datetimemax%display()
2331call filter%coordmax%display()
2332print *,
" >>>> vars:"
2333call filter%vars%display()
2334print *,
" >>>> starvars:"
2335call filter%starvars%display()
2336print *,
" >>>> anavars:"
2337call filter%anavars%display()
2338print *,
" >>>> anastarvars:"
2339call filter%anastarvars%display()
2340print *,
"var=",filter%var
2341print *,
"limit=",filter%limit
2342print *,
"ana_filter=",trim(filter%ana_filter)
2343print *,
"data_filter=",trim(filter%data_filter)
2344print *,
"attr_filter=",trim(filter%attr_filter)
2345print *,
"varlist=",trim(filter%varlist)
2346print *,
"*varlist=",trim(filter%starvarlist)
2347print *,
"anavarlist=",trim(filter%anavarlist)
2348print *,
"ana*varlist=",trim(filter%anastarvarlist)
2349print *,
"priority=",filter%priority
2350print *,
"priomin=",filter%priomin
2351print *,
"priomax=",filter%priomax
2352print *,
"contextana=",filter%contextana
2353print *,
"anaonly=",filter%anaonly
2354print *,
"dataonly=",filter%dataonly
2355print *,
"query=",trim(filter%query)
2357print *,
"-----------------------------------------"
2359end subroutine dbafilter_display
2362subroutine dbafilter_set(filter,session)
2366integer :: ier,year,month,day,hour,minute,sec,msec
2368call session%unsetall()
2370call filter%ana%dbaset(session)
2371call filter%network%dbaset(session)
2372ier = idba_set(session%sehandle,
"var",filter%var)
2374ier = idba_set(session%sehandle,
"limit",filter%limit)
2375ier = idba_set(session%sehandle,
"priority",filter%priority)
2376ier = idba_set(session%sehandle,
"priomin",filter%priomin)
2377ier = idba_set(session%sehandle,
"priomax",filter%priomax)
2379ier = idba_set(session%sehandle,
"latmin",getilat(filter%coordmin%geo_coord))
2380ier = idba_set(session%sehandle,
"lonmin",getilon(filter%coordmin%geo_coord))
2381ier = idba_set(session%sehandle,
"latmax",getilat(filter%coordmax%geo_coord))
2382ier = idba_set(session%sehandle,
"lonmax",getilon(filter%coordmax%geo_coord))
2384ier = idba_set(session%sehandle,
"ana_filter",filter%ana_filter)
2385ier = idba_set(session%sehandle,
"data_filter",filter%data_filter)
2386ier = idba_set(session%sehandle,
"attr_filter",filter%attr_filter)
2388ier = idba_set(session%sehandle,
"query",filter%query)
2390if (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)
2437end subroutine dbafilter_set
2441type(
dbametadata) function dbametadata_contextana(metadata)
2448select type(metadata)
2450 dbametadata_contextana=metadata
2453dbametadata_contextana%datetime=datetime%dbacontextana()
2454dbametadata_contextana%level=level%dbacontextana()
2455dbametadata_contextana%timerange=timerange%dbacontextana()
2457end function dbametadata_contextana
2461subroutine dbametaanddata_display(metaanddata)
2464call metaanddata%metadata%display()
2465call metaanddata%dataattrv%display()
2467end subroutine dbametaanddata_display
2470subroutine dbametaanddata_extrude(metaanddata,session,noattr,filter,attronly,template)
2473logical,
intent(in),
optional :: noattr
2474type(
dbafilter),
intent(in),
optional :: filter
2475logical,
intent(in),
optional :: attronly
2476character(len=*),
intent(in),
optional :: template
2484myfilter=
dbafilter(filter=filter,contextana=.false.)
2485call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2488myfilter=
dbafilter(filter=filter,contextana=.true.)
2489call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2493subroutine extrude(metaanddata,session,noattr,filter,attronly,template)
2496logical,
intent(in),
optional :: noattr
2498logical,
intent(in),
optional :: attronly
2499character(len=*),
intent(in),
optional :: template
2501if (.not. filter == metaanddata%metadata)
return
2503call session%unsetall()
2505call session%set(metadata=metaanddata%metadata)
2509call metaanddata%dataattrv%extrude(session,noattr,filter,attronly)
2512call session%close_message(template)
2514end subroutine extrude
2515end subroutine dbametaanddata_extrude
2519subroutine dbametaanddatav_display(metaanddatav)
2522call metaanddatav%metadata%display()
2523call metaanddatav%datav%display()
2525end subroutine dbametaanddatav_display
2528subroutine dbametaanddatav_extrude(metaanddatav,session,noattr,filter,template)
2531logical,
intent(in),
optional :: noattr
2532type(
dbafilter),
intent(in),
optional :: filter
2533character(len=*),
intent(in),
optional :: template
2537myfilter=
dbafilter(filter=filter,contextana=.false.)
2538call extrude(metaanddatav,session,noattr,myfilter,template)
2540myfilter=
dbafilter(filter=filter,contextana=.true.)
2541call extrude(metaanddatav,session,noattr,myfilter,template)
2545subroutine extrude(metaanddatav,session,noattr,filter,template)
2548logical,
intent(in),
optional :: noattr
2550character(len=*),
intent(in),
optional :: template
2552if (.not. filter == metaanddatav%metadata)
return
2554call session%set(metadata=metaanddatav%metadata)
2558call metaanddatav%datav%extrude(session,noattr,filter,template)
2560print*,
"dbaana_metaanddatav"
2562call session%close_message(template)
2564end subroutine extrude
2565end subroutine dbametaanddatav_extrude
2569subroutine dbametaanddatal_extrude(metaanddatal,session,noattr,filter,attronly,template)
2572logical,
intent(in),
optional :: noattr
2573type(
dbafilter),
intent(in),
optional :: filter
2575logical,
intent(in),
optional :: attronly
2576character(len=*),
intent(in),
optional :: template
2578call metaanddatal%rewind()
2579do while(metaanddatal%element())
2581 metaanddata=metaanddatal%current()
2582 call metaanddata%extrude(session,noattr,filter,attronly,template)
2583 call metaanddatal%next()
2586end subroutine dbametaanddatal_extrude
2590subroutine displaydbametaanddatai(this)
2595do while(this%element())
2596 print *,
"index:",this%currentindex(),
" value:"
2597 element=this%current()
2598 call element%display()
2601end subroutine displaydbametaanddatai
2606class(*),
pointer :: v
2608v => this%currentpoli()
2611 currentdbametaanddatai = v
2613end function currentdbametaanddatai
2617subroutine dbasession_ingest_metaanddatail(session,metaanddatal,filter)
2620type(
dbafilter),
intent(in),
optional :: filter
2625if (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()
2647end subroutine dbasession_ingest_metaanddatail
2650function toarray_dbametaanddatai(this)
2656allocate (toarray_dbametaanddatai(this%countelements()))
2660do while(this%element())
2662 toarray_dbametaanddatai(i) =this%current()
2665end function toarray_dbametaanddatai
2669subroutine displaydbametaanddatar(this)
2674do while(this%element())
2675 print *,
"index:",this%currentindex(),
" value:"
2676 element=this%current()
2677 call element%display()
2680end subroutine displaydbametaanddatar
2685class(*),
pointer :: v
2687v => this%currentpoli()
2690 currentdbametaanddatar = v
2692end function currentdbametaanddatar
2696subroutine dbasession_ingest_metaanddatarl(session,metaanddatal,filter)
2699type(
dbafilter),
intent(in),
optional :: filter
2703if (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()
2726end subroutine dbasession_ingest_metaanddatarl
2730function toarray_dbametaanddatar(this)
2735i=this%countelements()
2737allocate (toarray_dbametaanddatar(this%countelements()))
2741do while(this%element())
2743 toarray_dbametaanddatar(i) =this%current()
2746end function toarray_dbametaanddatar
2750subroutine displaydbametaanddatad(this)
2755do while(this%element())
2756 print *,
"index:",this%currentindex(),
" value:"
2757 element=this%current()
2758 call element%display()
2761end subroutine displaydbametaanddatad
2766class(*),
pointer :: v
2768v => this%currentpoli()
2771 currentdbametaanddatad = v
2773end function currentdbametaanddatad
2776subroutine dbasession_ingest_metaanddatadl(session,metaanddatal,filter)
2779type(
dbafilter),
intent(in),
optional :: filter
2783if (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()
2805end subroutine dbasession_ingest_metaanddatadl
2809function toarray_dbametaanddatad(this)
2815allocate (toarray_dbametaanddatad(this%countelements()))
2819do while(this%element())
2821 toarray_dbametaanddatad(i) =this%current()
2824end function toarray_dbametaanddatad
2828subroutine displaydbametaanddatab(this)
2833do while(this%element())
2834 print *,
"index:",this%currentindex(),
" value:"
2835 element=this%current()
2836 call element%display()
2839end subroutine displaydbametaanddatab
2844class(*),
pointer :: v
2846v => this%currentpoli()
2849 currentdbametaanddatab = v
2851end function currentdbametaanddatab
2855subroutine dbasession_ingest_metaanddatabl(session,metaanddatal,filter)
2858type(
dbafilter),
intent(in),
optional :: filter
2862if (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()
2884end subroutine dbasession_ingest_metaanddatabl
2888function toarray_dbametaanddatab(this)
2894allocate (toarray_dbametaanddatab(this%countelements()))
2898do while(this%element())
2900 toarray_dbametaanddatab(i) =this%current()
2903end function toarray_dbametaanddatab
2907subroutine displaydbametaanddatac(this)
2912do while(this%element())
2913 print *,
"index:",this%currentindex(),
" value:"
2914 element=this%current()
2915 call element%display()
2918end subroutine displaydbametaanddatac
2923class(*),
pointer :: v
2925v => this%currentpoli()
2928 currentdbametaanddatac = v
2930end function currentdbametaanddatac
2934subroutine dbasession_ingest_metaanddatacl(session,metaanddatal,filter)
2937type(
dbafilter),
intent(in),
optional :: filter
2941if (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()
2963end subroutine dbasession_ingest_metaanddatacl
2967function toarray_dbametaanddatac(this)
2973allocate (toarray_dbametaanddatac(this%countelements()))
2977do while(this%element())
2979 toarray_dbametaanddatac(i) =this%current()
2982end function toarray_dbametaanddatac
2986subroutine dbametaanddatai_display(data)
2989call data%metadata%display()
2990call data%dbadatai%display()
2992end subroutine dbametaanddatai_display
2995subroutine dbametaanddatab_display(data)
2998call data%metadata%display()
2999call data%dbadatab%display()
3001end subroutine dbametaanddatab_display
3004subroutine dbametaanddatad_display(data)
3007call data%metadata%display()
3008call data%dbadatad%display()
3010end subroutine dbametaanddatad_display
3013subroutine dbametaanddatar_display(data)
3016call data%metadata%display()
3017call data%dbadatar%display()
3019end subroutine dbametaanddatar_display
3023subroutine dbametaanddatac_display(data)
3026call data%metadata%display()
3027call data%dbadatac%display()
3029end subroutine dbametaanddatac_display
3033subroutine dbametaanddatai_extrude(metaanddatai,session)
3037call session%unsetall()
3039call session%set(metadata=metaanddatai%metadata)
3041call session%set(data=metaanddatai%dbadatai)
3043if (metaanddatai%dbadatai%c_e())
then
3044 call session%prendilo()
3046 call session%dimenticami()
3049end subroutine dbametaanddatai_extrude
3052subroutine dbametaanddatab_extrude(metaanddatab,session)
3056call session%unsetall()
3058call session%set(metadata=metaanddatab%metadata)
3060call session%set(data=metaanddatab%dbadatab)
3062if (metaanddatab%dbadatab%c_e())
then
3063 call session%prendilo()
3065 call session%dimenticami()
3068end subroutine dbametaanddatab_extrude
3071subroutine dbametaanddatad_extrude(metaanddatad,session)
3075call session%unsetall()
3077call session%set(metadata=metaanddatad%metadata)
3079call session%set(data=metaanddatad%dbadatad)
3081if (metaanddatad%dbadatad%c_e())
then
3082 call session%prendilo()
3084 call session%dimenticami()
3087end subroutine dbametaanddatad_extrude
3090subroutine dbametaanddatar_extrude(metaanddatar,session)
3094call session%unsetall()
3096call session%set(metadata=metaanddatar%metadata)
3098call session%set(data=metaanddatar%dbadatar)
3100if (metaanddatar%dbadatar%c_e())
then
3101 call session%prendilo()
3103 call session%dimenticami()
3106end subroutine dbametaanddatar_extrude
3109subroutine dbametaanddatac_extrude(metaanddatac,session)
3113call session%unsetall()
3115call session%set(metadata=metaanddatac%metadata)
3117call session%set(data=metaanddatac%dbadatac)
3119if (metaanddatac%dbadatac%c_e())
then
3120 call session%prendilo()
3122 call session%dimenticami()
3125end subroutine dbametaanddatac_extrude
3128subroutine dbasession_ingest_ana(session,ana)
3130type(
dbaana),
intent(out),
optional :: ana
3134if (.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
3143end subroutine dbasession_ingest_ana
3147subroutine dbasession_ingest_anav(session,anav)
3149type(
dbaana),
intent(out),
allocatable :: anav(:)
3152call session%ingest_ana()
3154if (c_e(session%count))
then
3155 allocate(anav(session%count))
3157 do while (session%count >0)
3159 call session%ingest_ana(anav(i))
3165end subroutine dbasession_ingest_anav
3169subroutine dbasession_ingest_anal(session,anal)
3174call session%ingest_ana()
3175do 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()
3180end subroutine dbasession_ingest_anal
3184subroutine dbasession_ingest_metaanddata(session,metaanddata,noattr,filter)
3187logical,
intent(in),
optional :: noattr
3188type(
dbafilter),
intent(in),
optional :: filter
3191integer :: ier,acount,i,j,k
3192character(len=9) :: btable
3193character(255) :: value
3194logical :: lvars,lstarvars
3195type(
dbadcv) :: vars,starvars
3199if (.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))
3444end subroutine dbasession_ingest_metaanddata
3448subroutine dbasession_ingest_metaanddatav(session,metaanddatav,noattr,filter)
3450type(
dbametaanddata),
intent(inout),
allocatable :: metaanddatav(:)
3451logical,
intent(in),
optional :: noattr
3452type(
dbafilter),
intent(in),
optional :: filter
3458if (
present(filter))
then
3459 call filter%dbaset(session)
3461 call session%unsetall()
3464call session%ingest()
3467if (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))
3492end subroutine dbasession_ingest_metaanddatav
3496subroutine dbasession_ingest_metaanddatal(session,metaanddatal,noattr,filter)
3499logical,
intent(in),
optional :: noattr
3500type(
dbafilter),
intent(in),
optional :: filter
3505if (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)
3539end subroutine dbasession_ingest_metaanddatal
3542subroutine dbasession_ingest_metaanddatai(session,metaanddata)
3547character(len=9) :: btable
3550if (.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
3559end subroutine dbasession_ingest_metaanddatai
3563subroutine dbasession_ingest_metaanddataiv(session,metaanddatav)
3569call session%ingest_metaanddatai()
3570if (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))
3581end subroutine dbasession_ingest_metaanddataiv
3585subroutine dbasession_ingest_metaanddatab(session,metaanddata)
3590character(len=9) :: btable
3591integer(kind=int_b) :: value
3593if (.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
3602end subroutine dbasession_ingest_metaanddatab
3606subroutine dbasession_ingest_metaanddatabv(session,metaanddatav)
3612call session%ingest_metaanddatab()
3613if (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))
3624end subroutine dbasession_ingest_metaanddatabv
3628subroutine dbasession_ingest_metaanddatad(session,metaanddata)
3633character(len=9) :: btable
3634doubleprecision :: value
3636if (.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
3645end subroutine dbasession_ingest_metaanddatad
3649subroutine dbasession_ingest_metaanddatadv(session,metaanddatav)
3655call session%ingest_metaanddatad()
3656if (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))
3666end subroutine dbasession_ingest_metaanddatadv
3670subroutine dbasession_ingest_metaanddatar(session,metaanddata)
3675character(len=9) :: btable
3678if (.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
3687end subroutine dbasession_ingest_metaanddatar
3691subroutine dbasession_ingest_metaanddatarv(session,metaanddatav)
3697call session%ingest_metaanddatar()
3698if (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))
3708end subroutine dbasession_ingest_metaanddatarv
3713subroutine dbasession_ingest_metaanddatac(session,metaanddata)
3718character(len=9) :: btable
3719character(len=255) :: value
3721if (.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
3730end subroutine dbasession_ingest_metaanddatac
3734subroutine dbasession_ingest_metaanddatacv(session,metaanddatav)
3740call session%ingest_metaanddatac()
3741if (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))
3751end subroutine dbasession_ingest_metaanddatacv
3755type(
dbaconnection) function dbaconnection_init(dsn, user, password,categoryappend,idbhandle)
3756character (len=*),
intent(in),
optional :: dsn
3757character (len=*),
intent(in),
optional :: user
3758character (len=*),
intent(in),
optional :: password
3759character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
3760integer,
INTENT(in),
OPTIONAL :: idbhandle
3763character(len=512) :: a_name,quidsn
3765if (
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))
3770dbaconnection_init%category=l4f_category_get(a_name)
3773ier=idba_error_set_callback(0,c_funloc(dballe_error_handler), &
3774 dbaconnection_init%category,dbaconnection_init%handle_err)
3775if (.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)
3787end function dbaconnection_init
3790subroutine dbaconnection_delete(handle)
3791#ifdef F2003_FULL_FEATURES
3792type (dbaconnection),
intent(inout) :: handle
3799if (c_e(handle%dbhandle))
then
3800 ier = idba_arrivederci(handle%dbhandle)
3801 ier = idba_error_remove_callback(handle%handle_err)
3804end subroutine dbaconnection_delete
3808recursive type(
dbasession) function dbasession_init(connection,anaflag, dataflag, attrflag,&
3809 filename,mode,format,template,write,wipe,repinfo,simplified,memdb,loadfile,categoryappend)
3811character (len=*),
intent(in),
optional :: anaflag
3812character (len=*),
intent(in),
optional :: dataflag
3813character (len=*),
intent(in),
optional :: attrflag
3814character (len=*),
intent(in),
optional :: filename
3815character (len=*),
intent(in),
optional :: mode
3816character (len=*),
intent(in),
optional :: template
3817logical,
INTENT(in),
OPTIONAL :: write
3818logical,
INTENT(in),
OPTIONAL :: wipe
3819character(len=*),
INTENT(in),
OPTIONAL :: repinfo
3820character(len=*),
intent(in),
optional :: format
3821logical,
intent(in),
optional :: simplified
3822logical,
intent(in),
optional :: memdb
3823logical,
intent(in),
optional :: loadfile
3824character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
3827character (len=5) :: lanaflag,ldataflag,lattrflag
3828character (len=1) :: lmode
3829logical :: lwrite,lwipe
3830character(len=255) :: lrepinfo
3831character(len=40) :: lformat
3832logical :: exist,lsimplified,read_next,lfile,lmemdb,lloadfile
3833character(len=512) :: a_name
3834character(len=40) :: ltemplate
3842if (
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))
3847dbasession_init%category=l4f_category_get(a_name)
3851if (
present(write))
then
3857if (
present(wipe))
then
3859 if (
present(repinfo))
then
3868if (
present(template))
then
3875if (
present(simplified))
then
3876 lsimplified=simplified
3880if (
present(format))
then
3886if (
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.
3923if (
present(memdb))
then
3927if (
present(loadfile))
then
3932call optio(anaflag,lanaflag)
3933if (.not. c_e(lanaflag))
then
3941call optio(dataflag,ldataflag)
3942if (.not. c_e(ldataflag))
then
3950call optio(attrflag,lattrflag)
3951if (.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")
3989if (
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)
4038dbasession_init%file=lfile
4039if (dbasession_init%file) dbasession_init%filename=filename
4040dbasession_init%mode=lmode
4041dbasession_init%format=lformat
4042dbasession_init%simplified=lsimplified
4043dbasession_init%memdb=lmemdb
4044dbasession_init%loadfile=lloadfile
4045dbasession_init%template=ltemplate
4058end function dbasession_init
4062subroutine dbasession_unsetall(session)
4066if (c_e(session%sehandle))
then
4067 ier = idba_unsetall(session%sehandle)
4070end subroutine dbasession_unsetall
4074subroutine dbasession_remove_all(session)
4078if (c_e(session%sehandle))
then
4079 ier = idba_remove_all(session%sehandle)
4082end subroutine dbasession_remove_all
4086subroutine dbasession_prendilo(session)
4090if (c_e(session%sehandle))
then
4091 ier = idba_prendilo(session%sehandle)
4094end subroutine dbasession_prendilo
4097subroutine dbasession_var_related(session,btable)
4099character(len=*),
INTENT(IN) :: btable
4102if (c_e(session%sehandle))
then
4103 ier = idba_set(session%sehandle,
"*var_related",btable)
4106end subroutine dbasession_var_related
4109subroutine dbasession_setcontextana(session)
4113if (c_e(session%sehandle))
then
4114 ier = idba_setcontextana(session%sehandle)
4117end subroutine dbasession_setcontextana
4120subroutine dbasession_dimenticami(session)
4124if (c_e(session%sehandle))
then
4125 ier = idba_dimenticami(session%sehandle)
4128end subroutine dbasession_dimenticami
4131subroutine dbasession_critica(session)
4135if (c_e(session%sehandle))
then
4136 ier = idba_critica(session%sehandle)
4139end subroutine dbasession_critica
4142subroutine dbasession_scusa(session)
4146if (c_e(session%sehandle))
then
4147 ier = idba_scusa(session%sehandle)
4150end subroutine dbasession_scusa
4153subroutine dbasession_set(session,metadata,datav,data,datetime,ana,network,level,timerange,filter)
4156class(
dbadcv),
optional :: datav
4157class(
dbadata),
optional :: data
4159type (
dbaana),
optional :: ana
4165if (
present(metadata))
then
4166 call metadata%dbaset(session)
4169if (
present(datetime))
then
4170 call datetime%dbaset(session)
4173if (
present(ana))
then
4174 call ana%dbaset(session)
4177if (
present(network))
then
4178 call network%dbaset(session)
4181if (
present(level))
then
4182 call level%dbaset(session)
4185if (
present(timerange))
then
4186 call timerange%dbaset(session)
4189if (
present(datav))
then
4190 call datav%dbaset(session)
4193if (
present(data))
then
4194 call data%dbaset(session)
4197if (
present(filter))
then
4198 call filter%dbaset(session)
4201end subroutine dbasession_set
4359# ifndef F2003_FULL_FEATURES
4361subroutine dbasession_delete(session)
4366if (c_e(session%sehandle))
then
4367 ier = idba_fatto(session%sehandle)
4370call session%memconnection%delete()
4372select type (session)
4374 session = defsession
4388end subroutine dbasession_delete
4393subroutine dbasession_delete(session)
4394type (dbasession),
intent(inout) :: session
4397if (c_e(session%sehandle))
then
4398 ier = idba_fatto(session%sehandle)
4412end subroutine dbasession_delete
4419subroutine dbasession_filerewind(session)
4423if (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)
4435end subroutine dbasession_filerewind
4438FUNCTION dballe_error_handler(category)
4439INTEGER :: category, code, l4f_level
4440INTEGER :: dballe_error_handler
4442CHARACTER(len=1000) :: message, buf
4444code = idba_error_code()
4447if (code == 13 )
then
4453call idba_error_message(message)
4454call l4f_category_log(category,l4f_level,trim(message))
4456call idba_error_context(buf)
4458call l4f_category_log(category,l4f_level,trim(buf))
4460call idba_error_details(buf)
4461call l4f_category_log(category,l4f_info,trim(buf))
4465if (l4f_level == l4f_error )
CALL raise_fatal_error(
"dballe: "//message)
4467dballe_error_handler = 0
4470END FUNCTION dballe_error_handler
Distruttori per le 2 classi.
print a summary of object contents
set parameters in dballe API
Classi per la gestione delle coordinate temporali.
class for import and export data from e to DB-All.e.
Classes for handling georeferenced sparse points in geographical corodinates.
abstract class to use lists in fortran 2003.
classe per la gestione del logging
Definitions of constants and functions for working with missing values.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione dell'anagrafica di stazioni meteo e affini.
Classe per la gestione di un volume completo di dati osservati.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Classe per la gestione delle reti di stazioni per osservazioni meteo e affini.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini.
Class for expressing an absolute time value.
double linked list of ana
manage connection handle to a DSN
fortran 2003 interface to geo_coord
base (abstract) type for data
extend one data container with a vector of data container (one data plus attributes)
vector of dbadataattr (more data plus attributes)
character version for dbadata
doubleprecision version for dbadata
integer version for dbadata
container for dbadata (used for promiscuous vector of data)
vector of container of dbadata
filter to apply before ingest data
Derived type defining an isolated georeferenced point on Earth in polar geographical coordinates.
Abstract implementation of doubly-linked list.
Definisce l'anagrafica di una stazione.
Definisce il livello verticale di un'osservazione.
Definisce la rete a cui appartiene una stazione.
Definisce l'intervallo temporale di un'osservazione meteo.