libsim Versione 7.2.4

◆ dbasession_delete()

subroutine dbasession_delete ( class (dbasession), intent(inout) session)
private

clear a dballe session

Definizione alla linea 4549 del file dballe_class.F03.

4550! Copyright (C) 2013 ARPA-SIM <urpsim@smr.arpa.emr.it>
4551! authors:
4552! Paolo Patruno <ppatruno@arpa.emr.it>
4553! Davide Cesari <dcesari@arpa.emr.it>
4554
4555! This program is free software; you can redistribute it and/or
4556! modify it under the terms of the GNU General Public License as
4557! published by the Free Software Foundation; either version 2 of
4558! the License, or (at your option) any later version.
4559
4560! This program is distributed in the hope that it will be useful,
4561! but WITHOUT ANY WARRANTY; without even the implied warranty of
4562! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4563! GNU General Public License for more details.
4564
4565! You should have received a copy of the GNU General Public License
4566! along with this program. If not, see <http://www.gnu.org/licenses/>.
4567
4568#include "config.h"
4569
4592MODULE dballe_class
4593
4595use log4fortran
4596use err_handling
4604use list_abstract
4605use vol7d_class, only: vol7d_cdatalen
4606use dballef
4607IMPLICIT NONE
4608
4609private
4610
4611character (len=255),parameter:: subcategory="dballe_class"
4612
4614type,public :: dbaconnection
4615 integer :: dbhandle=imiss
4616 integer :: handle_err=imiss
4617 integer :: category=0
4618 contains
4619# ifdef F2003_FULL_FEATURES
4620 final :: dbaconnection_delete
4621# else
4622 procedure :: delete => dbaconnection_delete
4623# endif
4624end type dbaconnection
4625
4627interface dbaconnection
4628 procedure dbaconnection_init
4629end interface
4630
4632type,public :: dbasession
4633 integer :: sehandle=imiss
4634 logical :: file=.false.
4635 character(len=40) :: template='generic'
4636 character(len=255) :: filename=cmiss
4637 character(len=40) :: mode=cmiss
4638 character(len=40) :: format=cmiss
4639 logical :: simplified=.true.
4640 logical :: memdb=.false.
4641 logical :: loadfile=.false.
4642 type(dbaconnection) :: memconnection
4643 integer :: category=0
4644 integer :: count=imiss
4645 contains
4646# ifdef F2003_FULL_FEATURES
4647 final :: dbasession_delete
4648# else
4649 procedure :: delete => dbasession_delete
4650# endif
4651 procedure :: unsetall => dbasession_unsetall
4652 procedure :: remove_all => dbasession_remove_all
4653 procedure :: set => dbasession_set
4654 procedure :: setcontextana => dbasession_setcontextana
4655 procedure :: dimenticami => dbasession_dimenticami
4668 procedure :: prendilo => dbasession_prendilo
4669 procedure :: var_related => dbasession_var_related
4670 procedure :: critica => dbasession_critica
4671 procedure :: scusa => dbasession_scusa
4672 procedure :: messages_open_input => dbasession_messages_open_input
4673 procedure :: messages_open_output => dbasession_messages_open_output
4674 procedure :: messages_read_next => dbasession_messages_read_next
4675 procedure :: messages_write_next => dbasession_messages_write_next
4676 procedure :: close_message => dbasession_close_message
4677 procedure :: unsetb => dbasession_unsetb
4678 procedure :: filerewind => dbasession_filerewind
4679 procedure :: ingest_ana => dbasession_ingest_ana
4680 procedure :: ingest_anav => dbasession_ingest_anav
4681 procedure :: ingest_anal => dbasession_ingest_anal
4682 procedure :: ingest_metaanddata => dbasession_ingest_metaanddata
4683 procedure :: ingest_metaanddatal => dbasession_ingest_metaanddatal
4684 procedure :: ingest_metaanddatav => dbasession_ingest_metaanddatav
4685 procedure :: ingest_metaanddatai => dbasession_ingest_metaanddatai
4686 procedure :: ingest_metaanddataiv => dbasession_ingest_metaanddataiv
4687 procedure :: ingest_metaanddatail => dbasession_ingest_metaanddatail
4688 procedure :: ingest_metaanddatab => dbasession_ingest_metaanddatab
4689 procedure :: ingest_metaanddatabv => dbasession_ingest_metaanddatabv
4690 procedure :: ingest_metaanddatabl => dbasession_ingest_metaanddatabl
4691 procedure :: ingest_metaanddatad => dbasession_ingest_metaanddatad
4692 procedure :: ingest_metaanddatadv => dbasession_ingest_metaanddatadv
4693 procedure :: ingest_metaanddatadl => dbasession_ingest_metaanddatadl
4694 procedure :: ingest_metaanddatar => dbasession_ingest_metaanddatar
4695 procedure :: ingest_metaanddatarv => dbasession_ingest_metaanddatarv
4696 procedure :: ingest_metaanddatarl => dbasession_ingest_metaanddatarl
4697 procedure :: ingest_metaanddatac => dbasession_ingest_metaanddatac
4698 procedure :: ingest_metaanddatacv => dbasession_ingest_metaanddatacv
4699 procedure :: ingest_metaanddatacl => dbasession_ingest_metaanddatacl
4700 procedure :: dissolve_metadata => dbasession_dissolve_metadata
4701 procedure :: dissolveattr => dbasession_dissolveattr_metadata
4702 generic :: dissolve => dissolve_metadata ,dimenticami
4703 generic :: ingesta => ingest_ana, ingest_anav,ingest_anal
4704 generic :: ingest => ingest_metaanddata,ingest_metaanddatav,ingest_metaanddatal,&
4705 !ingest_metaanddatai,ingest_metaanddatab,ingest_metaanddatad,ingest_metaanddatar,ingest_metaanddatac,& !ambiguos
4706 ingest_metaanddataiv,ingest_metaanddatabv,ingest_metaanddatadv,ingest_metaanddatarv,ingest_metaanddatacv,&
4707 ingest_metaanddatail,ingest_metaanddatarl,ingest_metaanddatadl,ingest_metaanddatabl,ingest_metaanddatacl
4711end type dbasession
4712
4714interface dbasession
4715 procedure dbasession_init
4716end interface
4717
4719type,public,extends(vol7d_level) :: dbalevel
4720 contains
4721
4722# ifdef F2003_FULL_FEATURES
4723! final :: dbalevel_delete
4724# else
4725! procedure :: delete => dbalevel_delete !< todo
4726# endif
4727 procedure :: display => dbalevel_display
4728 procedure :: dbaset => dbalevel_set
4729 procedure :: dbaenq => dbalevel_enq
4730 procedure,nopass :: dbacontextana => dbalevel_contextana
4732end type dbalevel
4733
4735interface dbalevel
4736 procedure dbalevel_init
4737end interface
4738
4740type,public,extends(vol7d_timerange) :: dbatimerange
4741 contains
4742# ifdef F2003_FULL_FEATURES
4743! final :: dbatimerange_delete
4744# else
4745! procedure :: delete => dbatimerange_delete
4746# endif
4747 procedure :: display => dbatimerange_display
4748 procedure :: dbaset => dbatimerange_set
4749 procedure :: dbaenq => dbatimerange_enq
4750 procedure,nopass :: dbacontextana => dbatimerange_contextana
4752end type dbatimerange
4753
4755interface dbatimerange
4756 procedure dbatimerange_init
4757end interface
4758
4760type,public,extends(geo_coord) :: dbacoord
4761
4762!!$ REAL(kind=fp_geo) :: lon !< longitudine
4763!!$ REAL(kind=fp_geo) :: lat !< latitudine
4764!!$ INTEGER(kind=int_l) :: ilon !< integer longitude (nint(lon*1.d5)
4765!!$ INTEGER(kind=int_l) :: ilat !< integer latitude (nint(lat*1.d5)
4766
4767 contains
4768# ifdef F2003_FULL_FEATURES
4769! final :: dbacoord_delete
4770# else
4771! procedure :: delete => dbacoord_delete
4772# endif
4773 procedure :: display => dbacoord_display
4774
4775end type dbacoord
4776
4778interface dbacoord
4779 procedure dbacoord_init
4780end interface
4781
4783type,public,extends(vol7d_ana) :: dbaana
4784
4785 contains
4786# ifdef F2003_FULL_FEATURES
4787! final :: dbaana_delete
4788# else
4789! procedure :: delete => dbaana_delete
4790# endif
4791 procedure :: display => dbaana_display
4792 procedure :: dbaset => dbaana_set
4793 procedure :: dbaenq => dbaana_enq
4794 procedure :: extrude => dbaana_extrude
4795end type dbaana
4796
4798interface dbaana
4799 procedure dbaana_init
4800end interface
4801
4803type, public, extends(list) :: dbaanalist
4804 contains
4805 procedure :: current => currentdbaana
4806 procedure :: display => displaydbaana
4807end type dbaanalist
4808
4810type,public,extends(vol7d_network) :: dbanetwork
4811
4812 !Every type of report has an associated priority that controls which
4813 !data are first returned when there is more than one in the same
4814 !physical space. It can be changed by editing
4815 !/etc/dballe/repinfo.csv
4816 integer :: priority
4817
4818 contains
4819# ifdef F2003_FULL_FEATURES
4820! final :: dbanetwork_delete
4821# else
4822! procedure :: delete => dbanetwork_delete
4823# endif
4824 procedure :: display => dbanetwork_display
4825 procedure :: dbaset => dbanetwork_set
4826 procedure :: dbaenq => dbanetwork_enq
4827
4828end type dbanetwork
4829
4831interface dbanetwork
4832 procedure dbanetwork_init
4833end interface
4834
4835
4837type,public,extends(datetime) :: dbadatetime
4838
4839 contains
4840# ifdef F2003_FULL_FEATURES
4841! final :: dbanetwork_delete
4842# else
4843! procedure :: delete => dbanetwork_delete
4844# endif
4845 procedure :: display => dbadatetime_display
4846 procedure :: dbaset => dbadatetime_set
4847 procedure :: dbaenq => dbadatetime_enq
4848 procedure,nopass :: dbacontextana => dbadatetime_contextana
4849end type dbadatetime
4850
4852interface dbadatetime
4853 procedure dbadatetime_init
4854end interface
4855
4856
4858type,public,abstract :: dbadata
4859 character(len=9) :: btable
4860contains
4861 procedure(dbadata_set),deferred :: dbaset
4862 procedure :: dbadata_geti
4863 procedure :: dbadata_getr
4864 procedure :: dbadata_getd
4865 procedure :: dbadata_getb
4866 procedure :: dbadata_getc
4867 generic :: get => dbadata_geti,dbadata_getr,dbadata_getd,dbadata_getb,dbadata_getc
4868 procedure :: dbadata_c_e_i
4869 procedure :: dbadata_c_e_r
4870 procedure :: dbadata_c_e_d
4871 procedure :: dbadata_c_e_b
4872 procedure :: dbadata_c_e_c
4873 procedure :: c_e => dbadata_c_e
4874 procedure(dbadata_display),deferred :: display
4875 procedure :: equal => dbadata_equal
4876 generic :: operator (==) => equal
4877end type dbadata
4878
4880abstract interface
4881subroutine dbadata_set(data,session)
4882import
4883class(dbadata), intent(in) :: data
4884type(dbasession), intent(in) :: session
4885end subroutine dbadata_set
4886
4888subroutine dbadata_display(data)
4889import
4890class(dbadata), intent(in) :: data
4891end subroutine dbadata_display
4892
4893end interface
4894
4896type,public, extends(dbadata) :: dbadatai
4897 integer :: value
4898contains
4899 procedure :: dbadata_geti => dbadatai_geti
4900 procedure :: dbaset => dbadatai_set
4901 procedure :: display => dbadatai_display
4902end type dbadatai
4903
4905interface dbadatai
4906 procedure :: dbadatai_init
4907end interface dbadatai
4908
4910type,public, extends(dbadata) :: dbadatar
4911 real :: value
4912contains
4913 procedure :: dbadata_getr => dbadatar_getr
4914 procedure :: dbaset => dbadatar_set
4915 procedure :: display => dbadatar_display
4916end type dbadatar
4917
4919interface dbadatar
4920 procedure :: dbadatar_init
4921end interface dbadatar
4922
4923
4925type,public, extends(dbadata) :: dbadatad
4926 doubleprecision :: value
4927contains
4928 procedure :: dbadata_getd => dbadatad_getd
4929 procedure :: dbaset => dbadatad_set
4930 procedure :: display => dbadatad_display
4931end type dbadatad
4932
4934interface dbadatad
4935 procedure :: dbadatad_init
4936end interface dbadatad
4937
4938
4940type,public, extends(dbadata) :: dbadatab
4941 integer(kind=int_b) :: value
4942contains
4943 procedure :: dbadata_getb => dbadatab_getb
4944 procedure :: dbaset => dbadatab_set
4945 procedure :: display => dbadatab_display
4946end type dbadatab
4947
4949interface dbadatab
4950 procedure :: dbadatab_init
4951end interface dbadatab
4952
4953
4955type,public, extends(dbadata) :: dbadatac
4956! character(:) :: value
4957! character(255) :: value
4958character(vol7d_cdatalen) :: value
4959
4960contains
4961 procedure :: dbadata_getc => dbadatac_getc
4962 procedure :: dbaset => dbadatac_set
4963 procedure :: display => dbadatac_display
4964end type dbadatac
4965
4967interface dbadatac
4968 procedure :: dbadatac_init
4969end interface dbadatac
4970
4972type,public :: dbametadata
4973 type(dbalevel) :: level
4974 type(dbatimerange) :: timerange
4975 type(dbaana) :: ana
4976 type(dbanetwork) :: network
4977 type(dbadatetime) :: datetime
4978 contains
4979# ifdef F2003_FULL_FEATURES
4980! final :: dbametadata_delete
4981# else
4982! procedure :: delete => dbametadata_delete
4983# endif
4984 procedure :: dbaset => dbametadata_set
4985 procedure :: dbaenq => dbametadata_enq
4986 procedure :: dbacontextana => dbametadata_contextana
4987 procedure :: display => dbametadata_display
4988 procedure :: equal => dbametadata_equal
4989 generic :: operator (==) => equal
4990end type dbametadata
4991
4993interface dbametadata
4994 procedure dbametadata_init
4995end interface
4996
4998type, public :: dbadc
4999 class(dbadata),allocatable :: dat
5000 contains
5001 procedure :: display => dbadc_display
5002 procedure :: dbaset => dbadc_set
5003 procedure :: extrude => dbadc_extrude
5004end type dbadc
5005
5006
5008type, public :: dbadcv
5009 type(dbadc),allocatable :: dcv(:)
5010 contains
5011 procedure :: display => dbadcv_display
5012 procedure :: dbaset => dbadcv_set
5013 procedure :: extrude => dbadcv_extrude
5014 procedure :: equal => dbadcv_equal_dbadata
5015 generic :: operator (==) => equal
5016end type dbadcv
5017
5019type, public ,extends(dbadc):: dbadataattr
5020 type(dbadcv) :: attrv
5021 contains
5022 procedure :: display => dbadataattr_display
5023 procedure :: extrude => dbadataattr_extrude
5024end type dbadataattr
5025
5027type, public :: dbadataattrv
5028 class(dbadataattr),allocatable :: dataattr(:)
5029 contains
5030 procedure :: display => dbadataattrv_display
5031 procedure :: extrude => dbadataattrv_extrude
5032end type dbadataattrv
5033
5035type, public :: dbametaanddata
5036 type(dbametadata) :: metadata
5037 type(dbadataattrv) ::dataattrv
5038 contains
5039 procedure :: display => dbametaanddata_display
5040 procedure :: extrude => dbametaanddata_extrude
5041end type dbametaanddata
5042
5044type, public :: dbametaanddatav
5045 type(dbametadata) :: metadata
5046 type(dbadcv) ::datav
5047 contains
5048 procedure :: display => dbametaanddatav_display
5049 procedure :: extrude => dbametaanddatav_extrude
5050end type dbametaanddatav
5051
5053type, public, extends(list) :: dbametaanddatalist
5054 contains
5055 procedure :: current => currentdbametaanddata
5056 procedure :: display => displaydbametaanddata
5057 procedure :: extrude => dbametaanddatal_extrude
5058end type dbametaanddatalist
5059
5061type, public,extends(dbadatai) :: dbametaanddatai
5062 type(dbametadata) :: metadata
5063 contains
5064 procedure :: display => dbametaanddatai_display
5065 procedure :: extrude => dbametaanddatai_extrude
5066end type dbametaanddatai
5067
5069type, public, extends(list) :: dbametaanddatailist
5070 contains
5071 procedure :: current => currentdbametaanddatai
5072 procedure :: display => displaydbametaanddatai
5073 procedure :: toarray => toarray_dbametaanddatai
5074end type dbametaanddatailist
5075
5077type, public,extends(dbadatab) :: dbametaanddatab
5078 type(dbametadata) :: metadata
5079 contains
5080 procedure :: display => dbametaanddatab_display
5081 procedure :: extrude => dbametaanddatab_extrude
5082end type dbametaanddatab
5083
5085type, public, extends(list) :: dbametaanddatablist
5086 contains
5087 procedure :: current => currentdbametaanddatab
5088 procedure :: display => displaydbametaanddatab
5089 procedure :: toarray => toarray_dbametaanddatab
5090end type dbametaanddatablist
5091
5093type, public,extends(dbadatad) :: dbametaanddatad
5094 type(dbametadata) :: metadata
5095 contains
5096 procedure :: display => dbametaanddatad_display
5097 procedure :: extrude => dbametaanddatad_extrude
5098end type dbametaanddatad
5099
5101type, public, extends(list) :: dbametaanddatadlist
5102 contains
5103 procedure :: current => currentdbametaanddatad
5104 procedure :: display => displaydbametaanddatad
5105 procedure :: toarray => toarray_dbametaanddatad
5106end type dbametaanddatadlist
5107
5109type, public,extends(dbadatar) :: dbametaanddatar
5110 type(dbametadata) :: metadata
5111 contains
5112 procedure :: display => dbametaanddatar_display
5113 procedure :: extrude => dbametaanddatar_extrude
5114end type dbametaanddatar
5115
5117type, public, extends(list) :: dbametaanddatarlist
5118 contains
5119 procedure :: current => currentdbametaanddatar
5120 procedure :: display => displaydbametaanddatar
5121 procedure :: toarray => toarray_dbametaanddatar
5122end type dbametaanddatarlist
5123
5125type, public,extends(dbadatac) :: dbametaanddatac
5126 type(dbametadata) :: metadata
5127 contains
5128 procedure :: display => dbametaanddatac_display
5129 procedure :: extrude => dbametaanddatac_extrude
5130end type dbametaanddatac
5131
5133type, public, extends(list) :: dbametaanddataclist
5134 contains
5135 procedure :: current => currentdbametaanddatac
5136 procedure :: display => displaydbametaanddatac
5137 procedure :: toarray => toarray_dbametaanddatac
5138end type dbametaanddataclist
5139
5141type, public :: dbafilter
5142 type(dbaana) :: ana
5143 character(len=6) :: var
5144 type(dbadatetime) :: datetime
5145 type(dbalevel) :: level
5146 type(dbatimerange) :: timerange
5147 type(dbanetwork) :: network
5148
5149 type(dbacoord) :: coordmin,coordmax
5150 type(dbadatetime) :: datetimemin,datetimemax
5151 integer :: limit
5152 character(len=255) :: ana_filter, data_filter, attr_filter, varlist, starvarlist, anavarlist, anastarvarlist
5153 character(len=40) :: query
5154 integer :: priority,priomin,priomax
5155 logical :: contextana
5156 logical :: anaonly
5157 logical :: dataonly
5158 type(dbadcv) :: vars,starvars
5159 type(dbadcv) :: anavars,anastarvars
5160 contains
5161 procedure :: display => dbafilter_display
5162 procedure :: dbaset => dbafilter_set
5163 procedure :: equalmetadata => dbafilter_equal_dbametadata
5166 generic :: operator (==) => equalmetadata
5167end type dbafilter
5168
5170interface dbafilter
5171 procedure dbafilter_init
5172end interface
5173
5174contains
5175
5177subroutine displaydbametaanddata(this)
5178class(dbametaanddataList),intent(inout) :: this
5179type(dbametaanddata) :: element
5180
5181call this%rewind()
5182do while(this%element())
5183 print *,"index:",this%currentindex()," value:"
5184 element=this%current()
5185 call element%display()
5186 call this%next()
5187end do
5188end subroutine displaydbametaanddata
5189
5191type(dbametaanddata) function currentdbametaanddata(this)
5192class(dbametaanddataList),intent(inout) :: this
5193class(*), pointer :: v
5194
5195v => this%currentpoli()
5196select type(v)
5197type is (dbametaanddata)
5198 currentdbametaanddata = v
5199end select
5200end function currentdbametaanddata
5201
5202
5204elemental logical function dbadata_equal(this,that)
5205
5206class(dbadata), intent(in) :: this
5207class(dbadata), intent(in) :: that
5208
5209if ( this%btable == that%btable ) then
5210 dbadata_equal = .true.
5211else
5212 dbadata_equal = .false.
5213end if
5214
5215end function dbadata_equal
5216
5217
5219subroutine dbadata_geti(data,value)
5220class(dbadata), intent(in) :: data
5221integer, intent(out) :: value
5222value=imiss
5223
5224select type(data)
5225type is (dbadatai)
5226 value = data%value
5227end select
5228
5229end subroutine dbadata_geti
5230
5231
5233logical function dbadata_c_e_i(data)
5234class(dbadata), intent(in) :: data
5235
5236dbadata_c_e_i=.false.
5237
5238select type(data)
5239type is (dbadatai)
5240 dbadata_c_e_i = c_e(data%value)
5241end select
5242
5243end function dbadata_c_e_i
5244
5246subroutine dbadata_getr(data,value)
5247class(dbadata), intent(in) :: data
5248real, intent(out) :: value
5249value=rmiss
5250
5251select type(data)
5252type is (dbadatar)
5253 value = data%value
5254end select
5255
5256end subroutine dbadata_getr
5257
5259logical function dbadata_c_e_r(data)
5260class(dbadata), intent(in) :: data
5261
5262dbadata_c_e_r=.false.
5263
5264select type(data)
5265type is (dbadatar)
5266 dbadata_c_e_r = c_e(data%value)
5267end select
5268
5269end function dbadata_c_e_r
5270
5272subroutine dbadata_getd(data,value)
5273class(dbadata), intent(in) :: data
5274doubleprecision, intent(out) :: value
5275value=dmiss
5276
5277select type(data)
5278type is (dbadatad)
5279 value = data%value
5280end select
5281
5282end subroutine dbadata_getd
5283
5285logical function dbadata_c_e_d(data)
5286class(dbadata), intent(in) :: data
5287
5288dbadata_c_e_d=.false.
5289
5290select type(data)
5291type is (dbadatad)
5292 dbadata_c_e_d = c_e(data%value)
5293end select
5294
5295end function dbadata_c_e_d
5296
5297
5299subroutine dbadata_getb(data,value)
5300class(dbadata), intent(in) :: data
5301INTEGER(kind=int_b), intent(out) :: value
5302value=bmiss
5303
5304select type(data)
5305type is (dbadatab)
5306 value = data%value
5307end select
5308
5309end subroutine dbadata_getb
5310
5312logical function dbadata_c_e_b(data)
5313class(dbadata), intent(in) :: data
5314
5315dbadata_c_e_b=.false.
5316
5317select type(data)
5318type is (dbadatab)
5319 dbadata_c_e_b = c_e(data%value)
5320end select
5321
5322end function dbadata_c_e_b
5323
5325subroutine dbadata_getc(data,value)
5326class(dbadata), intent(in) :: data
5327character(len=*), intent(out) :: value
5328value=cmiss
5329
5330select type(data)
5331type is (dbadatac)
5332 value = data%value
5333end select
5334
5335end subroutine dbadata_getc
5336
5337
5339logical function dbadata_c_e_c(data)
5340class(dbadata), intent(in) :: data
5341
5342dbadata_c_e_c=.false.
5343
5344select type(data)
5345type is (dbadatac)
5346 dbadata_c_e_c = c_e(data%value)
5347end select
5348
5349end function dbadata_c_e_c
5350
5351
5353logical function dbadata_c_e(data)
5354class(dbadata), intent(in) :: data
5355
5356dbadata_c_e=data%dbadata_c_e_i() .or. data%dbadata_c_e_r() .or. data%dbadata_c_e_d() &
5357 .or. data%dbadata_c_e_b() .or. data%dbadata_c_e_c()
5358
5359end function dbadata_c_e
5360
5361
5363subroutine dbalevel_display(level)
5364class(dbalevel), intent(in) :: level
5365call display (level%vol7d_level)
5366end subroutine dbalevel_display
5367
5370type(dbalevel) function dbalevel_init(level1, l1, level2, l2)
5371
5372INTEGER,INTENT(IN),OPTIONAL :: level1
5373INTEGER,INTENT(IN),OPTIONAL :: l1
5374INTEGER,INTENT(IN),OPTIONAL :: level2
5375INTEGER,INTENT(IN),OPTIONAL :: l2
5376
5377call init (dbalevel_init%vol7d_level,level1, l1, level2, l2)
5378end function dbalevel_init
5379
5381subroutine dbalevel_set(level,session)
5382class(dbalevel), intent(in) :: level
5383type(dbasession), intent(in) :: session
5384integer :: ier
5385
5386!if (c_e(session%sehandle)) then
5387ier = idba_setlevel(session%sehandle,&
5388 level%level1, level%l1, level%level2, level%l2)
5389
5390!todo this is a work around
5391if (.not. c_e(level%vol7d_level)) then
5392 call session%setcontextana
5393end if
5394
5395end subroutine dbalevel_set
5396
5398subroutine dbalevel_enq(level,session)
5399class(dbalevel), intent(out) :: level
5400type(dbasession), intent(in) :: session
5401integer :: ier
5402
5403ier = idba_enqlevel(session%sehandle,&
5404 level%level1, level%l1, level%level2, level%l2)
5405
5406end subroutine dbalevel_enq
5407
5409type(dbalevel) function dbalevel_contextana()
5410
5411dbalevel_contextana=dbalevel()
5412
5413end function dbalevel_contextana
5414
5415
5417subroutine dbaana_display(ana)
5418class(dbaana), intent(in) :: ana
5419call display (ana%vol7d_ana)
5420end subroutine dbaana_display
5421
5422
5425type(dbacoord) function dbacoord_init(lon, lat, ilon, ilat)
5426REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
5427REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
5428INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
5429INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
5430
5431CALL init(dbacoord_init%geo_coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
5432
5433end function dbacoord_init
5434
5436subroutine dbacoord_display(coord)
5437class(dbacoord), intent(in) :: coord
5438call display (coord%geo_coord)
5439end subroutine dbacoord_display
5440
5443type(dbaana) function dbaana_init(coord,ident,lon, lat, ilon, ilat)
5444CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
5445TYPE(dbacoord),INTENT(IN),optional :: coord
5446REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
5447REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
5448INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
5449INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
5450
5451if (present(coord))then
5452 CALL init(dbaana_init%vol7d_ana, ilon=getilon(coord%geo_coord), ilat=getilat(coord%geo_coord), ident=ident)
5453else
5454 CALL init(dbaana_init%vol7d_ana, lon=lon, lat=lat, ilon=ilon, ilat=ilat, ident=ident)
5455end if
5456
5457end function dbaana_init
5458
5460subroutine dbaana_set(ana,session)
5461class(dbaana), intent(in) :: ana
5462type(dbasession), intent(in) :: session
5463integer :: ier
5464
5465!if (c_e(session%sehandle)) then
5466ier = idba_set(session%sehandle,"lat",getilat(ana%vol7d_ana%coord))
5467ier = idba_set(session%sehandle,"lon",getilon(ana%vol7d_ana%coord))
5468if (c_e(ana%vol7d_ana%ident)) then
5469 ier = idba_set(session%sehandle,"ident",ana%vol7d_ana%ident)
5470 ier = idba_set(session%sehandle,"mobile",1)
5471else
5472 ier = idba_set(session%sehandle,"ident",cmiss)
5473 ier = idba_set(session%sehandle,"mobile",imiss)
5474end if
5475
5476end subroutine dbaana_set
5477
5479subroutine dbaana_enq(ana,session)
5480class(dbaana), intent(out) :: ana
5481type(dbasession), intent(in) :: session
5482integer :: ier,ilat,ilon
5483
5484!if (c_e(session%sehandle)) then
5485ier = idba_enq(session%sehandle,"lat",ilat)
5486ier = idba_enq(session%sehandle,"lon",ilon)
5487
5488call init(ana%vol7d_ana%coord,ilon=ilon,ilat=ilat)
5489ier = idba_enq(session%sehandle,"ident",ana%vol7d_ana%ident)
5490
5491end subroutine dbaana_enq
5492
5493
5495subroutine dbaana_extrude(ana,session)
5496class(dbaana), intent(in) :: ana
5497type(dbasession), intent(in) :: session
5498
5499call session%unsetall()
5500!write ana
5501call session%set(ana=ana)
5502call session%prendilo()
5503
5504!to close message on file
5505call session%close_message()
5506
5507end subroutine dbaana_extrude
5508
5509
5511subroutine displaydbaana(this)
5512class(dbaanaList),intent(inout) :: this
5513type(dbaana) :: element
5514
5515call this%rewind()
5516do while(this%element())
5517 print *,"index:",this%currentindex()," value:"
5518 element=this%current()
5519 call element%display()
5520 call this%next()
5521end do
5522end subroutine displaydbaana
5523
5525type(dbaana) function currentdbaana(this)
5526class(dbaanaList) :: this
5527class(*), pointer :: v
5528
5529v => this%currentpoli()
5530select type(v)
5531type is (dbaana)
5532 currentdbaana = v
5533end select
5534end function currentdbaana
5535
5536
5538subroutine dbadc_set(dc,session)
5539class(dbadc), intent(in) :: dc
5540type(dbasession), intent(in) :: session
5541
5542call dc%dat%dbaset(session)
5543
5544end subroutine dbadc_set
5545
5547subroutine dbadc_display(dc)
5548class(dbadc), intent(in) :: dc
5549
5550call dc%dat%display()
5551
5552end subroutine dbadc_display
5553
5555subroutine dbadcv_set(dcv,session)
5556class(dbadcv), intent(in) :: dcv
5557type(dbasession), intent(in) :: session
5558integer :: i
5559
5560do i=1, size(dcv%dcv)
5561 call dcv%dcv(i)%dbaset(session)
5562enddo
5563
5564end subroutine dbadcv_set
5565
5566
5567
5569subroutine dbadcv_extrude(dcv,session,noattr,filter,template)
5570class(dbadcv), intent(in) :: dcv
5571type(dbasession), intent(in) :: session
5572logical, intent(in),optional :: noattr
5573type(dbafilter),intent(in),optional :: filter
5574character(len=*),intent(in),optional :: template
5575integer :: i
5576
5577do i=1, size(dcv%dcv)
5578 call dcv%dcv(i)%extrude(session,noattr,filter,template=template)
5579enddo
5580
5581end subroutine dbadcv_extrude
5582
5584subroutine dbadc_extrude(data,session,noattr,filter,attronly,template)
5585class(dbadc), intent(in) :: data
5586type(dbasession), intent(in) :: session
5587logical, intent(in),optional :: noattr
5588type(dbafilter),intent(in),optional :: filter
5589logical, intent(in),optional :: attronly
5590character(len=*),intent(in),optional :: template
5591
5592call data%extrude(session,noattr,filter,attronly,template)
5593
5594end subroutine dbadc_extrude
5595
5596
5598subroutine dbadcv_display(dcv)
5599class(dbadcv), intent(in) :: dcv
5600integer :: i
5601
5602if (allocated(dcv%dcv)) then
5603 do i=1, size(dcv%dcv)
5604 call dcv%dcv(i)%display()
5605 end do
5606end if
5607end subroutine dbadcv_display
5608
5609!!$subroutine dbadat_extrude(dat,session)
5610!!$class(dbadat), intent(in) :: dat
5611!!$type(dbasession), intent(in) :: session
5612!!$
5613!!$!write data in dsn
5614!!$call dat%dbaset(session)
5615!!$call session%prendilo()
5616!!$
5617!!$end subroutine dbadat_extrude
5618!!$
5619!!$subroutine dbadatav_extrude(datav,session)
5620!!$class(dbadatav), intent(in) :: datav
5621!!$type(dbasession), intent(in) :: session
5622!!$integer :: i
5623!!$!write data in dsn
5624!!$do i =1,size(datav%dat)
5625!!$ call datav%dat(i)%dbaset(session)
5626!!$end do
5627!!$call session%prendilo()
5628!!$
5629!!$end subroutine dbadatav_extrude
5630
5631
5633subroutine dbasession_unsetb(session)
5634class(dbasession), intent(in) :: session
5635integer :: ier
5636
5637!if (session%file)then
5638ier=idba_unsetb(session%sehandle)
5639!end if
5640end subroutine dbasession_unsetb
5641
5643subroutine dbasession_close_message(session,template)
5644class(dbasession), intent(in) :: session
5645character(len=*),intent(in),optional :: template
5646integer :: ier
5647character(len=40) :: ltemplate
5648
5649
5650ltemplate=session%template
5651if (present(template)) ltemplate=template
5652
5653!!$print*,"--------------- dbasession ---------------------------------"
5654!!$print *,'file',session%file
5655!!$print *,'filename',trim(session%filename)
5656!!$print *,'mode',session%mode
5657!!$print *,'format',session%format
5658!!$print *,'simplified',session%simplified
5659!!$print *,'memdb',session%memdb
5660!!$print *,'loadfile',session%loadfile
5661!!$print *,'template',ltemplate
5662!!$print*,"------------------------------------------------"
5663
5664if (session%file)then
5665
5666 if (session%memdb) then
5667
5668 return
5669 !call session%messages_write_next(template=ltemplate)
5670
5671 else
5672
5673 if (c_e(ltemplate)) then
5674 ier=idba_set(session%sehandle,"query","message "//trim(ltemplate))
5675 else
5676 ier=idba_set(session%sehandle,"query","message")
5677 end if
5678
5679 call session%unsetb()
5680 call session%prendilo()
5681
5682 end if
5683end if
5684end subroutine dbasession_close_message
5685
5686
5688subroutine dbasession_messages_open_input(session,filename,mode,format,simplified)
5689class(dbasession), intent(in) :: session
5690character (len=*), intent(in) :: filename
5691character (len=*), intent(in),optional :: mode
5692character (len=*), intent(in),optional :: format
5693logical, intent(in),optional :: simplified
5694
5695integer :: ier
5696character (len=40) :: lmode, lformat
5697logical :: lsimplified
5698
5699lmode="r"
5700if (present(mode)) lmode=mode
5701
5702lformat="BUFR"
5703if (present(format)) lformat=format
5704
5705lsimplified=.true.
5706if (present(simplified)) lsimplified=simplified
5707
5708ier = idba_messages_open_input(session%sehandle, filename, lmode, lformat, lsimplified)
5709
5710end subroutine dbasession_messages_open_input
5711
5712
5714subroutine dbasession_messages_open_output(session,filename,mode,format)
5715class(dbasession), intent(in) :: session
5716character (len=*), intent(in) :: filename
5717character (len=*), intent(in),optional :: mode
5718character (len=*), intent(in),optional :: format
5719
5720integer :: ier
5721character (len=40) :: lmode, lformat
5722
5723lmode="w"
5724if (present(mode)) lmode=mode
5725
5726lformat="BUFR"
5727if (present(format)) lformat=format
5728
5729ier = idba_messages_open_output(session%sehandle, filename, lmode, lformat)
5730
5731end subroutine dbasession_messages_open_output
5732
5733
5735logical function dbasession_messages_read_next(session)
5736class(dbasession), intent(in) :: session
5737
5738integer :: ier
5739
5740ier = idba_messages_read_next(session%sehandle, dbasession_messages_read_next)
5741
5742end function dbasession_messages_read_next
5743
5745subroutine dbasession_messages_write_next(session,template)
5746class(dbasession), intent(in) :: session
5747character(len=*), optional :: template
5748character(len=40) :: ltemplate
5749
5750integer :: ier
5751
5752!TODO how to set autodetect?
5753!ltemplate="generic" !! "wmo" = wmo - WMO style templates (autodetect) ?
5754
5755ltemplate=session%template
5756if (present(template)) ltemplate=template
5757
5758ier = idba_messages_write_next(session%sehandle,ltemplate)
5759
5760end subroutine dbasession_messages_write_next
5761
5762
5764subroutine dbasession_dissolve_metadata(session,metadata)
5765class(dbasession), intent(in) :: session
5766type(dbametadata), intent(in) :: metadata(:)
5767
5768integer :: i
5769
5770do i =1, size (metadata)
5771
5772 call metadata(i)%dbaset(session)
5773 call session%dissolve()
5774
5775end do
5776
5777end subroutine dbasession_dissolve_metadata
5778
5779
5780
5782subroutine dbasession_dissolveattr_metadata(session,metadata)
5783class(dbasession), intent(in) :: session
5784type(dbametadata), intent(in),optional :: metadata(:)
5785
5786character(len=9) :: btable
5787integer :: i,ii,count,ier
5788
5789if (present (metadata)) then
5790 do i =1, size (metadata)
5791
5792 ! here if metadata have some field missig they will be set to missing so it will be unset in dballe (I hope)
5793 call metadata(i)%dbaset(session)
5794 ier = idba_voglioquesto(session%sehandle, count)
5795
5796 if (.not. c_e(count)) cycle
5797 do ii =1,count
5798 ier = idba_dammelo(session%sehandle, btable)
5799 !call session%var_related(btable) !not needed after dammelo
5800 call session%scusa()
5801 end do
5802
5803 end do
5804else
5805
5806 ier = idba_voglioquesto(session%sehandle, count)
5807
5808 if (c_e(count)) then
5809 do i =1,count
5810 ier = idba_dammelo(session%sehandle, btable)
5811 !call session%var_related(btable) !not needed after dammelo
5812 call session%scusa()
5813 end do
5814 end if
5815end if
5816end subroutine dbasession_dissolveattr_metadata
5817
5818
5820subroutine dbadataattr_extrude(data,session,noattr,filter,attronly,template)
5821class(dbadataattr), intent(in) :: data
5822type(dbasession), intent(in) :: session
5823logical, intent(in),optional :: noattr
5824type(dbafilter),intent(in),optional :: filter
5825logical, intent(in),optional :: attronly
5826character(len=*),intent(in),optional :: template
5827integer :: i,ierr,count,code
5828logical :: critica
5829character(len=9) :: btable
5830
5831
5832if (session%file .and. optio_log(attronly))then
5833 call l4f_category_log(session%category,l4f_error,"attronly writing on file not supported")
5834 CALL raise_fatal_error()
5835end if
5836
5837if (present(filter))then
5838 if (filter%contextana) then
5839 if (.not. filter%anavars == data%dbadc%dat) return
5840 else
5841 if (.not. filter%vars == data%dbadc%dat) return
5842 end if
5843endif
5844
5845!write data in dsn
5846
5847!print *,"extrude dati:"
5848!call data%dbadc%display()
5849
5850! missing on file do nothing
5851if (.not. data%dbadc%dat%c_e() .and. session%file) return
5852
5853call data%dbadc%dbaset(session)
5854
5855code = idba_error_code() !! 13 for Value is outside the range
5856
5857if (optio_log(attronly).or. .not. data%dbadc%dat%c_e() .or. code ==13 ) then
5858
5859 !! those hare required?
5860 ierr = idba_set(session%sehandle,"var",data%dbadc%dat%btable)
5861 !!
5862
5863 ierr = idba_voglioquesto(session%sehandle, count)
5864
5865 ! with missing data to extrude and missing data in DB we have nothing to delete
5866 ! with attronly and missing data in DB we have nothing to do
5867 ierr=idba_unsetb(session%sehandle)
5868 if (count ==0) return
5869
5870 if (c_e(count)) then
5871 if (optio_log(attronly))then
5872 ierr=idba_dammelo(session%sehandle, btable)
5873 !ierr=idba_enqi(session%sehandle, "context_id", id)
5874 else
5875 !remove data from db if data is missing
5876 ierr=idba_dimenticami(session%sehandle)
5877 endif
5878 endif
5879else
5880 call session%prendilo()
5881 ierr=idba_unsetb(session%sehandle)
5882end if
5883
5884if (optio_log(noattr)) return
5885
5886!write attributes in dsn
5887if (allocated(data%attrv%dcv)) then
5888 if (size(data%attrv%dcv) > 0 )then
5889 critica = .false.
5890 do i = 1, size(data%attrv%dcv)
5891 if (present(filter))then
5892 if (filter%contextana) then
5893 if (.not. filter%anastarvars == data%attrv%dcv(i)%dat) cycle
5894 else
5895 if (.not. filter%starvars == data%attrv%dcv(i)%dat) cycle
5896 end if
5897 endif
5898
5899 if (data%attrv%dcv(i)%dat%c_e()) then
5900 !print *,"extrude attributi:"
5901 !call data%attrv%dcv(i)%dat%display()
5902 call data%attrv%dcv(i)%dat%dbaset(session)
5903 critica=.true.
5904 else if(optio_log(attronly)) then
5905 !ierr=idba_seti(session%sehandle, "*context_id", id)
5906 !call session%var_related(data%dbadc%dat%btable) ! If I have made a prendilo I do not need this
5907 !call data%attrv%dcv(i)%dat%dbaset(session)
5908 ierr = idba_set(session%sehandle,"*var",data%attrv%dcv(i)%dat%btable)
5909 !print *,"scusa attributi:"
5910 !call data%attrv%dcv(i)%dat%display()
5911 call session%scusa()
5912 endif
5913 end do
5914 if (critica) then
5915 !ierr=idba_seti(session%sehandle, "*context_id", id)
5916 !call session%var_related(data%dbadc%dat%btable) ! If I have made a prendilo I do not need this
5917 call session%critica()
5918 end if
5919
5920 end if
5921end if
5922
5923
5924!to close message on file
5925!call session%close_message()
5926
5927end subroutine dbadataattr_extrude
5928
5930subroutine dbadataattr_display(dc)
5931class(dbadataattr), intent(in) :: dc
5932
5933print*,"Data:"
5934call dc%dbadc%display()
5935print*,"Attributes:"
5936call dc%attrv%display()
5937
5938end subroutine dbadataattr_display
5939
5940
5942subroutine dbadataattrv_extrude(dataattr,session,noattr,filter,attronly,template)
5943class(dbadataattrv), intent(in) :: dataattr
5944type(dbasession), intent(in) :: session
5945logical, intent(in),optional :: noattr
5946type(dbafilter),intent(in),optional :: filter
5947logical, intent(in),optional :: attronly
5948character(len=*),intent(in),optional :: template
5949
5950integer :: i
5951
5952if(.not. allocated(dataattr%dataattr)) return
5953do i=1, size(dataattr%dataattr)
5954 call dataattr%dataattr(i)%extrude(session,noattr,filter,attronly,template)
5955enddo
5956
5957!to close message on file
5958!call session%prendilo()
5959!call session%close_message()
5960
5961end subroutine dbadataattrv_extrude
5962
5964subroutine dbadataattrv_display(dataattr)
5965class(dbadataattrv), intent(in) :: dataattr
5966integer :: i
5967
5968do i=1, size(dataattr%dataattr)
5969 call dataattr%dataattr(i)%display()
5970end do
5971
5972end subroutine dbadataattrv_display
5973
5975subroutine dbadatai_geti(data,value)
5976class(dbadatai), intent(in) :: data
5977integer, intent(out) :: value
5978value=data%value
5979end subroutine dbadatai_geti
5980
5982subroutine dbadatar_getr(data,value)
5983class(dbadatar), intent(in) :: data
5984real, intent(out) :: value
5985value=data%value
5986end subroutine dbadatar_getr
5987
5989subroutine dbadatad_getd(data,value)
5990class(dbadatad), intent(in) :: data
5991doubleprecision, intent(out) :: value
5992value=data%value
5993end subroutine dbadatad_getd
5994
5996subroutine dbadatab_getb(data,value)
5997class(dbadatab), intent(in) :: data
5998integer(kind=int_b), intent(out) :: value
5999value=data%value
6000end subroutine dbadatab_getb
6001
6003subroutine dbadatac_getc(data,value)
6004class(dbadatac), intent(in) :: data
6005character(len=*), intent(out) :: value
6006value=data%value
6007end subroutine dbadatac_getc
6008
6009
6012type(dbadatai) elemental function dbadatai_init(btable,value)
6013
6014character(len=*),INTENT(IN),OPTIONAL :: btable
6015INTEGER,INTENT(IN),OPTIONAL :: value
6016
6017if (present(btable)) then
6018 dbadatai_init%btable=btable
6019else
6020 dbadatai_init%btable=cmiss
6021end if
6022
6023if (present(value)) then
6024 dbadatai_init%value=value
6025else
6026 dbadatai_init%value=imiss
6027end if
6028
6029end function dbadatai_init
6030
6033type(dbadatar) elemental function dbadatar_init(btable,value)
6034
6035character(len=*),INTENT(IN),OPTIONAL :: btable
6036real,INTENT(IN),OPTIONAL :: value
6037
6038if (present(btable)) then
6039 dbadatar_init%btable=btable
6040else
6041 dbadatar_init%btable=cmiss
6042end if
6043
6044if (present(value)) then
6045 dbadatar_init%value=value
6046else
6047 dbadatar_init%value=rmiss
6048end if
6049
6050end function dbadatar_init
6051
6054type(dbadatad) elemental function dbadatad_init(btable,value)
6055
6056character(len=*),INTENT(IN),OPTIONAL :: btable
6057double precision,INTENT(IN),OPTIONAL :: value
6058
6059if (present(btable)) then
6060 dbadatad_init%btable=btable
6061else
6062 dbadatad_init%btable=cmiss
6063end if
6064
6065if (present(value)) then
6066 dbadatad_init%value=value
6067else
6068 dbadatad_init%value=dmiss
6069end if
6070
6071end function dbadatad_init
6072
6073
6076type(dbadatab) elemental function dbadatab_init(btable,value)
6077
6078character(len=*),INTENT(IN),OPTIONAL :: btable
6079INTEGER(kind=int_b) ,INTENT(IN),OPTIONAL :: value
6080
6081if (present(btable)) then
6082 dbadatab_init%btable=btable
6083else
6084 dbadatab_init%btable=cmiss
6085end if
6086
6087if (present(value)) then
6088 dbadatab_init%value=value
6089else
6090 dbadatab_init%value=bmiss
6091end if
6092
6093end function dbadatab_init
6094
6097type(dbadatac) elemental function dbadatac_init(btable,value)
6098
6099character(len=*),INTENT(IN),OPTIONAL :: btable
6100character(len=*),INTENT(IN),OPTIONAL :: value
6101
6102if (present(btable)) then
6103 dbadatac_init%btable=btable
6104else
6105 dbadatac_init%btable=cmiss
6106end if
6107
6108if (present(value)) then
6109 dbadatac_init%value=value
6110else
6111 dbadatac_init%value=cmiss
6112end if
6113
6114end function dbadatac_init
6115
6116
6118subroutine dbadatai_set(data,session)
6119class(dbadatai), intent(in) :: data
6120type(dbasession), intent(in) :: session
6121integer :: ier
6122if (.not. c_e(data%btable)) return
6123ier = idba_set(session%sehandle,data%btable,data%value)
6124end subroutine dbadatai_set
6125
6127subroutine dbadatai_display(data)
6128class(dbadatai), intent(in) :: data
6129print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
6130end subroutine dbadatai_display
6131
6133subroutine dbadatar_set(data,session)
6134class(dbadatar), intent(in) :: data
6135type(dbasession), intent(in) :: session
6136integer :: ier
6137if (.not. c_e(data%btable)) return
6138ier = idba_set(session%sehandle,data%btable,data%value)
6139end subroutine dbadatar_set
6140
6142subroutine dbadatar_display(data)
6143class(dbadatar), intent(in) :: data
6144print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
6145end subroutine dbadatar_display
6146
6147
6149subroutine dbadatad_set(data,session)
6150class(dbadatad), intent(in) :: data
6151type(dbasession), intent(in) :: session
6152integer :: ier
6153if (.not. c_e(data%btable)) return
6154ier = idba_set(session%sehandle,data%btable,data%value)
6155end subroutine dbadatad_set
6156
6158subroutine dbadatad_display(data)
6159class(dbadatad), intent(in) :: data
6160print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
6161end subroutine dbadatad_display
6162
6164subroutine dbadatab_set(data,session)
6165class(dbadatab), intent(in) :: data
6166type(dbasession), intent(in) :: session
6167integer :: ier
6168if (.not. c_e(data%btable)) return
6169ier = idba_set(session%sehandle,data%btable,data%value)
6170end subroutine dbadatab_set
6171
6173subroutine dbadatab_display(data)
6174class(dbadatab), intent(in) :: data
6175print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
6176end subroutine dbadatab_display
6177
6179subroutine dbadatac_set(data,session)
6180class(dbadatac), intent(in) :: data
6181type(dbasession), intent(in) :: session
6182integer :: ier
6183if (.not. c_e(data%btable)) return
6184ier = idba_set(session%sehandle,data%btable,data%value)
6185end subroutine dbadatac_set
6186
6188subroutine dbadatac_display(data)
6189class(dbadatac), intent(in) :: data
6190print *,"Btable: ", t2c(data%btable,miss="Missing")," Value: ", t2c(data%value,miss="Missing value")
6191end subroutine dbadatac_display
6192
6193
6194!!$function dbalevel_spiega(level,handle)
6195!!$class(dbalevel), intent(in) :: level
6196!!$integer, intent(in) :: handle
6197!!$character (len=255) :: dbalevel_spiega
6198!!$integer :: ier
6199!!$
6200!!$ier = idba_spiegal(handle,level%level1,level%l1,level%level2,level%l2,dbalevel_spiega)
6201!!$if (ier /= 0) dbalevel_spiega = cmiss
6202!!$
6203!!$end function dbalevel_spiega
6204
6205
6207subroutine dbatimerange_display(timerange)
6208class(dbatimerange), intent(in) :: timerange
6209call display (timerange%vol7d_timerange)
6210end subroutine dbatimerange_display
6211
6213subroutine dbatimerange_set(timerange,session)
6214class(dbatimerange), intent(in) :: timerange
6215type(dbasession), intent(in) :: session
6216integer :: ier
6217
6218ier = idba_settimerange(session%sehandle,&
6219 timerange%timerange, timerange%p1, timerange%p2)
6220
6221!todo this is a work around
6222if (.not. c_e(timerange%vol7d_timerange)) then
6223 call session%setcontextana
6224end if
6225
6226end subroutine dbatimerange_set
6227
6229subroutine dbatimerange_enq(timerange,session)
6230class(dbatimerange), intent(out) :: timerange
6231type(dbasession), intent(in) :: session
6232integer :: ier
6233
6234ier = idba_enqtimerange(session%sehandle,&
6235 timerange%timerange, timerange%p1, timerange%p2)
6236
6237end subroutine dbatimerange_enq
6238
6241type(dbatimerange) function dbatimerange_init(timerange, p1, p2)
6242INTEGER,INTENT(IN),OPTIONAL :: timerange
6243INTEGER,INTENT(IN),OPTIONAL :: p1
6244INTEGER,INTENT(IN),OPTIONAL :: p2
6245
6246call init (dbatimerange_init%vol7d_timerange,timerange, p1, p2)
6247end function dbatimerange_init
6248
6250type(dbatimerange) function dbatimerange_contextana()
6251
6252dbatimerange_contextana=dbatimerange()
6253
6254end function dbatimerange_contextana
6255
6256
6258subroutine dbanetwork_display(network)
6259class(dbanetwork), intent(in) :: network
6260call display (network%vol7d_network)
6261print *,"Priority=",network%priority
6262end subroutine dbanetwork_display
6263
6265subroutine dbanetwork_set(network,session)
6266class(dbanetwork), intent(in) :: network
6267type(dbasession), intent(in) :: session
6268integer :: ier
6269
6270ier = idba_set(session%sehandle,"rep_memo", network%name)
6271
6272end subroutine dbanetwork_set
6273
6275subroutine dbanetwork_enq(network,session)
6276class(dbanetwork), intent(out) :: network
6277type(dbasession), intent(in) :: session
6278integer :: ier
6279
6280ier = idba_enq(session%sehandle,"rep_memo", network%name)
6281ier = idba_enq(session%sehandle,"priority", network%priority)
6282
6283end subroutine dbanetwork_enq
6284
6287type(dbanetwork) function dbanetwork_init(name)
6288CHARACTER(len=*),INTENT(in),OPTIONAL :: name
6289
6290call init (dbanetwork_init%vol7d_network,name)
6291dbanetwork_init%priority=imiss
6292end function dbanetwork_init
6293
6294
6296subroutine dbadatetime_display(datetime)
6297class(dbadatetime), intent(in) :: datetime
6298call display (datetime%datetime)
6299end subroutine dbadatetime_display
6300
6302subroutine dbadatetime_set(datetime,session)
6303class(dbadatetime), intent(in) :: datetime
6304type(dbasession), intent(in) :: session
6305integer :: ier,year,month,day,hour,minute,sec,msec
6306
6307CALL getval(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
6308
6309if (c_e(msec)) then
6310 sec=nint(float(msec)/1000.)
6311else
6312 sec=imiss
6313end if
6314
6315ier = idba_setdate(session%sehandle,year,month,day,hour,minute,sec)
6316
6317!todo this is a work around
6318if (.not. c_e(datetime%datetime)) then
6319 call session%setcontextana
6320end if
6321
6322end subroutine dbadatetime_set
6323
6325subroutine dbadatetime_enq(datetime,session)
6326class(dbadatetime), intent(out) :: datetime
6327type(dbasession), intent(in) :: session
6328
6329integer :: ier,year,month,day,hour,minute,sec,msec
6330
6331ier = idba_enqdate(session%sehandle,year,month,day,hour,minute,sec)
6332
6333if (c_e(sec)) then
6334 msec=sec*1000
6335else
6336 msec=imiss
6337end if
6338
6339!! TODO
6340!! this is a workaround ! year == 1000 should never exist
6341if (year==1000) then
6342 datetime%datetime=datetime_new()
6343else
6344 CALL init(datetime%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
6345end if
6346
6347end subroutine dbadatetime_enq
6348
6351type(dbadatetime) function dbadatetime_init(dt)
6352type(datetime),INTENT(in),OPTIONAL :: dt
6353
6354if (present(dt)) then
6355 dbadatetime_init%datetime=dt
6356else
6357 dbadatetime_init%datetime=datetime_new()
6358end if
6359
6360end function dbadatetime_init
6361
6363type(dbadatetime) function dbadatetime_contextana()
6364
6365dbadatetime_contextana%datetime=datetime_new()
6366
6367end function dbadatetime_contextana
6368
6369
6372type(dbametadata) function dbametadata_init(level,timerange,ana,network,datetime)
6373
6374type(dbalevel), intent(in), optional :: level
6375type(dbatimerange), intent(in), optional :: timerange
6376type(dbaana), intent(in), optional :: ana
6377type(dbanetwork), intent(in), optional :: network
6378type(dbadatetime), intent(in), optional :: datetime
6379
6380if (present(level)) then
6381 dbametadata_init%level=level
6382else
6383 dbametadata_init%level=dbalevel()
6384end if
6385
6386if (present(timerange)) then
6387 dbametadata_init%timerange=timerange
6388else
6389 dbametadata_init%timerange=dbatimerange()
6390end if
6391
6392if (present(ana)) then
6393 dbametadata_init%ana=ana
6394else
6395 dbametadata_init%ana=dbaana()
6396end if
6397
6398if (present(network)) then
6399 dbametadata_init%network=network
6400else
6401 dbametadata_init%network=dbanetwork()
6402end if
6403
6404if (present(datetime)) then
6405 dbametadata_init%datetime=datetime
6406else
6407 dbametadata_init%datetime=dbadatetime()
6408end if
6409
6410end function dbametadata_init
6411
6413subroutine dbametadata_display(metadata)
6414class(dbametadata), intent(in) :: metadata
6415call metadata%level%display()
6416call metadata%timerange%display()
6417call metadata%ana%display()
6418call metadata%network%display()
6419call metadata%datetime%display()
6420
6421end subroutine dbametadata_display
6422
6424subroutine dbametadata_set(metadata,session)
6425class(dbametadata), intent(in) :: metadata
6426type(dbasession), intent(in) :: session
6427
6428!print *,"extrude metadata:"
6429!call metadata%display()
6430
6431call metadata%ana%dbaset(session)
6432call metadata%network%dbaset(session)
6433
6434if (c_e(metadata%datetime%datetime) .or. &
6435 c_e(metadata%level%vol7d_level) .or. &
6436 c_e(metadata%timerange%vol7d_timerange)) then
6437
6438 call metadata%datetime%dbaset(session)
6439 call metadata%level%dbaset(session)
6440 call metadata%timerange%dbaset(session)
6441
6442else
6443 call session%setcontextana()
6444end if
6445
6446end subroutine dbametadata_set
6447
6449subroutine dbametadata_enq(metadata,session)
6450class(dbametadata), intent(out) :: metadata
6451type(dbasession), intent(in) :: session
6452
6453call metadata%ana%dbaenq(session)
6454call metadata%network%dbaenq(session)
6455call metadata%datetime%dbaenq(session)
6456call metadata%level%dbaenq(session)
6457call metadata%timerange%dbaenq(session)
6458
6459end subroutine dbametadata_enq
6460
6461
6463logical function dbafilter_equal_dbametadata(this,that)
6464
6465class(dbafilter), intent(in) :: this
6466class(dbametadata), intent(in) :: that
6467
6468dbafilter_equal_dbametadata = .false.
6469
6470!! TODO utilizzare dataonly ? direi di no
6471
6472if (this%contextana .and. c_e(that%timerange%vol7d_timerange)) return
6473if (this%contextana .and. c_e(that%datetime%datetime)) return
6474if (this%contextana .and. c_e(that%level%vol7d_level)) return
6475
6476if (c_e(this%level%vol7d_level) .and. .not. this%level%vol7d_level == that%level%vol7d_level ) return
6477if (c_e(this%timerange%vol7d_timerange) .and. .not. this%timerange%vol7d_timerange == that%timerange%vol7d_timerange ) return
6478if (c_e(this%datetime%datetime) .and. .not. this%datetime%datetime == that%datetime%datetime ) return
6479if (c_e(this%network%vol7d_network) .and. .not. this%network%vol7d_network == that%network%vol7d_network ) return
6480if (c_e(this%ana%vol7d_ana) .and. .not. this%ana%vol7d_ana == that%ana%vol7d_ana ) return
6481
6482if ( c_e(this%datetimemin%datetime) .and. c_e(that%datetime%datetime) .and. &
6483 this%datetimemin%datetime > that%datetime%datetime ) return
6484if ( c_e(this%datetimemax%datetime) .and. c_e(that%datetime%datetime) .and. &
6485 this%datetimemax%datetime < that%datetime%datetime ) return
6486
6487if (c_e(this%coordmin%geo_coord)) then
6488 if (geo_coord_ll(that%ana%vol7d_ana%coord, this%coordmin%geo_coord)) return
6489end if
6490
6491if (c_e(this%coordmax%geo_coord)) then
6492 if (geo_coord_ur(that%ana%vol7d_ana%coord, this%coordmax%geo_coord)) return
6493end if
6494
6495dbafilter_equal_dbametadata = .true.
6496
6497end function dbafilter_equal_dbametadata
6498
6499
6500!!$!> equal operator for dbafilter and dbadata
6501!!$! todo qui vuene utilizzata vars ma potrebbe essere attrs: bisogna distinguere
6502!!$elemental logical function dbafilter_equal_dbadata(this,that)
6503!!$
6504!!$class(dbafilter), intent(in) :: this !< first element
6505!!$class(dbadata), intent(in) :: that !< second element
6506!!$
6507!!$integer :: i
6508!!$
6509!!$!non compila:
6510!!$!dbafilter_equal_dbadata = any(this%vars%dcv(:)%dat == that)
6511!!$
6512!!$if (allocated(this%vars%dcv)) then
6513!!$ do i=1, size(this%vars%dcv(:))
6514!!$ dbafilter_equal_dbadata = this%vars%dcv(i)%dat == that
6515!!$ if (dbafilter_equal_dbadata) continue
6516!!$ end do
6517!!$else
6518!!$ dbafilter_equal_dbadata=.false.
6519!!$end if
6520!!$
6521!!$end function dbafilter_equal_dbadata
6522
6523
6526elemental logical function dbadcv_equal_dbadata(this,that)
6527
6528class(dbadcv), intent(in) :: this
6529class(dbadata), intent(in) :: that
6530
6531integer :: i
6532
6533!non compila:
6534!dbafilter_equal_dbadata = any(this%vars%dcv(:)%dat == that)
6535
6536if (allocated(this%dcv)) then
6537 dbadcv_equal_dbadata=.false.
6538 do i=1, size(this%dcv)
6539 dbadcv_equal_dbadata = this%dcv(i)%dat == that
6540 if (dbadcv_equal_dbadata) exit
6541 end do
6542else
6543 dbadcv_equal_dbadata=.true.
6544end if
6545
6546end function dbadcv_equal_dbadata
6547
6548
6550elemental logical function dbametadata_equal(this,that)
6551
6552class(dbametadata), intent(in) :: this
6553class(dbametadata), intent(in) :: that
6554
6555if ( &
6556 this%level%vol7d_level == that%level%vol7d_level .and. &
6557 this%timerange%vol7d_timerange == that%timerange%vol7d_timerange .and. &
6558 this%datetime%datetime == that%datetime%datetime .and. &
6559 this%network%vol7d_network == that%network%vol7d_network .and. &
6560 this%ana%vol7d_ana == that%ana%vol7d_ana &
6561 ) then
6562 dbametadata_equal = .true.
6563else
6564 dbametadata_equal = .false.
6565end if
6566
6567end function dbametadata_equal
6568
6569
6573type(dbafilter) function dbafilter_init(filter,ana,var,datetime,level,timerange,network,&
6574 datetimemin,datetimemax,coordmin,coordmax,limit,&
6575 ana_filter, data_filter, attr_filter, varlist, starvarlist, anavarlist, anastarvarlist ,&
6576 priority, priomin, priomax, contextana,&
6577 vars, starvars, anavars, anastarvars, query,anaonly,dataonly)
6578
6579type(dbafilter),intent(in),optional :: filter
6580type(dbaana),intent(in),optional :: ana
6581character(len=*),intent(in),optional :: var
6582type(dbadatetime),intent(in),optional :: datetime
6583type(dbalevel),intent(in),optional :: level
6584type(dbatimerange),intent(in),optional :: timerange
6585type(dbanetwork),intent(in),optional :: network
6586type(dbacoord),intent(in),optional :: coordmin
6587type(dbacoord),intent(in),optional :: coordmax
6588type(dbadatetime),intent(in),optional :: datetimemin
6589type(dbadatetime),intent(in),optional :: datetimemax
6590integer,intent(in),optional :: limit
6591character(len=*),intent(in),optional :: ana_filter
6592character(len=*),intent(in),optional :: data_filter
6593character(len=*),intent(in),optional :: attr_filter
6594character(len=*),intent(in),optional :: varlist
6595character(len=*),intent(in),optional :: starvarlist
6596character(len=*),intent(in),optional :: anavarlist
6597character(len=*),intent(in),optional :: anastarvarlist
6598integer,intent(in),optional :: priority
6599integer,intent(in),optional :: priomin
6600integer,intent(in),optional :: priomax
6601logical,intent(in),optional :: contextana
6602class(dbadcv),intent(in),optional :: vars ! vector of vars wanted on output
6603class(dbadcv),intent(in),optional :: starvars ! vector of vars for attribute wanted on output
6604class(dbadcv),intent(in),optional :: anavars ! vector of ana vars wanted on output
6605class(dbadcv),intent(in),optional :: anastarvars ! vector of vars for attribute of ana wanted on output
6606character(len=*),intent(in),optional :: query
6607logical,intent(in),optional :: anaonly
6608logical,intent(in),optional :: dataonly
6609
6610integer :: i
6611logical :: nopreserve
6612
6613nopreserve=.true.
6614if (present(filter)) then
6615 dbafilter_init=filter
6616
6617!!$ if (allocated(filter%vars%dcv)) then
6618!!$ if (allocated(dbafilter_init%vars%dcv)) deallocate(dbafilter_init%vars%dcv)
6619!!$ allocate(dbafilter_init%vars%dcv(size(filter%vars%dcv)))
6620!!$ do i =1,size(filter%vars%dcv)
6621!!$ allocate(dbafilter_init%vars%dcv(i)%dat,source=filter%vars%dcv(i)%dat)
6622!!$ end do
6623!!$ end if
6624!!$
6625!!$ if (allocated(filter%starvars%dcv)) then
6626!!$ if (allocated(dbafilter_init%starvars%dcv)) deallocate(dbafilter_init%starvars%dcv)
6627!!$ allocate(dbafilter_init%starvars%dcv(size(filter%starvars%dcv)))
6628!!$ do i =1,size(filter%starvars%dcv)
6629!!$ allocate(dbafilter_init%starvars%dcv(i)%dat,source=filter%starvars%dcv(i)%dat)
6630!!$ end do
6631!!$ end if
6632!!$
6633!!$ if (allocated(filter%anavars%dcv)) then
6634!!$ if (allocated(dbafilter_init%anavars%dcv)) deallocate(dbafilter_init%anavars%dcv)
6635!!$ allocate(dbafilter_init%anavars%dcv(size(filter%anavars%dcv)))
6636!!$ do i =1,size(filter%anavars%dcv)
6637!!$ call filter%anavars%dcv(i)%dat%display()
6638!!$ allocate(dbafilter_init%anavars%dcv(i)%dat,source=filter%anavars%dcv(i)%dat)
6639!!$ end do
6640!!$ end if
6641!!$
6642!!$ if (allocated(filter%anastarvars%dcv)) then
6643!!$ if (allocated(dbafilter_init%anastarvars%dcv)) deallocate(dbafilter_init%anastarvars%dcv)
6644!!$ allocate(dbafilter_init%anastarvars%dcv(size(filter%anastarvars%dcv)))
6645!!$ do i =1,size(filter%anastarvars%dcv)
6646!!$ allocate(dbafilter_init%anastarvars%dcv(i)%dat,source=filter%anastarvars%dcv(i)%dat)
6647!!$ end do
6648!!$ end if
6649
6650 nopreserve=.false.
6651end if
6652
6653if (present(ana)) then
6654 dbafilter_init%ana=ana
6655else if (nopreserve) then
6656 dbafilter_init%ana=dbaana()
6657end if
6658
6659if (present(var)) then
6660 dbafilter_init%var=var
6661else if (nopreserve) then
6662 dbafilter_init%var=cmiss
6663end if
6664
6665if (present(datetime)) then
6666 dbafilter_init%datetime=datetime
6667else if (nopreserve) then
6668 dbafilter_init%datetime=dbadatetime()
6669end if
6670
6671if (present(level)) then
6672 dbafilter_init%level=level
6673else if (nopreserve) then
6674 dbafilter_init%level=dbalevel()
6675end if
6676
6677if (present(timerange)) then
6678 dbafilter_init%timerange=timerange
6679else if (nopreserve) then
6680 dbafilter_init%timerange=dbatimerange()
6681end if
6682
6683if (present(network)) then
6684 dbafilter_init%network=network
6685else if (nopreserve) then
6686 dbafilter_init%network=dbanetwork()
6687end if
6688
6689if (present(datetimemin)) then
6690 dbafilter_init%datetimemin=datetimemin
6691else if (nopreserve) then
6692 dbafilter_init%datetimemin=dbadatetime()
6693end if
6694
6695if (present(datetimemax)) then
6696 dbafilter_init%datetimemax=datetimemax
6697else if (nopreserve) then
6698 dbafilter_init%datetimemax=dbadatetime()
6699end if
6700
6701if (present(coordmin)) then
6702 dbafilter_init%coordmin=coordmin
6703else if (nopreserve) then
6704 dbafilter_init%coordmin=dbacoord()
6705end if
6706
6707if (present(coordmax)) then
6708 dbafilter_init%coordmax=coordmax
6709else if (nopreserve) then
6710 dbafilter_init%coordmax=dbacoord()
6711end if
6712
6713if (present(limit)) then
6714 dbafilter_init%limit=limit
6715else if (nopreserve) then
6716 dbafilter_init%limit=imiss
6717end if
6718
6719if (present(ana_filter)) then
6720 dbafilter_init%ana_filter=ana_filter
6721else if (nopreserve) then
6722 dbafilter_init%ana_filter=cmiss
6723end if
6724
6725if (present(data_filter)) then
6726 dbafilter_init%data_filter=data_filter
6727else if (nopreserve) then
6728 dbafilter_init%data_filter=cmiss
6729end if
6730
6731if (present(attr_filter)) then
6732 dbafilter_init%attr_filter=attr_filter
6733else if (nopreserve) then
6734 dbafilter_init%attr_filter=cmiss
6735end if
6736
6737if (present(varlist)) then
6738 dbafilter_init%varlist=varlist
6739else if (nopreserve) then
6740 dbafilter_init%varlist=cmiss
6741end if
6742
6743if (present(starvarlist)) then
6744 dbafilter_init%starvarlist=starvarlist
6745else if (nopreserve) then
6746 dbafilter_init%starvarlist=cmiss
6747end if
6748
6749if (present(anavarlist)) then
6750 dbafilter_init%anavarlist=anavarlist
6751else if (nopreserve) then
6752 dbafilter_init%anavarlist=cmiss
6753end if
6754
6755if (present(anastarvarlist)) then
6756 dbafilter_init%anastarvarlist=anastarvarlist
6757else if (nopreserve) then
6758 dbafilter_init%anastarvarlist=cmiss
6759end if
6760
6761if (present(vars)) then
6762 if (allocated(vars%dcv)) then
6763 allocate(dbafilter_init%vars%dcv(size(vars%dcv)))
6764 do i =1,size(vars%dcv)
6765 allocate(dbafilter_init%vars%dcv(i)%dat,source=vars%dcv(i)%dat)
6766 end do
6767
6768 dbafilter_init%varlist=""
6769 do i=1,size(vars%dcv)
6770 dbafilter_init%varlist=trim(dbafilter_init%varlist)//vars%dcv(i)%dat%btable
6771 if (i /= size(vars%dcv)) dbafilter_init%varlist=trim(dbafilter_init%varlist)//","
6772 end do
6773 endif
6774end if
6775
6776if (present(starvars)) then
6777 if (allocated(starvars%dcv)) then
6778 allocate(dbafilter_init%starvars%dcv(size(starvars%dcv)))
6779 do i =1,size(starvars%dcv)
6780 allocate(dbafilter_init%starvars%dcv(i)%dat,source=starvars%dcv(i)%dat)
6781 end do
6782
6783 dbafilter_init%starvarlist=""
6784 do i=1,size(starvars%dcv)
6785 dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//starvars%dcv(i)%dat%btable
6786 if (i /= size(starvars%dcv)) dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//","
6787 end do
6788 end if
6789end if
6790
6791
6792if (present(anavars)) then
6793 if (allocated(anavars%dcv)) then
6794 allocate(dbafilter_init%anavars%dcv(size(anavars%dcv)))
6795 do i =1,size(anavars%dcv)
6796 allocate(dbafilter_init%anavars%dcv(i)%dat,source=anavars%dcv(i)%dat)
6797 end do
6798
6799 dbafilter_init%anavarlist=""
6800 do i=1,size(anavars%dcv)
6801 dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//anavars%dcv(i)%dat%btable
6802 if (i /= size(anavars%dcv)) dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//","
6803 end do
6804 endif
6805end if
6806
6807if (present(anastarvars)) then
6808 if (allocated(anastarvars%dcv)) then
6809 allocate(dbafilter_init%anastarvars%dcv(size(anastarvars%dcv)))
6810 do i =1,size(anastarvars%dcv)
6811 allocate(dbafilter_init%anastarvars%dcv(i)%dat,source=anastarvars%dcv(i)%dat)
6812 end do
6813
6814 dbafilter_init%anastarvarlist=""
6815 do i=1,size(anastarvars%dcv)
6816 dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//anastarvars%dcv(i)%dat%btable
6817 if (i /= size(anastarvars%dcv)) dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//","
6818 end do
6819 end if
6820end if
6821
6822if (present(priority)) then
6823 dbafilter_init%priority=priority
6824else if (nopreserve) then
6825 dbafilter_init%priority=imiss
6826end if
6827
6828if (present(priomin)) then
6829 dbafilter_init%priomin=priomax
6830else if (nopreserve) then
6831 dbafilter_init%priomin=imiss
6832end if
6833
6834if (present(priomax)) then
6835 dbafilter_init%priomax=priomax
6836else if (nopreserve) then
6837 dbafilter_init%priomax=imiss
6838end if
6839
6840if (present(contextana)) then
6841 dbafilter_init%contextana=contextana
6842else if (nopreserve) then
6843 dbafilter_init%contextana=.false.
6844end if
6845
6846if (present(anaonly)) then
6847 dbafilter_init%anaonly=anaonly
6848else if (nopreserve) then
6849 dbafilter_init%anaonly=.false.
6850end if
6851if (present(dataonly)) then
6852 dbafilter_init%dataonly=dataonly
6853else if (nopreserve) then
6854 dbafilter_init%dataonly=.false.
6855end if
6856
6857if (present(query)) then
6858 dbafilter_init%query=query
6859else if (nopreserve) then
6860 dbafilter_init%query=cmiss
6861end if
6862
6863end function dbafilter_init
6864
6866subroutine dbafilter_display(filter)
6867class(dbafilter), intent(in) :: filter
6868
6869print *,"------------------ filter ---------------"
6870call filter%ana%display()
6871call filter%datetime%display()
6872call filter%level%display()
6873call filter%timerange%display()
6874call filter%network%display()
6875print *, " >>>> minimum:"
6876call filter%datetimemin%display()
6877call filter%coordmin%display()
6878print *, " >>>> maximum:"
6879call filter%datetimemax%display()
6880call filter%coordmax%display()
6881print *, " >>>> vars:"
6882call filter%vars%display()
6883print *, " >>>> starvars:"
6884call filter%starvars%display()
6885print *, " >>>> anavars:"
6886call filter%anavars%display()
6887print *, " >>>> anastarvars:"
6888call filter%anastarvars%display()
6889print *,"var=",filter%var
6890print *,"limit=",filter%limit
6891print *,"ana_filter=",trim(filter%ana_filter)
6892print *,"data_filter=",trim(filter%data_filter)
6893print *,"attr_filter=",trim(filter%attr_filter)
6894print *,"varlist=",trim(filter%varlist)
6895print *,"*varlist=",trim(filter%starvarlist)
6896print *,"anavarlist=",trim(filter%anavarlist)
6897print *,"ana*varlist=",trim(filter%anastarvarlist)
6898print *,"priority=",filter%priority
6899print *,"priomin=",filter%priomin
6900print *,"priomax=",filter%priomax
6901print *,"contextana=",filter%contextana
6902print *,"anaonly=",filter%anaonly
6903print *,"dataonly=",filter%dataonly
6904print *,"query=",trim(filter%query)
6905
6906print *,"-----------------------------------------"
6907
6908end subroutine dbafilter_display
6909
6911subroutine dbafilter_set(filter,session)
6912class(dbafilter), intent(in) :: filter
6913type(dbasession), intent(in) :: session
6914
6915integer :: ier,year,month,day,hour,minute,sec,msec
6916
6917call session%unsetall()
6918
6919call filter%ana%dbaset(session)
6920call filter%network%dbaset(session)
6921ier = idba_set(session%sehandle,"var",filter%var)
6922
6923ier = idba_set(session%sehandle,"limit",filter%limit)
6924ier = idba_set(session%sehandle,"priority",filter%priority)
6925ier = idba_set(session%sehandle,"priomin",filter%priomin)
6926ier = idba_set(session%sehandle,"priomax",filter%priomax)
6927
6928ier = idba_set(session%sehandle,"latmin",getilat(filter%coordmin%geo_coord))
6929ier = idba_set(session%sehandle,"lonmin",getilon(filter%coordmin%geo_coord))
6930ier = idba_set(session%sehandle,"latmax",getilat(filter%coordmax%geo_coord))
6931ier = idba_set(session%sehandle,"lonmax",getilon(filter%coordmax%geo_coord))
6932
6933ier = idba_set(session%sehandle,"ana_filter",filter%ana_filter)
6934ier = idba_set(session%sehandle,"data_filter",filter%data_filter)
6935ier = idba_set(session%sehandle,"attr_filter",filter%attr_filter)
6936
6937ier = idba_set(session%sehandle,"query",filter%query)
6938
6939if (filter%contextana) then
6940
6941 call session%setcontextana()
6942
6943 ier = idba_set(session%sehandle,"varlist",filter%anavarlist)
6944 ier = idba_set(session%sehandle,"*varlist",filter%anastarvarlist)
6945
6946else
6947
6948 if (c_e(filter%datetime%datetime)) call filter%datetime%dbaset(session)
6949 if (c_e(filter%level%vol7d_level)) call filter%level%dbaset(session)
6950 if (c_e(filter%timerange%vol7d_timerange)) call filter%timerange%dbaset(session)
6951
6952 CALL getval(filter%datetimemin%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
6953 if (c_e(msec)) then
6954 sec=nint(float(msec)/1000.)
6955 else
6956 sec=imiss
6957 end if
6958
6959 ier = idba_set(session%sehandle,"yearmin",year)
6960 ier = idba_set(session%sehandle,"monthmin",month)
6961 ier = idba_set(session%sehandle,"daymin",day)
6962 ier = idba_set(session%sehandle,"hourmin",hour)
6963 ier = idba_set(session%sehandle,"minumin",minute)
6964 ier = idba_set(session%sehandle,"secmin",sec)
6965
6966 CALL getval(filter%datetimemax%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
6967
6968 if (c_e(msec)) then
6969 sec=nint(float(msec)/1000.)
6970 else
6971 sec=imiss
6972 end if
6973
6974 ier = idba_set(session%sehandle,"yearmax",year)
6975 ier = idba_set(session%sehandle,"monthmax",month)
6976 ier = idba_set(session%sehandle,"daymax",day)
6977 ier = idba_set(session%sehandle,"hourmax",hour)
6978 ier = idba_set(session%sehandle,"minumax",minute)
6979 ier = idba_set(session%sehandle,"secmax",sec)
6980
6981
6982 ier = idba_set(session%sehandle,"varlist",filter%varlist)
6983 ier = idba_set(session%sehandle,"*varlist",filter%starvarlist)
6984end if
6985
6986end subroutine dbafilter_set
6987
6988
6990type(dbametadata) function dbametadata_contextana(metadata)
6991class(dbametadata), intent(in) :: metadata
6992
6993type (dbadatetime) :: datetime
6994type (dbalevel) :: level
6995type (dbatimerange) :: timerange
6996
6997select type(metadata)
6998type is(dbametadata)
6999 dbametadata_contextana=metadata
7000end select
7001
7002dbametadata_contextana%datetime=datetime%dbacontextana()
7003dbametadata_contextana%level=level%dbacontextana()
7004dbametadata_contextana%timerange=timerange%dbacontextana()
7005
7006end function dbametadata_contextana
7007
7008
7010subroutine dbametaanddata_display(metaanddata)
7011class(dbametaanddata), intent(in) :: metaanddata
7012
7013call metaanddata%metadata%display()
7014call metaanddata%dataattrv%display()
7015
7016end subroutine dbametaanddata_display
7017
7019subroutine dbametaanddata_extrude(metaanddata,session,noattr,filter,attronly,template)
7020class(dbametaanddata), intent(in) :: metaanddata
7021type(dbasession), intent(in) :: session
7022logical, intent(in),optional :: noattr
7023type(dbafilter),intent(in),optional :: filter
7024logical, intent(in),optional :: attronly
7025character(len=*),intent(in),optional :: template
7026
7027type(dbafilter) :: myfilter
7028
7029!print *,"------------------"
7030!call metaanddata%display()
7031!print *,"contextana false"
7032
7033myfilter=dbafilter(filter=filter,contextana=.false.)
7034call extrude(metaanddata,session,noattr,myfilter,attronly,template)
7035
7036!print *,"contextana true"
7037myfilter=dbafilter(filter=filter,contextana=.true.)
7038call extrude(metaanddata,session,noattr,myfilter,attronly,template)
7039
7040contains
7041
7042subroutine extrude(metaanddata,session,noattr,filter,attronly,template)
7043class(dbametaanddata), intent(in) :: metaanddata
7044type(dbasession), intent(in) :: session
7045logical, intent(in),optional :: noattr
7046type(dbafilter),intent(in) :: filter
7047logical, intent(in),optional :: attronly
7048character(len=*),intent(in),optional :: template
7049
7050if (.not. filter == metaanddata%metadata) return
7051
7052call session%unsetall()
7053!write metadata
7054call session%set(metadata=metaanddata%metadata)
7055
7056!write data and attribute
7057!call session%extrude(metaanddata%dataattrv,noattr,filter)
7058call metaanddata%dataattrv%extrude(session,noattr,filter,attronly)
7059
7060!to close message on file
7061call session%close_message(template)
7062
7063end subroutine extrude
7064end subroutine dbametaanddata_extrude
7065
7066
7068subroutine dbametaanddatav_display(metaanddatav)
7069class(dbametaanddatav), intent(in) :: metaanddatav
7070
7071call metaanddatav%metadata%display()
7072call metaanddatav%datav%display()
7073
7074end subroutine dbametaanddatav_display
7075
7077subroutine dbametaanddatav_extrude(metaanddatav,session,noattr,filter,template)
7078class(dbametaanddatav), intent(in) :: metaanddatav
7079type(dbasession), intent(in) :: session
7080logical, intent(in),optional :: noattr
7081type(dbafilter),intent(in),optional :: filter
7082character(len=*),intent(in),optional :: template
7083
7084type(dbafilter) :: myfilter
7085
7086myfilter=dbafilter(filter=filter,contextana=.false.)
7087call extrude(metaanddatav,session,noattr,myfilter,template)
7088
7089myfilter=dbafilter(filter=filter,contextana=.true.)
7090call extrude(metaanddatav,session,noattr,myfilter,template)
7091
7092contains
7093
7094subroutine extrude(metaanddatav,session,noattr,filter,template)
7095class(dbametaanddatav), intent(in) :: metaanddatav
7096type(dbasession), intent(in) :: session
7097logical, intent(in),optional :: noattr
7098type(dbafilter),intent(in) :: filter
7099character(len=*),intent(in),optional :: template
7100
7101if (.not. filter == metaanddatav%metadata)return
7102!write metadata
7103call session%set(metadata=metaanddatav%metadata)
7104
7105!write ana data and attribute
7106!!$call session%set(datav=metaanddatav%datav)
7107call metaanddatav%datav%extrude(session,noattr,filter,template)
7108
7109print*,"dbaana_metaanddatav"
7110!to close message on file
7111call session%close_message(template)
7112
7113end subroutine extrude
7114end subroutine dbametaanddatav_extrude
7115
7116
7118subroutine dbametaanddatal_extrude(metaanddatal,session,noattr,filter,attronly,template)
7119class(dbametaanddatalist), intent(inout) :: metaanddatal
7120class(dbasession), intent(in) :: session
7121logical, intent(in),optional :: noattr
7122type(dbafilter),intent(in),optional :: filter
7123type(dbametaanddata) :: metaanddata
7124logical, intent(in),optional :: attronly
7125character(len=*),intent(in),optional :: template
7126
7127call metaanddatal%rewind()
7128do while(metaanddatal%element())
7129 !call session%extrude(metaanddatal%current(),noattr,filter)
7130 metaanddata=metaanddatal%current()
7131 call metaanddata%extrude(session,noattr,filter,attronly,template)
7132 call metaanddatal%next()
7133end do
7134
7135end subroutine dbametaanddatal_extrude
7136
7137
7139subroutine displaydbametaanddatai(this)
7140class(dbametaanddataiList),intent(inout) :: this
7141type(dbametaanddatai) :: element
7142
7143call this%rewind()
7144do while(this%element())
7145 print *,"index:",this%currentindex()," value:"
7146 element=this%current()
7147 call element%display()
7148 call this%next()
7149end do
7150end subroutine displaydbametaanddatai
7151
7153type(dbametaanddatai) function currentdbametaanddatai(this)
7154class(dbametaanddataiList) :: this
7155class(*), pointer :: v
7156
7157v => this%currentpoli()
7158select type(v)
7159type is (dbametaanddatai)
7160 currentdbametaanddatai = v
7161end select
7162end function currentdbametaanddatai
7163
7164
7166subroutine dbasession_ingest_metaanddatail(session,metaanddatal,filter)
7167class(dbasession), intent(inout) :: session
7168type(dbametaanddatailist), intent(inout) :: metaanddatal
7169type(dbafilter),intent(in),optional :: filter
7170
7171type(dbametaanddatai) :: element
7172
7173
7174if (session%memdb .and. .not. session%loadfile)then
7175
7176 do while (session%messages_read_next())
7177 call session%set(filter=filter)
7178 call session%ingest_metaanddatai()
7179 call session%ingest_metaanddatai(element)
7180 call metaanddatal%append(element)
7181 call session%remove_all()
7182 end do
7183
7184else
7185
7186 call session%set(filter=filter)
7187 call session%ingest_metaanddatai()
7188 do while (c_e(session%count) .and. session%count >0)
7189 call session%ingest_metaanddatai(element)
7190 call metaanddatal%append(element)
7191 if (session%file) call session%ingest()
7192 end do
7193
7194end if
7195
7196end subroutine dbasession_ingest_metaanddatail
7197
7199function toarray_dbametaanddatai(this)
7200type(dbametaanddatai),allocatable :: toarray_dbametaanddatai(:)
7201class(dbametaanddataiList) :: this
7202
7203integer :: i
7204
7205allocate (toarray_dbametaanddatai(this%countelements()))
7206
7207call this%rewind()
7208i=0
7209do while(this%element())
7210 i=i+1
7211 toarray_dbametaanddatai(i) =this%current()
7212 call this%next()
7213end do
7214end function toarray_dbametaanddatai
7215
7216
7218subroutine displaydbametaanddatar(this)
7219class(dbametaanddatarList),intent(inout) :: this
7220type(dbametaanddatar) :: element
7221
7222call this%rewind()
7223do while(this%element())
7224 print *,"index:",this%currentindex()," value:"
7225 element=this%current()
7226 call element%display()
7227 call this%next()
7228end do
7229end subroutine displaydbametaanddatar
7230
7232type(dbametaanddatar) function currentdbametaanddatar(this)
7233class(dbametaanddatarList) :: this
7234class(*), pointer :: v
7235
7236v => this%currentpoli()
7237select type(v)
7238type is (dbametaanddatar)
7239 currentdbametaanddatar = v
7240end select
7241end function currentdbametaanddatar
7242
7243
7245subroutine dbasession_ingest_metaanddatarl(session,metaanddatal,filter)
7246class(dbasession), intent(inout) :: session
7247type(dbametaanddatarlist), intent(inout) :: metaanddatal
7248type(dbafilter),intent(in),optional :: filter
7249
7250type(dbametaanddatar) :: element
7251
7252if (session%memdb .and. .not. session%loadfile)then
7253
7254 do while (session%messages_read_next())
7255 call session%set(filter=filter)
7256 call session%ingest_metaanddatar()
7257 call session%ingest_metaanddatar(element)
7258 call metaanddatal%append(element)
7259 call session%remove_all()
7260 end do
7261
7262else
7263
7264 call session%set(filter=filter)
7265 call session%ingest_metaanddatar()
7266 do while (c_e(session%count) .and. session%count >0)
7267 call session%ingest_metaanddatar(element)
7268 call metaanddatal%append(element)
7269 if (session%file) call session%ingest()
7270 end do
7271
7272end if
7273
7274
7275end subroutine dbasession_ingest_metaanddatarl
7276
7277
7279function toarray_dbametaanddatar(this)
7280type(dbametaanddatar),allocatable :: toarray_dbametaanddatar(:)
7281class(dbametaanddatarList) :: this
7282
7283integer :: i
7284i=this%countelements()
7285!print *, "allocate:",i
7286allocate (toarray_dbametaanddatar(this%countelements()))
7287
7288call this%rewind()
7289i=0
7290do while(this%element())
7291 i=i+1
7292 toarray_dbametaanddatar(i) =this%current()
7293 call this%next()
7294end do
7295end function toarray_dbametaanddatar
7296
7297
7299subroutine displaydbametaanddatad(this)
7300class(dbametaanddatadList),intent(inout) :: this
7301type(dbametaanddatad) :: element
7302
7303call this%rewind()
7304do while(this%element())
7305 print *,"index:",this%currentindex()," value:"
7306 element=this%current()
7307 call element%display()
7308 call this%next()
7309end do
7310end subroutine displaydbametaanddatad
7311
7313type(dbametaanddatad) function currentdbametaanddatad(this)
7314class(dbametaanddatadList) :: this
7315class(*), pointer :: v
7316
7317v => this%currentpoli()
7318select type(v)
7319type is (dbametaanddatad)
7320 currentdbametaanddatad = v
7321end select
7322end function currentdbametaanddatad
7323
7325subroutine dbasession_ingest_metaanddatadl(session,metaanddatal,filter)
7326class(dbasession), intent(inout) :: session
7327type(dbametaanddatadlist), intent(inout) :: metaanddatal
7328type(dbafilter),intent(in),optional :: filter
7329
7330type(dbametaanddatad) :: element
7331
7332if (session%memdb .and. .not. session%loadfile)then
7333
7334 do while (session%messages_read_next())
7335 call session%set(filter=filter)
7336 call session%ingest_metaanddatad()
7337 call session%ingest_metaanddatad(element)
7338 call metaanddatal%append(element)
7339 call session%remove_all()
7340 end do
7341
7342else
7343
7344 call session%set(filter=filter)
7345 call session%ingest_metaanddatad()
7346 do while (c_e(session%count) .and. session%count >0)
7347 call session%ingest_metaanddatad(element)
7348 call metaanddatal%append(element)
7349 if (session%file) call session%ingest()
7350 end do
7351
7352end if
7353
7354end subroutine dbasession_ingest_metaanddatadl
7355
7356
7358function toarray_dbametaanddatad(this)
7359type(dbametaanddatad),allocatable :: toarray_dbametaanddatad(:)
7360class(dbametaanddatadList) :: this
7361
7362integer :: i
7363
7364allocate (toarray_dbametaanddatad(this%countelements()))
7365
7366call this%rewind()
7367i=0
7368do while(this%element())
7369 i=i+1
7370 toarray_dbametaanddatad(i) =this%current()
7371 call this%next()
7372end do
7373end function toarray_dbametaanddatad
7374
7375
7377subroutine displaydbametaanddatab(this)
7378class(dbametaanddatabList),intent(inout) :: this
7379type(dbametaanddatab) :: element
7380
7381call this%rewind()
7382do while(this%element())
7383 print *,"index:",this%currentindex()," value:"
7384 element=this%current()
7385 call element%display()
7386 call this%next()
7387end do
7388end subroutine displaydbametaanddatab
7389
7391type(dbametaanddatab) function currentdbametaanddatab(this)
7392class(dbametaanddatabList) :: this
7393class(*), pointer :: v
7394
7395v => this%currentpoli()
7396select type(v)
7397type is (dbametaanddatab)
7398 currentdbametaanddatab = v
7399end select
7400end function currentdbametaanddatab
7401
7402
7404subroutine dbasession_ingest_metaanddatabl(session,metaanddatal,filter)
7405class(dbasession), intent(inout) :: session
7406type(dbametaanddatablist), intent(inout) :: metaanddatal
7407type(dbafilter),intent(in),optional :: filter
7408
7409type(dbametaanddatab) :: element
7410
7411if (session%memdb .and. .not. session%loadfile)then
7412
7413 do while (session%messages_read_next())
7414 call session%set(filter=filter)
7415 call session%ingest_metaanddatab()
7416 call session%ingest_metaanddatab(element)
7417 call metaanddatal%append(element)
7418 call session%remove_all()
7419 end do
7420
7421else
7422
7423 call session%set(filter=filter)
7424 call session%ingest_metaanddatab()
7425 do while (c_e(session%count) .and. session%count >0)
7426 call session%ingest_metaanddatab(element)
7427 call metaanddatal%append(element)
7428 if (session%file) call session%ingest()
7429 end do
7430
7431end if
7432
7433end subroutine dbasession_ingest_metaanddatabl
7434
7435
7437function toarray_dbametaanddatab(this)
7438type(dbametaanddatab),allocatable :: toarray_dbametaanddatab(:)
7439class(dbametaanddatabList) :: this
7440
7441integer :: i
7442
7443allocate (toarray_dbametaanddatab(this%countelements()))
7444
7445call this%rewind()
7446i=0
7447do while(this%element())
7448 i=i+1
7449 toarray_dbametaanddatab(i) =this%current()
7450 call this%next()
7451end do
7452end function toarray_dbametaanddatab
7453
7454
7456subroutine displaydbametaanddatac(this)
7457class(dbametaanddatacList),intent(inout) :: this
7458type(dbametaanddatac) :: element
7459
7460call this%rewind()
7461do while(this%element())
7462 print *,"index:",this%currentindex()," value:"
7463 element=this%current()
7464 call element%display()
7465 call this%next()
7466end do
7467end subroutine displaydbametaanddatac
7468
7470type(dbametaanddatac) function currentdbametaanddatac(this)
7471class(dbametaanddatacList) :: this
7472class(*), pointer :: v
7473
7474v => this%currentpoli()
7475select type(v)
7476type is (dbametaanddatac)
7477 currentdbametaanddatac = v
7478end select
7479end function currentdbametaanddatac
7480
7481
7483subroutine dbasession_ingest_metaanddatacl(session,metaanddatal,filter)
7484class(dbasession), intent(inout) :: session
7485type(dbametaanddataclist), intent(inout) :: metaanddatal
7486type(dbafilter),intent(in),optional :: filter
7487
7488type(dbametaanddatac) :: element
7489
7490if (session%memdb .and. .not. session%loadfile)then
7491
7492 do while (session%messages_read_next())
7493 call session%set(filter=filter)
7494 call session%ingest_metaanddatac()
7495 call session%ingest_metaanddatac(element)
7496 call metaanddatal%append(element)
7497 call session%remove_all()
7498 end do
7499
7500else
7501
7502 call session%set(filter=filter)
7503 call session%ingest_metaanddatac()
7504 do while (c_e(session%count) .and. session%count >0)
7505 call session%ingest_metaanddatac(element)
7506 call metaanddatal%append(element)
7507 if (session%file) call session%ingest()
7508 end do
7509
7510end if
7511
7512end subroutine dbasession_ingest_metaanddatacl
7513
7514
7516function toarray_dbametaanddatac(this)
7517type(dbametaanddatac),allocatable :: toarray_dbametaanddatac(:)
7518class(dbametaanddatacList) :: this
7519
7520integer :: i
7521
7522allocate (toarray_dbametaanddatac(this%countelements()))
7523
7524call this%rewind()
7525i=0
7526do while(this%element())
7527 i=i+1
7528 toarray_dbametaanddatac(i) =this%current()
7529 call this%next()
7530end do
7531end function toarray_dbametaanddatac
7532
7533
7535subroutine dbametaanddatai_display(data)
7536class(dbametaanddatai), intent(in) :: data
7537
7538call data%metadata%display()
7539call data%dbadatai%display()
7540
7541end subroutine dbametaanddatai_display
7542
7544subroutine dbametaanddatab_display(data)
7545class(dbametaanddatab), intent(in) :: data
7546
7547call data%metadata%display()
7548call data%dbadatab%display()
7549
7550end subroutine dbametaanddatab_display
7551
7553subroutine dbametaanddatad_display(data)
7554class(dbametaanddatad), intent(in) :: data
7555
7556call data%metadata%display()
7557call data%dbadatad%display()
7558
7559end subroutine dbametaanddatad_display
7560
7562subroutine dbametaanddatar_display(data)
7563class(dbametaanddatar), intent(in) :: data
7564
7565call data%metadata%display()
7566call data%dbadatar%display()
7567
7568end subroutine dbametaanddatar_display
7569
7570
7572subroutine dbametaanddatac_display(data)
7573class(dbametaanddatac), intent(in) :: data
7574
7575call data%metadata%display()
7576call data%dbadatac%display()
7577
7578end subroutine dbametaanddatac_display
7579
7580
7582subroutine dbametaanddatai_extrude(metaanddatai,session)
7583class(dbametaanddatai), intent(in) :: metaanddatai
7584type(dbasession), intent(in) :: session
7585
7586call session%unsetall()
7587!write metadata
7588call session%set(metadata=metaanddatai%metadata)
7589!write ana data and attribute
7590call session%set(data=metaanddatai%dbadatai)
7591
7592if (metaanddatai%dbadatai%c_e()) then
7593 call session%prendilo()
7594else
7595 call session%dimenticami()
7596endif
7597
7598end subroutine dbametaanddatai_extrude
7599
7601subroutine dbametaanddatab_extrude(metaanddatab,session)
7602class(dbametaanddatab), intent(in) :: metaanddatab
7603type(dbasession), intent(in) :: session
7604
7605call session%unsetall()
7606!write metadata
7607call session%set(metadata=metaanddatab%metadata)
7608!write ana data and attribute
7609call session%set(data=metaanddatab%dbadatab)
7610
7611if (metaanddatab%dbadatab%c_e()) then
7612 call session%prendilo()
7613else
7614 call session%dimenticami()
7615endif
7616
7617end subroutine dbametaanddatab_extrude
7618
7620subroutine dbametaanddatad_extrude(metaanddatad,session)
7621class(dbametaanddatad), intent(in) :: metaanddatad
7622type(dbasession), intent(in) :: session
7623
7624call session%unsetall()
7625!write metadata
7626call session%set(metadata=metaanddatad%metadata)
7627!write ana data and attribute
7628call session%set(data=metaanddatad%dbadatad)
7629
7630if (metaanddatad%dbadatad%c_e()) then
7631 call session%prendilo()
7632else
7633 call session%dimenticami()
7634endif
7635
7636end subroutine dbametaanddatad_extrude
7637
7639subroutine dbametaanddatar_extrude(metaanddatar,session)
7640class(dbametaanddatar), intent(in) :: metaanddatar
7641type(dbasession), intent(in) :: session
7642
7643call session%unsetall()
7644!write metadata
7645call session%set(metadata=metaanddatar%metadata)
7646!write ana data and attribute
7647call session%set(data=metaanddatar%dbadatar)
7648
7649if (metaanddatar%dbadatar%c_e()) then
7650 call session%prendilo()
7651else
7652 call session%dimenticami()
7653endif
7654
7655end subroutine dbametaanddatar_extrude
7656
7658subroutine dbametaanddatac_extrude(metaanddatac,session)
7659class(dbametaanddatac), intent(in) :: metaanddatac
7660type(dbasession), intent(in) :: session
7661
7662call session%unsetall()
7663!write metadata
7664call session%set(metadata=metaanddatac%metadata)
7665!write ana data and attribute
7666call session%set(data=metaanddatac%dbadatac)
7667
7668if (metaanddatac%dbadatac%c_e()) then
7669 call session%prendilo()
7670else
7671 call session%dimenticami()
7672endif
7673
7674end subroutine dbametaanddatac_extrude
7675
7677subroutine dbasession_ingest_ana(session,ana)
7678class(dbasession), intent(inout) :: session
7679type(dbaana), intent(out),optional :: ana
7680
7681integer :: ier
7682
7683if (.not. present(ana)) then
7684 ier = idba_quantesono(session%sehandle, session%count)
7685 !print *,"numero ana",session%count
7686else
7687 ier = idba_elencamele(session%sehandle)
7688 call ana%dbaenq(session)
7689 session%count=session%count-1
7690end if
7691
7692end subroutine dbasession_ingest_ana
7693
7694
7696subroutine dbasession_ingest_anav(session,anav)
7697class(dbasession), intent(inout) :: session
7698type(dbaana), intent(out),allocatable :: anav(:)
7699integer :: i
7700
7701call session%ingest_ana()
7702
7703if (c_e(session%count)) then
7704 allocate(anav(session%count))
7705 i=0
7706 do while (session%count >0)
7707 i=i+1
7708 call session%ingest_ana(anav(i))
7709 end do
7710else
7711 allocate(anav(0))
7712end if
7713
7714end subroutine dbasession_ingest_anav
7715
7716
7718subroutine dbasession_ingest_anal(session,anal)
7719class(dbasession), intent(inout) :: session
7720type(dbaanalist), intent(out) :: anal
7721type(dbaana) :: element
7722
7723call session%ingest_ana()
7724do while (c_e(session%count) .and. session%count >0)
7725 call session%ingest_ana(element)
7726 call anal%append(element)
7727 call session%ingest_ana()
7728end do
7729end subroutine dbasession_ingest_anal
7730
7731
7733subroutine dbasession_ingest_metaanddata(session,metaanddata,noattr,filter)
7734class(dbasession), intent(inout) :: session
7735type(dbametaanddata), intent(inout),optional :: metaanddata
7736logical,intent(in),optional :: noattr
7737type(dbafilter),intent(in),optional :: filter
7738
7739type(dbametadata) :: metadata
7740integer :: ier,acount,i,j,k
7741character(len=9) :: btable
7742character(255) :: value
7743logical :: lvars,lstarvars
7744type(dbadcv) :: vars,starvars
7745
7746
7747 ! if you do not pass metaanddata we presume to have to initialize the query
7748if (.not. present(metaanddata)) then
7749 ier = idba_voglioquesto(session%sehandle, session%count)
7750
7751 ! preroll one read because after I have to read one more to check metadata
7752 if (c_e(session%count) .and. session%count > 0) then
7753 ier = idba_dammelo(session%sehandle, btable)
7754 end if
7755
7756else
7757
7758 ! you pass metaanddata so we continue with the query
7759
7760 if (allocated(metaanddata%dataattrv%dataattr)) then
7761 deallocate (metaanddata%dataattrv%dataattr)
7762 end if
7763
7764 lvars=.false.
7765 lstarvars=.false.
7766 if (present(filter)) then
7767
7768 if (filter%contextana) then
7769
7770 !todo try to use this: vars=filter%anavars
7771 if (allocated(filter%anavars%dcv)) then
7772 lvars=.true.
7773 allocate(vars%dcv(size(filter%anavars%dcv)))
7774 do i =1,size(filter%anavars%dcv)
7775 allocate(vars%dcv(i)%dat,source=filter%anavars%dcv(i)%dat)
7776 end do
7777 end if
7778
7779 if (allocated(filter%anastarvars%dcv)) then
7780 lstarvars=.true.
7781 allocate(starvars%dcv(size(filter%anastarvars%dcv)))
7782 do i =1,size(filter%anastarvars%dcv)
7783 allocate(starvars%dcv(i)%dat,source=filter%anastarvars%dcv(i)%dat)
7784 end do
7785 end if
7786
7787 else
7788
7789 if (allocated(filter%vars%dcv)) then
7790 lvars=.true.
7791 allocate(vars%dcv(size(filter%vars%dcv)))
7792 do i =1,size(filter%vars%dcv)
7793 allocate(vars%dcv(i)%dat,source=filter%vars%dcv(i)%dat)
7794 end do
7795 end if
7796
7797 if (allocated(filter%starvars%dcv)) then
7798 lstarvars=.true.
7799 allocate(starvars%dcv(size(filter%starvars%dcv)))
7800 do i =1,size(filter%starvars%dcv)
7801 allocate(starvars%dcv(i)%dat,source=filter%starvars%dcv(i)%dat)
7802 end do
7803 end if
7804
7805 end if
7806
7807 end if
7808
7809 if (lvars) then
7810
7811 ! create an empty vector for data
7812 allocate (metaanddata%dataattrv%dataattr(size(vars%dcv)))
7813 do i = 1, size(vars%dcv)
7814 allocate (metaanddata%dataattrv%dataattr(i)%dat,source=vars%dcv(i)%dat)
7815 end do
7816
7817 ! load metadata
7818 call metaanddata%metadata%dbaenq(session)
7819 ! load curret metadata
7820 call metadata%dbaenq(session)
7821
7822 ! if current metadata is equal to metadata
7823 do while ( metaanddata%metadata == metadata )
7824 ier = idba_enq(session%sehandle,"var",btable)
7825 do i=1,size(metaanddata%dataattrv%dataattr)
7826 if (metaanddata%dataattrv%dataattr(i)%dat%btable == btable) then
7827
7828 select type ( dat => metaanddata%dataattrv%dataattr(i)%dat )
7829 type is (dbadatai)
7830 ier = idba_enq(session%sehandle, btable,dat%value)
7831 type is (dbadatar)
7832 ier = idba_enq(session%sehandle, btable,dat%value)
7833 type is (dbadatad)
7834 ier = idba_enq(session%sehandle, btable,dat%value)
7835 type is (dbadatab)
7836 ier = idba_enq(session%sehandle, btable,dat%value)
7837 type is (dbadatac)
7838 ier = idba_enq(session%sehandle, btable,dat%value)
7839 end select
7840
7841 if (optio_log(noattr))then
7842 ! initialize to (0) the attribute vector
7843 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
7844
7845 else
7846
7847 if (lstarvars) then
7848
7849 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(size(starvars%dcv)))
7850 do j = 1, size(starvars%dcv)
7851 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
7852 end do
7853
7854 if (c_e(session%count) .and. session%count > 0) then
7855
7856 ier = idba_voglioancora(session%sehandle, acount)
7857 do k =1,acount
7858 ier = idba_ancora(session%sehandle, btable)
7859 ier = idba_enq(session%sehandle, btable,value)
7860
7861 do j=1,size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
7862
7863 if (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat%btable == btable) then
7864
7865 select type ( dat => metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat )
7866 type is (dbadatai)
7867 ier = idba_enq(session%sehandle, btable,dat%value)
7868 type is (dbadatar)
7869 ier = idba_enq(session%sehandle, btable,dat%value)
7870 type is (dbadatad)
7871 ier = idba_enq(session%sehandle, btable,dat%value)
7872 type is (dbadatab)
7873 ier = idba_enq(session%sehandle, btable,dat%value)
7874 type is (dbadatac)
7875 ier = idba_enq(session%sehandle, btable,dat%value)
7876 end select
7877
7878 end if
7879 end do
7880 end do
7881 end if
7882 else
7883 if (c_e(session%count) .and. session%count > 0) then
7884 ier = idba_voglioancora(session%sehandle, acount)
7885
7886 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(acount))
7887 do j =1,acount
7888 ier = idba_ancora(session%sehandle, btable)
7889 ier = idba_enq(session%sehandle, btable,value)
7890 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatac(btable,value))
7891 end do
7892 else
7893 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
7894 end if
7895 end if
7896 end if
7897 end if
7898 end do
7899
7900 if (c_e(session%count)) session%count=session%count-1
7901
7902 if (c_e(session%count) .and. session%count > 0 ) then
7903 ier = idba_dammelo(session%sehandle, btable)
7904 call metadata%dbaenq(session)
7905 else
7906 metadata=dbametadata()
7907 end if
7908 end do
7909 else
7910
7911 allocate (metaanddata%dataattrv%dataattr(1))
7912 ier = idba_enq(session%sehandle,"var",btable)
7913 ier = idba_enq(session%sehandle, btable,value)
7914 allocate (metaanddata%dataattrv%dataattr(1)%dat,source=dbadatac(btable,value))
7915 call metaanddata%metadata%dbaenq(session)
7916
7917
7918 if (optio_log(noattr))then
7919
7920 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
7921
7922 else
7923
7924 if (lstarvars) then
7925
7926 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(size(starvars%dcv)))
7927 do j = 1, size(starvars%dcv)
7928 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
7929 end do
7930
7931 if (c_e(session%count) .and. session%count > 0) then
7932
7933 ier = idba_voglioancora(session%sehandle, acount)
7934 do k =1,acount
7935 ier = idba_ancora(session%sehandle, btable)
7936 ier = idba_enq(session%sehandle, btable,value)
7937
7938 do j=1,size(metaanddata%dataattrv%dataattr(1)%attrv%dcv)
7939
7940 if (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat%btable == btable) then
7941
7942 select type ( dat => metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat )
7943 type is (dbadatai)
7944 ier = idba_enq(session%sehandle, btable,dat%value)
7945 type is (dbadatar)
7946 ier = idba_enq(session%sehandle, btable,dat%value)
7947 type is (dbadatad)
7948 ier = idba_enq(session%sehandle, btable,dat%value)
7949 type is (dbadatab)
7950 ier = idba_enq(session%sehandle, btable,dat%value)
7951 type is (dbadatac)
7952 ier = idba_enq(session%sehandle, btable,dat%value)
7953 end select
7954
7955 end if
7956 end do
7957 end do
7958 end if
7959 else
7960 if (c_e(session%count) .and. session%count > 0) then
7961 ier = idba_voglioancora(session%sehandle, acount)
7962
7963 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(acount))
7964 do j =1,acount
7965 ier = idba_ancora(session%sehandle, btable)
7966 ier = idba_enq(session%sehandle, btable,value)
7967 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=dbadatac(btable,value))
7968 end do
7969 else
7970 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
7971 end if
7972 end if
7973 end if
7974
7975 if (c_e(session%count)) then
7976 session%count=session%count-1
7977
7978 if (session%count > 0 ) then
7979 ier = idba_dammelo(session%sehandle, btable)
7980 end if
7981 end if
7982 end if
7983!!$ SOLVED by https://github.com/ARPA-SIMC/dballe/issues/73
7984!!$ !reading from file get some variable not in filter so we can have some attrv%dcv not allocated
7985 do i=1,size(metaanddata%dataattrv%dataattr)
7986 if (.not.allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv)) then
7987 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
7988 endif
7989 end do
7990
7991end if
7992
7993end subroutine dbasession_ingest_metaanddata
7994
7995
7997subroutine dbasession_ingest_metaanddatav(session,metaanddatav,noattr,filter)
7998class(dbasession), intent(inout) :: session
7999type(dbametaanddata), intent(inout),allocatable :: metaanddatav(:)
8000logical, intent(in),optional :: noattr
8001type(dbafilter),intent(in),optional :: filter
8002
8003type(dbametaanddata),allocatable :: metaanddatavbuf(:)
8004integer :: i
8005
8006!todo aggiungere anche altrove dove passato filter
8007if (present(filter)) then
8008 call filter%dbaset(session)
8009else
8010 call session%unsetall()
8011endif
8012
8013call session%ingest()
8014!print*," count: ",session%count
8015
8016if (c_e(session%count)) then
8017 ! allocate to max dimension
8018 allocate(metaanddatavbuf(session%count))
8019 i=0
8020 do while (session%count >0)
8021 i=i+1
8022 call session%ingest(metaanddatavbuf(i),noattr=noattr,filter=filter)
8023 end do
8024
8025! compact data to real dimension
8026 IF (SIZE(metaanddatavbuf) == i) THEN
8027! space/time optimization in common case of no filter
8028 CALL move_alloc(metaanddatavbuf, metaanddatav)
8029 ELSE
8030! allocate (metaanddatav(i))
8031 metaanddatav=metaanddatavbuf(:i)
8032 DEALLOCATE(metaanddatavbuf)
8033 ENDIF
8034
8035else
8036 if (allocated(metaanddatav)) deallocate(metaanddatav)
8037 allocate(metaanddatav(0))
8038end if
8039
8040
8041end subroutine dbasession_ingest_metaanddatav
8042
8043
8045subroutine dbasession_ingest_metaanddatal(session,metaanddatal,noattr,filter)
8046class(dbasession), intent(inout) :: session
8047type(dbametaanddatalist), intent(out) :: metaanddatal
8048logical, intent(in),optional :: noattr
8049type(dbafilter),intent(in),optional :: filter
8050
8051type(dbametaanddata),allocatable :: metaanddatavbuf(:)
8052integer :: i
8053
8054if (session%memdb .and. .not. session%loadfile)then
8055
8056 do while (session%messages_read_next())
8057 call session%set(filter=filter)
8058 call session%ingest()
8059 call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
8060 do i=1,size(metaanddatavbuf)
8061 call metaanddatal%append(metaanddatavbuf(i))
8062 end do
8063
8064 call session%remove_all()
8065 deallocate (metaanddatavbuf)
8066 end do
8067
8068else
8069
8070 call session%ingest()
8071
8072 do while (c_e(session%count) .and. session%count >0)
8073 call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
8074 do i=1,size(metaanddatavbuf)
8075 if (present(filter)) then
8076 ! exclude contextana data from file
8077 if (filter%contextana) then
8078 if (datetime_new() /= metaanddatavbuf(i)%metadata%datetime%datetime) cycle
8079 end if
8080 end if
8081 call metaanddatal%append(metaanddatavbuf(i))
8082 end do
8083 if (session%file) call session%ingest()
8084 deallocate (metaanddatavbuf)
8085 end do
8086end if
8087
8088end subroutine dbasession_ingest_metaanddatal
8089
8091subroutine dbasession_ingest_metaanddatai(session,metaanddata)
8092class(dbasession), intent(inout) :: session
8093type(dbametaanddatai), intent(inout),optional :: metaanddata
8094
8095integer :: ier
8096character(len=9) :: btable
8097integer :: value
8098
8099if (.not. present(metaanddata)) then
8100 ier = idba_voglioquesto(session%sehandle, session%count)
8101else
8102 ier = idba_dammelo(session%sehandle, btable)
8103 ier = idba_enq(session%sehandle, btable,value)
8104 metaanddata%dbadatai=dbadatai(btable,value)
8105 call metaanddata%metadata%dbaenq(session)
8106 session%count=session%count-1
8107end if
8108end subroutine dbasession_ingest_metaanddatai
8109
8110
8112subroutine dbasession_ingest_metaanddataiv(session,metaanddatav)
8113class(dbasession), intent(inout) :: session
8114type(dbametaanddatai), intent(inout),allocatable :: metaanddatav(:)
8115
8116integer :: i
8117
8118call session%ingest_metaanddatai()
8119if (c_e(session%count)) then
8120 allocate(metaanddatav(session%count))
8121 i=0
8122 do while (session%count >0)
8123 i=i+1
8124 call session%ingest_metaanddatai(metaanddatav(i))
8125 end do
8126else
8127 allocate(metaanddatav(0))
8128end if
8129
8130end subroutine dbasession_ingest_metaanddataiv
8131
8132
8134subroutine dbasession_ingest_metaanddatab(session,metaanddata)
8135class(dbasession), intent(inout) :: session
8136type(dbametaanddatab), intent(inout),optional :: metaanddata
8137
8138integer :: ier
8139character(len=9) :: btable
8140integer(kind=int_b) :: value
8141
8142if (.not. present(metaanddata)) then
8143 ier = idba_voglioquesto(session%sehandle, session%count)
8144else
8145 ier = idba_dammelo(session%sehandle, btable)
8146 ier = idba_enq(session%sehandle, btable,value)
8147 metaanddata%dbadatab=dbadatab(btable,value)
8148 call metaanddata%metadata%dbaenq(session)
8149 session%count=session%count-1
8150end if
8151end subroutine dbasession_ingest_metaanddatab
8152
8153
8155subroutine dbasession_ingest_metaanddatabv(session,metaanddatav)
8156class(dbasession), intent(inout) :: session
8157type(dbametaanddatab), intent(inout),allocatable :: metaanddatav(:)
8158
8159integer :: i
8160
8161call session%ingest_metaanddatab()
8162if (c_e(session%count)) then
8163 allocate(metaanddatav(session%count))
8164 i=0
8165 do while (session%count >0)
8166 i=i+1
8167 call session%ingest_metaanddatab(metaanddatav(i))
8168 end do
8169else
8170 allocate(metaanddatav(0))
8171end if
8172
8173end subroutine dbasession_ingest_metaanddatabv
8174
8175
8177subroutine dbasession_ingest_metaanddatad(session,metaanddata)
8178class(dbasession), intent(inout) :: session
8179type(dbametaanddatad), intent(inout),optional :: metaanddata
8180
8181integer :: ier
8182character(len=9) :: btable
8183doubleprecision :: value
8184
8185if (.not. present(metaanddata)) then
8186 ier = idba_voglioquesto(session%sehandle, session%count)
8187else
8188 ier = idba_dammelo(session%sehandle, btable)
8189 ier = idba_enq(session%sehandle, btable,value)
8190 metaanddata%dbadatad=dbadatad(btable,value)
8191 call metaanddata%metadata%dbaenq(session)
8192 session%count=session%count-1
8193end if
8194end subroutine dbasession_ingest_metaanddatad
8195
8196
8198subroutine dbasession_ingest_metaanddatadv(session,metaanddatav)
8199class(dbasession), intent(inout) :: session
8200type(dbametaanddatad), intent(inout),allocatable :: metaanddatav(:)
8201
8202integer :: i
8203
8204call session%ingest_metaanddatad()
8205if (c_e(session%count)) then
8206 allocate(metaanddatav(session%count))
8207 i=0
8208 do while (session%count >0)
8209 i=i+1
8210 call session%ingest_metaanddatad(metaanddatav(i))
8211 end do
8212else
8213 allocate(metaanddatav(0))
8214end if
8215end subroutine dbasession_ingest_metaanddatadv
8216
8217
8219subroutine dbasession_ingest_metaanddatar(session,metaanddata)
8220class(dbasession), intent(inout) :: session
8221type(dbametaanddatar), intent(inout),optional :: metaanddata
8222
8223integer :: ier
8224character(len=9) :: btable
8225real :: value
8226
8227if (.not. present(metaanddata)) then
8228 ier = idba_voglioquesto(session%sehandle, session%count)
8229else
8230 ier = idba_dammelo(session%sehandle, btable)
8231 ier = idba_enq(session%sehandle, btable,value)
8232 metaanddata%dbadatar=dbadatar(btable,value)
8233 call metaanddata%metadata%dbaenq(session)
8234 session%count=session%count-1
8235end if
8236end subroutine dbasession_ingest_metaanddatar
8237
8238
8240subroutine dbasession_ingest_metaanddatarv(session,metaanddatav)
8241class(dbasession), intent(inout) :: session
8242type(dbametaanddatar), intent(inout),allocatable :: metaanddatav(:)
8243
8244integer :: i
8245
8246call session%ingest_metaanddatar()
8247if (c_e(session%count)) then
8248 allocate(metaanddatav(session%count))
8249 i=0
8250 do while (session%count >0)
8251 i=i+1
8252 call session%ingest_metaanddatar(metaanddatav(i))
8253 end do
8254else
8255 allocate(metaanddatav(0))
8256end if
8257end subroutine dbasession_ingest_metaanddatarv
8258
8259
8260
8262subroutine dbasession_ingest_metaanddatac(session,metaanddata)
8263class(dbasession), intent(inout) :: session
8264type(dbametaanddatac), intent(inout),optional :: metaanddata
8265
8266integer :: ier
8267character(len=9) :: btable
8268character(len=255) :: value
8269
8270if (.not. present(metaanddata)) then
8271 ier = idba_voglioquesto(session%sehandle, session%count)
8272else
8273 ier = idba_dammelo(session%sehandle, btable)
8274 ier = idba_enq(session%sehandle, btable,value)
8275 metaanddata%dbadatac=dbadatac(btable,value)
8276 call metaanddata%metadata%dbaenq(session)
8277 session%count=session%count-1
8278end if
8279end subroutine dbasession_ingest_metaanddatac
8280
8281
8283subroutine dbasession_ingest_metaanddatacv(session,metaanddatav)
8284class(dbasession), intent(inout) :: session
8285type(dbametaanddatac), intent(inout),allocatable :: metaanddatav(:)
8286
8287integer :: i
8288
8289call session%ingest_metaanddatac()
8290if (c_e(session%count)) then
8291 allocate(metaanddatav(session%count))
8292 i=0
8293 do while (session%count >0)
8294 i=i+1
8295 call session%ingest_metaanddatac(metaanddatav(i))
8296 end do
8297else
8298 allocate(metaanddatav(session%count))
8299end if
8300end subroutine dbasession_ingest_metaanddatacv
8301
8304type(dbaconnection) function dbaconnection_init(dsn, user, password,categoryappend,idbhandle)
8305character (len=*), intent(in), optional :: dsn
8306character (len=*), intent(in), optional :: user
8307character (len=*), intent(in), optional :: password
8308character(len=*),INTENT(in),OPTIONAL :: categoryappend
8309integer,INTENT(in),OPTIONAL :: idbhandle
8310
8311integer :: ier
8312character(len=512) :: a_name,quidsn
8313
8314if (present(categoryappend))then
8315 call l4f_launcher(a_name,a_name_append=trim(subcategory)//"."//trim(categoryappend))
8316else
8317 call l4f_launcher(a_name,a_name_append=trim(subcategory))
8318endif
8319dbaconnection_init%category=l4f_category_get(a_name)
8320
8321! impostiamo la gestione dell'errore
8322ier=idba_error_set_callback(0,c_funloc(dballe_error_handler), &
8323 dbaconnection_init%category,dbaconnection_init%handle_err)
8324if (.not. c_e(optio_i(idbhandle))) then
8325
8326 quidsn = "test"
8327 IF (PRESENT(dsn)) THEN
8328 IF (c_e(dsn)) quidsn = dsn
8329 ENDIF
8330
8331 ier=idba_presentati(dbaconnection_init%dbhandle,quidsn)
8332else
8333 dbaconnection_init%dbhandle=optio_i(idbhandle)
8334end if
8335
8336end function dbaconnection_init
8337
8339subroutine dbaconnection_delete(handle)
8340#ifdef F2003_FULL_FEATURES
8341type (dbaconnection), intent(inout) :: handle
8342#else
8343class(dbaconnection), intent(inout) :: handle
8344#endif
8345
8346integer :: ier
8347
8348if (c_e(handle%dbhandle)) then
8349 ier = idba_arrivederci(handle%dbhandle)
8350 ier = idba_error_remove_callback(handle%handle_err)
8351end if
8352
8353end subroutine dbaconnection_delete
8354
8357recursive type(dbasession) function dbasession_init(connection,anaflag, dataflag, attrflag,&
8358 filename,mode,format,template,write,wipe,repinfo,simplified,memdb,loadfile,categoryappend)
8359type(dbaconnection),intent(in),optional :: connection
8360character (len=*), intent(in), optional :: anaflag
8361character (len=*), intent(in), optional :: dataflag
8362character (len=*), intent(in), optional :: attrflag
8363character (len=*), intent(in), optional :: filename
8364character (len=*), intent(in), optional :: mode
8365character (len=*), intent(in), optional :: template
8366logical,INTENT(in),OPTIONAL :: write
8367logical,INTENT(in),OPTIONAL :: wipe
8368character(len=*), INTENT(in),OPTIONAL :: repinfo
8369character(len=*),intent(in),optional :: format
8370logical,intent(in),optional :: simplified
8371logical,intent(in),optional :: memdb
8372logical,intent(in),optional :: loadfile
8373character(len=*),INTENT(in),OPTIONAL :: categoryappend
8374
8375integer :: ier
8376character (len=5) :: lanaflag,ldataflag,lattrflag
8377character (len=1) :: lmode
8378logical :: lwrite,lwipe
8379character(len=255) :: lrepinfo
8380character(len=40) :: lformat
8381logical :: exist,lsimplified,read_next,lfile,lmemdb,lloadfile
8382character(len=512) :: a_name
8383character(len=40) :: ltemplate
8384
8385! those are assigned by the default constructor?
8386!!$dbasession_init%sehandle=imiss
8387!!$dbasession_init%file=.false.
8388!!$dbasession_init%template=cmiss
8389!!$dbasession_init%count=imiss
8390
8391if (present(categoryappend))then
8392 call l4f_launcher(a_name,a_name_append=trim(subcategory)//"."//trim(categoryappend))
8393else
8394 call l4f_launcher(a_name,a_name_append=trim(subcategory))
8395endif
8396dbasession_init%category=l4f_category_get(a_name)
8397
8398
8399lwrite=.false.
8400if (present(write))then
8401 lwrite=write
8402endif
8403
8404lwipe=.false.
8405lrepinfo=""
8406if (present(wipe))then
8407 lwipe=wipe
8408 if (present(repinfo))then
8409 lrepinfo=repinfo
8410 endif
8411endif
8412
8413lmemdb=.false.
8414lloadfile=.false.
8415lfile=.false.
8416
8417if (present(template))then
8418 ltemplate=template
8419else
8420 ltemplate=cmiss
8421endif
8422
8423lsimplified=.true.
8424if (present(simplified))then
8425 lsimplified=simplified
8426end if
8427
8428lformat="BUFR"
8429if (present(format))then
8430 lformat=format
8431end if
8432
8433lmode="r"
8434
8435if (present(filename)) then
8436
8437 lfile=.true.
8438
8439 IF (filename == '') THEN
8440! if stdio do not check existence, stdin always exist, stdout never exist
8441 exist = .NOT.lwrite
8442 ELSE
8443 INQUIRE(file=filename,exist=exist)
8444 ENDIF
8445
8446 if (lwrite)then
8447 if (lwipe.or..not.exist) then
8448 lmode="w"
8449 else
8450 lmode="a"
8451 call l4f_category_log(dbasession_init%category,l4f_info,"file exists; appending data to file")
8452 end if
8453 else
8454 if (.not.exist) then
8455 call l4f_category_log(dbasession_init%category,l4f_error,"file does not exist; cannot open file for read")
8456 CALL raise_fatal_error()
8457 end if
8458 end if
8459
8460 if (present(mode)) lmode = mode
8461
8462 if (.not.present(memdb))then
8463 dbasession_init%memdb=.true. ! default with filename
8464 end if
8465
8466 if (.not.present(loadfile))then
8467 dbasession_init%loadfile=.true. ! default with filename
8468 end if
8469
8470end if
8471
8472if (present(memdb))then
8473 lmemdb=memdb
8474end if
8475
8476if (present(loadfile))then
8477 lloadfile=loadfile
8478end if
8479
8480
8481call optio(anaflag,lanaflag)
8482if (.not. c_e(lanaflag))then
8483 if (lwrite) then
8484 lanaflag = "write"
8485 else
8486 lanaflag = "read"
8487 end if
8488end if
8489
8490call optio(dataflag,ldataflag)
8491if (.not. c_e(ldataflag)) then
8492 if (lwrite) then
8493 ldataflag = "write"
8494 else
8495 ldataflag = "read"
8496 end if
8497end if
8498
8499call optio(attrflag,lattrflag)
8500if (.not. c_e(lattrflag))then
8501 if (lwrite) then
8502 lattrflag = "write"
8503 else
8504 lattrflag = "read"
8505 end if
8506end if
8507
8508
8509!!$print*,"---------------- call session_init --------------------------------"
8510!!$print *,"session_init,lformat,ltemplate,lmemdb,lfile,lloadfile,lanaflag,ldataflag,lattrflag"
8511!!$print *,"session_init",lformat,ltemplate,lmemdb,lfile,lloadfile,lanaflag,ldataflag,lattrflag
8512!!$print*,"------------------------------------------------"
8513
8514if (lfile) then
8515
8516 if (present(anaflag).or.present(dataflag).or.present( attrflag)) then
8517 call l4f_category_log(dbasession_init%category,l4f_error,"option anaflag, dataflag, attrflag defined with filename access")
8518 CALL raise_error()
8519 end if
8520
8521else
8522
8523 if(.not. present(connection)) then
8524 call l4f_category_log(dbasession_init%category,l4f_error,"connection not present accessing DBA")
8525 CALL raise_error()
8526 end if
8527
8528 if (present(mode).or.present(format).or.present(template).or.present(simplified)) then
8529 call l4f_category_log(dbasession_init%category,l4f_error,&
8530 "option mode or format or template or simplified defined without filename")
8531 CALL raise_error()
8532 end if
8533
8534end if
8535
8536
8537! check filename for recursive call
8538if (present(filename))then
8539 if (lmemdb)then
8540 if (.not. present(connection)) then
8541 ! connect to dsn type DBA
8542 dbasession_init%memconnection=dbaconnection(dsn="mem:")
8543 !call self with memconnection without filename
8544 dbasession_init=dbasession(dbasession_init%memconnection,&
8545 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
8546 memdb=lmemdb,loadfile=lloadfile) ! without categoryappend
8547
8548 else
8549 dbasession_init%memconnection=connection
8550 !call self with memconnection without filename
8551 dbasession_init=dbasession(dbasession_init%memconnection,&
8552 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
8553 memdb=lmemdb,loadfile=lloadfile) ! without categoryappend
8554
8555 end if
8556
8557 if (lmode == "r") then
8558 call dbasession_init%messages_open_input(filename=filename,mode=lmode,&
8559 format=lformat,simplified=lsimplified)
8560
8561 if (lloadfile)then
8562 read_next = dbasession_init%messages_read_next()
8563 do while (read_next)
8564 read_next = dbasession_init%messages_read_next()
8565 end do
8566 end if
8567 else
8568
8569 call dbasession_init%messages_open_output(filename=filename,&
8570 mode=lmode,format=lformat)
8571
8572 end if
8573
8574 else
8575
8576 ier = idba_messaggi(dbasession_init%sehandle,filename, lmode, lformat)
8577
8578 end if
8579
8580else
8581
8582 ier = idba_preparati(connection%dbhandle,dbasession_init%sehandle, lanaflag, ldataflag, lattrflag)
8583 if (lwipe)ier=idba_scopa(dbasession_init%sehandle,lrepinfo)
8584
8585end if
8586
8587dbasession_init%file=lfile
8588if (dbasession_init%file) dbasession_init%filename=filename
8589dbasession_init%mode=lmode
8590dbasession_init%format=lformat
8591dbasession_init%simplified=lsimplified
8592dbasession_init%memdb=lmemdb
8593dbasession_init%loadfile=lloadfile
8594dbasession_init%template=ltemplate
8595
8596!!$print*,"--------------- at end ---------------------------------"
8597!!$print *,'file',dbasession_init%file
8598!!$print *,'filename',trim(dbasession_init%filename)
8599!!$print *,'mode',dbasession_init%mode
8600!!$print *,'format',dbasession_init%format
8601!!$print *,'simplified',dbasession_init%simplified
8602!!$print *,'memdb',dbasession_init%memdb
8603!!$print *,'loadfile',dbasession_init%loadfile
8604!!$print *,'template',dbasession_init%template
8605!!$print*,"------------------------------------------------"
8606
8607end function dbasession_init
8608
8609
8611subroutine dbasession_unsetall(session)
8612class(dbasession), intent(in) :: session
8613integer :: ier
8614
8615if (c_e(session%sehandle)) then
8616 ier = idba_unsetall(session%sehandle)
8617end if
8618
8619end subroutine dbasession_unsetall
8620
8621
8623subroutine dbasession_remove_all(session)
8624class(dbasession), intent(in) :: session
8625integer :: ier
8626
8627if (c_e(session%sehandle)) then
8628 ier = idba_remove_all(session%sehandle)
8629end if
8630
8631end subroutine dbasession_remove_all
8632
8633
8635subroutine dbasession_prendilo(session)
8636class(dbasession), intent(in) :: session
8637integer :: ier
8638
8639if (c_e(session%sehandle)) then
8640 ier = idba_prendilo(session%sehandle)
8641end if
8642
8643end subroutine dbasession_prendilo
8644
8646subroutine dbasession_var_related(session,btable)
8647class(dbasession), intent(in) :: session
8648character(len=*),INTENT(IN) :: btable
8649integer :: ier
8650
8651if (c_e(session%sehandle)) then
8652 ier = idba_set(session%sehandle,"*var_related",btable)
8653end if
8654
8655end subroutine dbasession_var_related
8656
8658subroutine dbasession_setcontextana(session)
8659class(dbasession), intent(in) :: session
8660integer :: ier
8661
8662if (c_e(session%sehandle)) then
8663 ier = idba_setcontextana(session%sehandle)
8664end if
8665
8666end subroutine dbasession_setcontextana
8667
8669subroutine dbasession_dimenticami(session)
8670class(dbasession), intent(in) :: session
8671integer :: ier
8672
8673if (c_e(session%sehandle)) then
8674 ier = idba_dimenticami(session%sehandle)
8675end if
8676
8677end subroutine dbasession_dimenticami
8678
8680subroutine dbasession_critica(session)
8681class(dbasession), intent(in) :: session
8682integer :: ier
8683
8684if (c_e(session%sehandle)) then
8685 ier = idba_critica(session%sehandle)
8686end if
8687
8688end subroutine dbasession_critica
8689
8691subroutine dbasession_scusa(session)
8692class(dbasession), intent(in) :: session
8693integer :: ier
8694
8695if (c_e(session%sehandle)) then
8696 ier = idba_scusa(session%sehandle)
8697end if
8698
8699end subroutine dbasession_scusa
8700
8702subroutine dbasession_set(session,metadata,datav,data,datetime,ana,network,level,timerange,filter)
8703class(dbasession), intent(in) :: session
8704type (dbametadata),optional :: metadata
8705class(dbadcv),optional :: datav
8706class(dbadata),optional :: data
8707type (dbadatetime),optional :: datetime
8708type (dbaana),optional :: ana
8709type (dbanetwork),optional :: network
8710type (dbalevel),optional :: level
8711type (dbatimerange),optional :: timerange
8712type (dbafilter),optional :: filter
8713
8714if (present(metadata)) then
8715 call metadata%dbaset(session)
8716endif
8717
8718if (present(datetime)) then
8719 call datetime%dbaset(session)
8720endif
8721
8722if (present(ana)) then
8723 call ana%dbaset(session)
8724endif
8725
8726if (present(network)) then
8727 call network%dbaset(session)
8728endif
8729
8730if (present(level)) then
8731 call level%dbaset(session)
8732endif
8733
8734if (present(timerange)) then
8735 call timerange%dbaset(session)
8736endif
8737
8738if (present(datav)) then
8739 call datav%dbaset(session)
8740end if
8741
8742if (present(data)) then
8743 call data%dbaset(session)
8744end if
8745
8746if (present(filter)) then
8747 call filter%dbaset(session)
8748end if
8749
8750end subroutine dbasession_set
8751
8752
8753!!! Those are for reverse order call session%extrude(object)
8754
8755!!$!> put data on DSN
8756!!$subroutine dbasession_extrude_ana(session,ana)
8757!!$class(dbasession), intent(in) :: session
8758!!$class(dbaana) :: ana !< ana
8759!!$call ana%extrude(session)
8760!!$end subroutine dbasession_extrude_ana
8761!!$
8762!!$!> put data on DSN
8763!!$subroutine dbasession_extrude_dataattr(session,dataattr)
8764!!$class(dbasession), intent(in) :: session
8765!!$class(dbadataattr) :: dataattr !< dataattr
8766!!$call dataattr%extrude(session)
8767!!$end subroutine dbasession_extrude_dataattr
8768!!$
8769!!$!> put data on DSN
8770!!$subroutine dbasession_extrude_dataattrv(session,dataattrv,noattr,filter)
8771!!$class(dbasession), intent(in) :: session
8772!!$class(dbadataattrv) :: dataattrv !< array datatattr
8773!!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
8774!!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
8775!!$
8776!!$call dataattrv%extrude(session,noattr,filter)
8777!!$end subroutine dbasession_extrude_dataattrv
8778!!$
8779!!$!> put data on DSN
8780!!$subroutine dbasession_extrude_metaanddata(session,metaanddata,noattr,filter)
8781!!$class(dbasession), intent(in) :: session
8782!!$class(dbametaanddata) :: metaanddata !< metaanddata
8783!!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
8784!!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
8785!!$
8786!!$call metaanddata%extrude(session,noattr,filter)
8787!!$end subroutine dbasession_extrude_metaanddata
8788!!$
8789!!$!> put data on DSN
8790!!$subroutine dbasession_extrude_metaanddatai(session,metaanddatai)
8791!!$class(dbasession), intent(in) :: session
8792!!$class(dbametaanddatai) :: metaanddatai !< metaanddatai
8793!!$call metaanddatai%extrude(session)
8794!!$end subroutine dbasession_extrude_metaanddatai
8795!!$
8796!!$!> put data on DSN
8797!!$subroutine dbasession_extrude_metaanddatab(session,metaanddatab)
8798!!$class(dbasession), intent(in) :: session
8799!!$class(dbametaanddatab) :: metaanddatab !< metaanddatab
8800!!$call metaanddatab%extrude(session)
8801!!$end subroutine dbasession_extrude_metaanddatab
8802!!$
8803!!$!> put data on DSN
8804!!$subroutine dbasession_extrude_metaanddatad(session,metaanddatad)
8805!!$class(dbasession), intent(in) :: session
8806!!$class(dbametaanddatad) :: metaanddatad !< metaanddatad
8807!!$call metaanddatad%extrude(session)
8808!!$end subroutine dbasession_extrude_metaanddatad
8809!!$
8810!!$!> put data on DSN
8811!!$subroutine dbasession_extrude_metaanddatac(session,metaanddatac)
8812!!$class(dbasession), intent(in) :: session
8813!!$class(dbametaanddatac) :: metaanddatac !< metaanddatac
8814!!$call metaanddatac%extrude(session)
8815!!$end subroutine dbasession_extrude_metaanddatac
8816!!$
8817!!$!> put data on DSN
8818!!$subroutine dbasession_extrude_metaanddatar(session,metaanddatar)
8819!!$class(dbasession), intent(in) :: session
8820!!$class(dbametaanddatar) :: metaanddatar !< metaanddatar
8821!!$call metaanddatar%extrude(session)
8822!!$end subroutine dbasession_extrude_metaanddatar
8823!!$
8824!!$!> put data on DSN
8825!!$subroutine dbasession_extrude_metaanddatav(session, metaanddatav,noattr,filter)
8826!!$class(dbasession), intent(in) :: session
8827!!$class(dbametaanddatav) :: metaanddatav !< array metaanddata
8828!!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
8829!!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
8830!!$
8831!!$call metaanddatav%extrude(session,noattr,filter)
8832!!$end subroutine dbasession_extrude_metaanddatav
8833!!$
8834!!$subroutine dbasession_extrude_metaanddatal(session, metaanddatal,noattr,filter)
8835!!$class(dbasession), intent(in) :: session
8836!!$class (dbametaanddatalist) :: metaanddatal !< metaanddata list
8837!!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
8838!!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
8839!!$
8840!!$call metaanddatal%extrude(session,noattr,filter)
8841!!$end subroutine dbasession_extrude_metaanddatal
8842!!$
8843!!$!> put data on DSN
8844!!$subroutine dbasession_extrude(session,ana,dataattr,dataattrv,metaanddata,&
8845!!$ metaanddatai,metaanddatab,metaanddatad,metaanddatac,metaanddatar,&
8846!!$ metaanddatav ,metaanddatal,noattr,filter)
8847!!$class(dbasession), intent(in) :: session
8848!!$class(dbaana),optional :: ana !< ana
8849!!$class(dbadataattr),optional :: dataattr !< dataattr
8850!!$class(dbadataattrv),optional :: dataattrv !< array datatattr
8851!!$class(dbametaanddata),optional :: metaanddata !< metaanddata
8852!!$class(dbametaanddatai),optional :: metaanddatai !< metaanddatai
8853!!$class(dbametaanddatab),optional :: metaanddatab !< metaanddatab
8854!!$class(dbametaanddatad),optional :: metaanddatad !< metaanddatad
8855!!$class(dbametaanddatac),optional :: metaanddatac !< metaanddatac
8856!!$class(dbametaanddatar),optional :: metaanddatar !< metaanddatar
8857!!$class(dbametaanddatav),optional :: metaanddatav !< array metaanddata
8858!!$class(dbametaanddatalist),optional :: metaanddatal !< metaanddata list
8859!!$logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
8860!!$type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
8861!!$
8862!!$if (present(ana)) then
8863!!$ call ana%extrude(session)
8864!!$end if
8865!!$
8866!!$if (present(dataattr)) then
8867!!$ call dataattr%extrude(session)
8868!!$end if
8869!!$
8870!!$if (present(dataattrv)) then
8871!!$ call dataattrv%extrude(session,noattr,filter)
8872!!$end if
8873!!$
8874!!$if (present(metaanddata)) then
8875!!$ call metaanddata%extrude(session)
8876!!$end if
8877!!$
8878!!$if (present(metaanddatai)) then
8879!!$ call metaanddatai%extrude(session)
8880!!$end if
8881!!$
8882!!$if (present(metaanddatab)) then
8883!!$ call metaanddatab%extrude(session)
8884!!$end if
8885!!$
8886!!$if (present(metaanddatad)) then
8887!!$ call metaanddatad%extrude(session)
8888!!$end if
8889!!$
8890!!$if (present(metaanddatac)) then
8891!!$ call metaanddatac%extrude(session)
8892!!$end if
8893!!$
8894!!$if (present(metaanddatar)) then
8895!!$ call metaanddatar%extrude(session)
8896!!$end if
8897!!$
8898!!$if (present(metaanddatav)) then
8899!!$ call metaanddatav%extrude(session,noattr,filter)
8900!!$end if
8901!!$
8902!!$if (present(metaanddatal)) then
8903!!$ call metaanddatal%extrude(session,noattr,filter)
8904!!$end if
8905!!$
8906!!$end subroutine dbasession_extrude
8907
8908# ifndef F2003_FULL_FEATURES
8909
8910subroutine dbasession_delete(session)
8911class(dbasession), intent(inout) :: session
8912integer :: ier
8913type(dbasession) :: defsession
8914
8915if (c_e(session%sehandle)) then
8916 ier = idba_fatto(session%sehandle)
8917end if
8918
8919call session%memconnection%delete()
8920
8921select type (session)
8922type is (dbasession)
8923 session = defsession
8924end select
8925
8926!!$session%sehandle=imiss
8927!!$session%file=.false.
8928!!$session%template=cmiss
8929!!$session%filename=cmiss
8930!!$session%mode=cmiss
8931!!$session%format=cmiss
8932!!$session%simplified=.true.
8933!!$session%memdb=.false.
8934!!$session%category=imiss
8935!!$session%count=imiss
8936
8937end subroutine dbasession_delete
8938
8939#else
8940
8942subroutine dbasession_delete(session)
8943type (dbasession), intent(inout) :: session
8944integer :: ier
8945
8946if (c_e(session%sehandle)) then
8947 ier = idba_fatto(session%sehandle)
8948end if
8949
8950!!$session%sehandle=imiss
8951!!$session%file=.false.
8952!!$session%template=cmiss
8953!!$session%filename=cmiss
8954!!$session%mode=cmiss
8955!!$session%format=cmiss
8956!!$session%simplified=.true.
8957!!$session%memdb=.false.
8958!!$session%category=imiss
8959!!$session%count=imiss
8960
8961end subroutine dbasession_delete
8962
8963#endif
8964
8965
8966
8968subroutine dbasession_filerewind(session)
8969class(dbasession), intent(inout) :: session
8970integer :: ier
8971
8972if (c_e(session%sehandle).and. session%file) then
8973 ier = idba_fatto(session%sehandle)
8974 ier = idba_messaggi(session%sehandle,session%filename,session%mode,session%format)
8975
8976!!$! example: here we call constructor after a cast to reassign self (can you pass self attributes to constructor?)
8977!!$ select type(session)
8978!!$ type is (dbasession)
8979!!$ session=dbasession(filename=session%filename,mode=session%mode,format=session%format)
8980!!$ end select
8981
8982end if
8983
8984end subroutine dbasession_filerewind
8985
8986
8987FUNCTION dballe_error_handler(category)
8988INTEGER :: category, code, l4f_level
8989INTEGER :: dballe_error_handler
8990
8991CHARACTER(len=1000) :: message, buf
8992
8993code = idba_error_code()
8994
8995! check if "Value outside acceptable domain"
8996if (code == 13 ) then
8997 l4f_level=l4f_warn
8998else
8999 l4f_level=l4f_error
9000end if
9001
9002call idba_error_message(message)
9003call l4f_category_log(category,l4f_level,trim(message))
9004
9005call idba_error_context(buf)
9006
9007call l4f_category_log(category,l4f_level,trim(buf))
9008
9009call idba_error_details(buf)
9010call l4f_category_log(category,l4f_info,trim(buf))
9011
9012
9013! if "Value outside acceptable domain" do not raise error
9014if (l4f_level == l4f_error ) CALL raise_fatal_error("dballe: "//message)
9015
9016dballe_error_handler = 0
9017return
9018
9019END FUNCTION dballe_error_handler
9020
9021end MODULE dballe_class
9022
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.
Gestione degli errori.
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)
byte version for dbadata
character version for dbadata
doubleprecision version for dbadata
integer version for dbadata
real version for dbadata
container for dbadata (used for promiscuous vector of data)
vector of container of dbadata
filter to apply before ingest data
one metadata with more data plus attributes
metadata and byte data
metadata and byte data double linked list
metadata and character data
metadata and character data double linked list
metadata and doubleprecision data
metadata and diubleprecision data double linked list
metadata and integer data
metadata and integer data double linked list
double linked list of dbametaanddata
metadata and real data
metadata and real data double linked list
one metadata plus vector of container of dbadata
summ of all metadata pieces
manage session handle
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.

Generated with Doxygen.