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
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
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
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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
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)
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
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
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
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)
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)
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)
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
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
1827 type(
dbaana),
intent(in),
optional :: ana
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)
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)
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)
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)
2522 call metaanddatav%metadata%display()
2523 call metaanddatav%datav%display()
2525 end subroutine dbametaanddatav_display
2528 subroutine dbametaanddatav_extrude(metaanddatav,session,noattr,filter,template)
2531 logical,
intent(in),
optional :: noattr
2532 type(
dbafilter),
intent(in),
optional :: filter
2533 character(len=*),
intent(in),
optional :: template
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)
2548 logical,
intent(in),
optional :: noattr
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)
2572 logical,
intent(in),
optional :: noattr
2573 type(
dbafilter),
intent(in),
optional :: filter
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)
2595 do while(this%element())
2596 print *,
"index:",this%currentindex(),
" value:"
2597 element=this%current()
2598 call element%display()
2601 end subroutine displaydbametaanddatai
2606 class(*),
pointer :: v
2608 v => this%currentpoli()
2611 currentdbametaanddatai = v
2613 end function currentdbametaanddatai
2617 subroutine dbasession_ingest_metaanddatail(session,metaanddatal,filter)
2620 type(
dbafilter),
intent(in),
optional :: filter
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)
2674 do while(this%element())
2675 print *,
"index:",this%currentindex(),
" value:"
2676 element=this%current()
2677 call element%display()
2680 end subroutine displaydbametaanddatar
2685 class(*),
pointer :: v
2687 v => this%currentpoli()
2690 currentdbametaanddatar = v
2692 end function currentdbametaanddatar
2696 subroutine dbasession_ingest_metaanddatarl(session,metaanddatal,filter)
2699 type(
dbafilter),
intent(in),
optional :: filter
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)
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)
2755 do while(this%element())
2756 print *,
"index:",this%currentindex(),
" value:"
2757 element=this%current()
2758 call element%display()
2761 end subroutine displaydbametaanddatad
2766 class(*),
pointer :: v
2768 v => this%currentpoli()
2771 currentdbametaanddatad = v
2773 end function currentdbametaanddatad
2776 subroutine dbasession_ingest_metaanddatadl(session,metaanddatal,filter)
2779 type(
dbafilter),
intent(in),
optional :: filter
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)
2833 do while(this%element())
2834 print *,
"index:",this%currentindex(),
" value:"
2835 element=this%current()
2836 call element%display()
2839 end subroutine displaydbametaanddatab
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)
2912 do while(this%element())
2913 print *,
"index:",this%currentindex(),
" value:"
2914 element=this%current()
2915 call element%display()
2918 end subroutine displaydbametaanddatac
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)
2989 call data%metadata%display()
2990 call data%dbadatai%display()
2992 end subroutine dbametaanddatai_display
2995 subroutine dbametaanddatab_display(data)
2998 call data%metadata%display()
2999 call data%dbadatab%display()
3001 end subroutine dbametaanddatab_display
3004 subroutine dbametaanddatad_display(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)
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)
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)
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)
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)
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)
3187 logical,
intent(in),
optional :: noattr
3188 type(
dbafilter),
intent(in),
optional :: filter
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)
3450 type(
dbametaanddata),
intent(inout),
allocatable :: metaanddatav(:)
3451 logical,
intent(in),
optional :: noattr
3452 type(
dbafilter),
intent(in),
optional :: filter
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)
3499 logical,
intent(in),
optional :: noattr
3500 type(
dbafilter),
intent(in),
optional :: filter
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)
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)
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)
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)
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)
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)
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)
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)
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)
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)
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
3792 type (dbaconnection),
intent(inout) :: handle
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)
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)
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)
4394 type (dbasession),
intent(inout) :: 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
print a summary of object contents
Function to check whether a value is missing or not.
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
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.