libsim Versione 7.2.6

◆ 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
4570!> \brief class for import and export data from e to DB-All.e.
4571!! This module define objects and methods to manage
4572!! import and export of data from database for sparse data DB-All.e
4573!!
4574!! The main usefull structure is this:
4575!!\verbatim
4576!! %timerange
4577!! %ana
4578!! %network
4579!! %datetime
4580!! metaanddata%metadata%level
4581!! %dataattrv%dataattr(*)%dat
4582!! %attrv%dcv(*)%dat
4583!!
4584!!\endverbatim
4585!! You can use a vector of this structure to archive a full dataset in memory.
4586!!
4587!! The program example is the better starting point:
4588!!\include example_dballe.F03
4589!!
4590!!\ingroup vol7d
4591!!
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
4613!> manage connection handle to a DSN
4614type,public :: dbaconnection
4615 integer :: dbhandle=imiss !< dballe DB handle
4616 integer :: handle_err=imiss !< dballe error handler
4617 integer :: category=0 !< log4fortran
4618 contains
4619# ifdef F2003_FULL_FEATURES
4620 final :: dbaconnection_delete
4621# else
4622 procedure :: delete => dbaconnection_delete !< todo
4623# endif
4624end type dbaconnection
4625
4626!> User-defined constructors => dballe_class::dbaconnection_init
4627interface dbaconnection
4628 procedure dbaconnection_init !< add constructor to shape generic interface
4629end interface
4630
4631!> manage session handle
4632type,public :: dbasession
4633 integer :: sehandle=imiss !< session handler
4634 logical :: file=.false. !< is it a file?
4635 character(len=40) :: template='generic' !< template for BUFR format
4636 character(len=255) :: filename=cmiss !< filename
4637 character(len=40) :: mode=cmiss !< mode for open file
4638 character(len=40) :: format=cmiss !< format (bufr/crex)
4639 logical :: simplified=.true. !< how to interpret input data
4640 logical :: memdb=.false. !< use memdb
4641 logical :: loadfile=.false. !< load data in file into memdb
4642 type(dbaconnection) :: memconnection !< connection for memdb
4643 integer :: category=0 !< log4fortran category
4644 integer :: count=imiss !< number of results left to query
4645 contains
4646# ifdef F2003_FULL_FEATURES
4647 final :: dbasession_delete
4648# else
4649 procedure :: delete => dbasession_delete !< todo
4650# endif
4651 procedure :: unsetall => dbasession_unsetall !< dballe unsetall
4652 procedure :: remove_all => dbasession_remove_all !< dballe remove_all
4653 procedure :: set => dbasession_set !< set dballe parameters
4654 procedure :: setcontextana => dbasession_setcontextana !< set dballe station data context
4655 procedure :: dimenticami => dbasession_dimenticami !< dballe dimenticami
4656!!$ procedure :: extrude_dbasession => dbasession_extrude !< put data on DSN
4657!!$ procedure :: extrude_ana => dbasession_extrude_ana !< put data on DSN
4658!!$ procedure :: extrude_dataattr => dbasession_extrude_dataattr !< put data on DSN
4659!!$ procedure :: extrude_dataattrv => dbasession_extrude_dataattrv !< put data on DSN
4660!!$ procedure :: extrude_metaanddata => dbasession_extrude_metaanddata !< put data on DSN
4661!!$ procedure :: extrude_metaanddatai => dbasession_extrude_metaanddatai !< put data on DSN
4662!!$ procedure :: extrude_metaanddatar => dbasession_extrude_metaanddatar !< put data on DSN
4663!!$ procedure :: extrude_metaanddatad => dbasession_extrude_metaanddatad !< put data on DSN
4664!!$ procedure :: extrude_metaanddatab => dbasession_extrude_metaanddatab !< put data on DSN
4665!!$ procedure :: extrude_metaanddatac => dbasession_extrude_metaanddatac !< put data on DSN
4666!!$ procedure :: extrude_metaanddatav => dbasession_extrude_metaanddatav !< put data on DSN
4667!!$ procedure :: extrude_metaanddatal => dbasession_extrude_metaanddatal !< put data on DSN
4668 procedure :: prendilo => dbasession_prendilo !< dballe prendilo
4669 procedure :: var_related => dbasession_var_related !< dballe var_related
4670 procedure :: critica => dbasession_critica !< dballe critica
4671 procedure :: scusa => dbasession_scusa !< dballe scusa
4672 procedure :: messages_open_input => dbasession_messages_open_input !< dballe messages_open_input
4673 procedure :: messages_open_output => dbasession_messages_open_output !< dballe messages_open_output
4674 procedure :: messages_read_next => dbasession_messages_read_next !< dballe messages_read_next
4675 procedure :: messages_write_next => dbasession_messages_write_next !< dballe messages_write_next
4676 procedure :: close_message => dbasession_close_message !< dballe close_message
4677 procedure :: unsetb => dbasession_unsetb !< dballe unsetb
4678 procedure :: filerewind => dbasession_filerewind !< rewind file associates with this session
4679 procedure :: ingest_ana => dbasession_ingest_ana !< get station metadata from DSN
4680 procedure :: ingest_anav => dbasession_ingest_anav !< get station metadata from DSN
4681 procedure :: ingest_anal => dbasession_ingest_anal !< get station metadata from DSN
4682 procedure :: ingest_metaanddata => dbasession_ingest_metaanddata !< get data from DSN
4683 procedure :: ingest_metaanddatal => dbasession_ingest_metaanddatal !< get data from DSN
4684 procedure :: ingest_metaanddatav => dbasession_ingest_metaanddatav !< get data from DSN
4685 procedure :: ingest_metaanddatai => dbasession_ingest_metaanddatai !< get data from DSN
4686 procedure :: ingest_metaanddataiv => dbasession_ingest_metaanddataiv !< get data from DSN
4687 procedure :: ingest_metaanddatail => dbasession_ingest_metaanddatail !< get data from DSN
4688 procedure :: ingest_metaanddatab => dbasession_ingest_metaanddatab !< get data from DSN
4689 procedure :: ingest_metaanddatabv => dbasession_ingest_metaanddatabv !< get data from DSN
4690 procedure :: ingest_metaanddatabl => dbasession_ingest_metaanddatabl !< get data from DSN
4691 procedure :: ingest_metaanddatad => dbasession_ingest_metaanddatad !< get data from DSN
4692 procedure :: ingest_metaanddatadv => dbasession_ingest_metaanddatadv !< get data from DSN
4693 procedure :: ingest_metaanddatadl => dbasession_ingest_metaanddatadl !< get data from DSN
4694 procedure :: ingest_metaanddatar => dbasession_ingest_metaanddatar !< get data from DSN
4695 procedure :: ingest_metaanddatarv => dbasession_ingest_metaanddatarv !< get data from DSN
4696 procedure :: ingest_metaanddatarl => dbasession_ingest_metaanddatarl !< get data from DSN
4697 procedure :: ingest_metaanddatac => dbasession_ingest_metaanddatac !< get data from DSN
4698 procedure :: ingest_metaanddatacv => dbasession_ingest_metaanddatacv !< get data from DSN
4699 procedure :: ingest_metaanddatacl => dbasession_ingest_metaanddatacl !< get data from DSN
4700 procedure :: dissolve_metadata => dbasession_dissolve_metadata !< remove data from DSN
4701 procedure :: dissolveattr => dbasession_dissolveattr_metadata !< remove attributes from DSN
4702 generic :: dissolve => dissolve_metadata ,dimenticami !< remove from DSN
4703 generic :: ingesta => ingest_ana, ingest_anav,ingest_anal !< get station metadata from DSN
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 !< get data from DSN
4708!!$ generic :: extrude => extrude_ana,extrude_dataattr,extrude_dataattrv,extrude_metaanddata,&
4709!!$ extrude_metaanddatai,extrude_metaanddatar,extrude_metaanddatad,extrude_metaanddatab,extrude_metaanddatac,&
4710!!$ extrude_metaanddatav,extrude_metaanddatal
4711end type dbasession
4712
4713!> User-defined constructors => dballe_class::dbasession_init
4714interface dbasession
4715 procedure dbasession_init !< add constructor to shape generic interface
4716end interface
4717
4718!> level metadata
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 !< print a summary of object contents
4728 procedure :: dbaset => dbalevel_set !< set dballe parameters
4729 procedure :: dbaenq => dbalevel_enq !< query dballe parameters
4730 procedure,nopass :: dbacontextana => dbalevel_contextana !< set dballe station data context for level (in object, not dballe session)
4731!!$procedure :: spiega => dbalevel_spiega
4732end type dbalevel
4733
4734!> User-defined constructors => dballe_class::dbalevel_init
4735interface dbalevel
4736 procedure dbalevel_init !< add constructor to shape generic interface
4737end interface
4738
4739!> timerange metadata
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 !< print a summary of object contents
4748 procedure :: dbaset => dbatimerange_set !< set dballe parameters
4749 procedure :: dbaenq => dbatimerange_enq !< query dballe parameters
4750 procedure,nopass :: dbacontextana => dbatimerange_contextana !< set dballe station data context for timerange (in object, not dballe session)
4751!!$procedure :: spiega => dbatimerange_spiega
4752end type dbatimerange
4753
4754!> User-defined constructors => dballe_class::dbatimerange_init
4755interface dbatimerange
4756 procedure dbatimerange_init !< add constructor to shape generic interface
4757end interface
4758
4759!> fortran 2003 interface to geo_coord
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 !< print a summary of object contents
4774
4775end type dbacoord
4776
4777!> User-defined constructors => dballe_class::dbacoord_init
4778interface dbacoord
4779 procedure dbacoord_init !< add constructor to shape generic interface
4780end interface
4781
4782!> ana metadata
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 !< print a summary of object contents
4792 procedure :: dbaset => dbaana_set !< set dballe parameters
4793 procedure :: dbaenq => dbaana_enq !< query dballe parameters
4794 procedure :: extrude => dbaana_extrude !< put data on DSN
4795end type dbaana
4796
4797!> User-defined constructors => dballe_class::dbaana_init
4798interface dbaana
4799 procedure dbaana_init !< add constructor to shape generic interface
4800end interface
4801
4802!> double linked list of ana
4803type, public, extends(list) :: dbaanalist
4804 contains
4805 procedure :: current => currentdbaana !< get dbaana pointed by iterator
4806 procedure :: display => displaydbaana !< print a summary of object contents
4807end type dbaanalist
4808
4809!> network metadata
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 !< print a summary of object contents
4825 procedure :: dbaset => dbanetwork_set !< set dballe parameters
4826 procedure :: dbaenq => dbanetwork_enq !< query dballe parameters
4827
4828end type dbanetwork
4829
4830!> User-defined constructors => dballe_class::dbanetwork_init
4831interface dbanetwork
4832 procedure dbanetwork_init !< add constructor to shape generic interface
4833end interface
4834
4835
4836!> datetime metadata
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 !< print a summary of object contents
4846 procedure :: dbaset => dbadatetime_set !< set dballe parameters
4847 procedure :: dbaenq => dbadatetime_enq !< query dballe parameters
4848 procedure,nopass :: dbacontextana => dbadatetime_contextana !< set dballe station data context for date and time (in object, not dballe session)
4849end type dbadatetime
4850
4851!> User-defined constructors => dballe_class::dbadatetime_init
4852interface dbadatetime
4853 procedure dbadatetime_init !< add constructor to shape generic interface
4854end interface
4855
4856
4857!> base (abstract) type for data
4858type,public,abstract :: dbadata
4859 character(len=9) :: btable
4860contains
4861 procedure(dbadata_set),deferred :: dbaset !< set dballe parameters
4862 procedure :: dbadata_geti !< return integer value
4863 procedure :: dbadata_getr !< return real value
4864 procedure :: dbadata_getd !< return double precision value
4865 procedure :: dbadata_getb !< return byte value
4866 procedure :: dbadata_getc !< return character value
4867 generic :: get => dbadata_geti,dbadata_getr,dbadata_getd,dbadata_getb,dbadata_getc !< return value
4868 procedure :: dbadata_c_e_i !< test integer missing value
4869 procedure :: dbadata_c_e_r !< test real missing value
4870 procedure :: dbadata_c_e_d !< test double precision missing value
4871 procedure :: dbadata_c_e_b !< test byte missing value
4872 procedure :: dbadata_c_e_c !< test character missing value
4873 procedure :: c_e => dbadata_c_e !< test missing value
4874 procedure(dbadata_display),deferred :: display !< print a summary of object contents
4875 procedure :: equal => dbadata_equal !> compare two dbametadata
4876 generic :: operator (==) => equal !> == operator
4877end type dbadata
4878
4879!> set parameters in dballe API
4880abstract interface
4881subroutine dbadata_set(data,session)
4882import
4883class(dbadata), intent(in) :: data
4884type(dbasession), intent(in) :: session
4885end subroutine dbadata_set
4886
4887!> print a summary of object contents
4888subroutine dbadata_display(data)
4889import
4890class(dbadata), intent(in) :: data
4891end subroutine dbadata_display
4892
4893end interface
4894
4895!> integer version for dbadata
4896type,public, extends(dbadata) :: dbadatai
4897 integer :: value
4898contains
4899 procedure :: dbadata_geti => dbadatai_geti !< return integer value
4900 procedure :: dbaset => dbadatai_set !< set dballe parameters
4901 procedure :: display => dbadatai_display !< print a summary of object contents
4902end type dbadatai
4903
4904!> User-defined constructors => dballe_class::dbadatai_init
4905interface dbadatai
4906 procedure :: dbadatai_init !< add constructor to shape generic interface
4907end interface dbadatai
4908
4909!> real version for dbadata
4910type,public, extends(dbadata) :: dbadatar
4911 real :: value
4912contains
4913 procedure :: dbadata_getr => dbadatar_getr !< return real value
4914 procedure :: dbaset => dbadatar_set !< set dballe parameters
4915 procedure :: display => dbadatar_display !< print a summary of object contents
4916end type dbadatar
4917
4918!> User-defined constructors => dballe_class::dbadatar_init
4919interface dbadatar
4920 procedure :: dbadatar_init !< add constructor to shape generic interface
4921end interface dbadatar
4922
4923
4924!> doubleprecision version for dbadata
4925type,public, extends(dbadata) :: dbadatad
4926 doubleprecision :: value
4927contains
4928 procedure :: dbadata_getd => dbadatad_getd !< return double precision value
4929 procedure :: dbaset => dbadatad_set !< set dballe parameters
4930 procedure :: display => dbadatad_display !< print a summary of object contents
4931end type dbadatad
4932
4933!> User-defined constructors => dballe_class::dbadatad_init
4934interface dbadatad
4935 procedure :: dbadatad_init !< add constructor to shape generic interface
4936end interface dbadatad
4937
4938
4939!> byte version for dbadata
4940type,public, extends(dbadata) :: dbadatab
4941 integer(kind=int_b) :: value
4942contains
4943 procedure :: dbadata_getb => dbadatab_getb !< return byte value
4944 procedure :: dbaset => dbadatab_set !< set dballe parameters
4945 procedure :: display => dbadatab_display !< print a summary of object contents
4946end type dbadatab
4947
4948!> User-defined constructors => dballe_class::dbadatab_init
4949interface dbadatab
4950 procedure :: dbadatab_init !< add constructor to shape generic interface
4951end interface dbadatab
4952
4953
4954!> character version for dbadata
4955type,public, extends(dbadata) :: dbadatac
4956! character(:) :: value
4957! character(255) :: value
4958character(vol7d_cdatalen) :: value
4959
4960contains
4961 procedure :: dbadata_getc => dbadatac_getc !< return character value
4962 procedure :: dbaset => dbadatac_set !< set dballe parameters
4963 procedure :: display => dbadatac_display !< print a summary of object contents
4964end type dbadatac
4965
4966!> User-defined constructors => dballe_class::dbadatac_init
4967interface dbadatac
4968 procedure :: dbadatac_init !< add constructor to shape generic interface
4969end interface dbadatac
4970
4971!> summ of all metadata pieces
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 !< set dballe parameters
4985 procedure :: dbaenq => dbametadata_enq !< query dballe parameters
4986 procedure :: dbacontextana => dbametadata_contextana !< set dballe station data context for all metadata (in object, not dballe session)
4987 procedure :: display => dbametadata_display !< print a summary of object contents
4988 procedure :: equal => dbametadata_equal !> compare two dbametadata
4989 generic :: operator (==) => equal !> == operator
4990end type dbametadata
4991
4992!> User-defined constructors => dballe_class::dbametadata_init
4993interface dbametadata
4994 procedure dbametadata_init !< add constructor to shape generic interface
4995end interface
4996
4997!> container for dbadata (used for promiscuous vector of data)
4998type, public :: dbadc
4999 class(dbadata),allocatable :: dat
5000 contains
5001 procedure :: display => dbadc_display !< print a summary of object contents
5002 procedure :: dbaset => dbadc_set !< set dballe parameters
5003 procedure :: extrude => dbadc_extrude
5004end type dbadc
5005
5006
5007!> vector of container of dbadata
5008type, public :: dbadcv
5009 type(dbadc),allocatable :: dcv(:)
5010 contains
5011 procedure :: display => dbadcv_display !< print a summary of object contents
5012 procedure :: dbaset => dbadcv_set !< set dballe parameters
5013 procedure :: extrude => dbadcv_extrude
5014 procedure :: equal => dbadcv_equal_dbadata !> compare dbadcv and dbadata
5015 generic :: operator (==) => equal !> == operator
5016end type dbadcv
5017
5018!> extend one data container with a vector of data container (one data plus attributes)
5019type, public ,extends(dbadc):: dbadataattr
5020 type(dbadcv) :: attrv
5021 contains
5022 procedure :: display => dbadataattr_display !< print a summary of object contents
5023 procedure :: extrude => dbadataattr_extrude !< put data on DSN
5024end type dbadataattr
5025
5026!> vector of dbadataattr (more data plus attributes)
5027type, public :: dbadataattrv
5028 class(dbadataattr),allocatable :: dataattr(:)
5029 contains
5030 procedure :: display => dbadataattrv_display !< print a summary of object contents
5031 procedure :: extrude => dbadataattrv_extrude!< put data on DSN
5032end type dbadataattrv
5033
5034!> one metadata with more data plus attributes
5035type, public :: dbametaanddata
5036 type(dbametadata) :: metadata
5037 type(dbadataattrv) ::dataattrv
5038 contains
5039 procedure :: display => dbametaanddata_display !< print a summary of object contents
5040 procedure :: extrude => dbametaanddata_extrude!< put data on DSN
5041end type dbametaanddata
5042
5043!> one metadata plus vector of container of dbadata
5044type, public :: dbametaanddatav
5045 type(dbametadata) :: metadata
5046 type(dbadcv) ::datav
5047 contains
5048 procedure :: display => dbametaanddatav_display !< print a summary of object contents
5049 procedure :: extrude => dbametaanddatav_extrude!< put data on DSN
5050end type dbametaanddatav
5051
5052!> double linked list of dbametaanddata
5053type, public, extends(list) :: dbametaanddatalist
5054 contains
5055 procedure :: current => currentdbametaanddata !< get dbametaanddata pointed by iterator
5056 procedure :: display => displaydbametaanddata !< print a summary of object contents
5057 procedure :: extrude => dbametaanddatal_extrude !< put data on DSN
5058end type dbametaanddatalist
5059
5060!> metadata and integer data
5061type, public,extends(dbadatai) :: dbametaanddatai
5062 type(dbametadata) :: metadata
5063 contains
5064 procedure :: display => dbametaanddatai_display !< print a summary of object contents
5065 procedure :: extrude => dbametaanddatai_extrude!< put data on DSN
5066end type dbametaanddatai
5067
5068!> metadata and integer data double linked list
5069type, public, extends(list) :: dbametaanddatailist
5070 contains
5071 procedure :: current => currentdbametaanddatai !< get dbametaanddatai pointed by iterator
5072 procedure :: display => displaydbametaanddatai !< print a summary of object contents
5073 procedure :: toarray => toarray_dbametaanddatai !< return dbametaanddatai allocated array
5074end type dbametaanddatailist
5075
5076!> metadata and byte data
5077type, public,extends(dbadatab) :: dbametaanddatab
5078 type(dbametadata) :: metadata
5079 contains
5080 procedure :: display => dbametaanddatab_display !< print a summary of object contents
5081 procedure :: extrude => dbametaanddatab_extrude!< put data on DSN
5082end type dbametaanddatab
5083
5084!> metadata and byte data double linked list
5085type, public, extends(list) :: dbametaanddatablist
5086 contains
5087 procedure :: current => currentdbametaanddatab !< get dbametaanddatab pointed by iterator
5088 procedure :: display => displaydbametaanddatab !< print a summary of object contents
5089 procedure :: toarray => toarray_dbametaanddatab !< return dbametaanddatab allocated array
5090end type dbametaanddatablist
5091
5092!> metadata and doubleprecision data
5093type, public,extends(dbadatad) :: dbametaanddatad
5094 type(dbametadata) :: metadata
5095 contains
5096 procedure :: display => dbametaanddatad_display !< print a summary of object contents
5097 procedure :: extrude => dbametaanddatad_extrude!< put data on DSN
5098end type dbametaanddatad
5099
5100!> metadata and diubleprecision data double linked list
5101type, public, extends(list) :: dbametaanddatadlist
5102 contains
5103 procedure :: current => currentdbametaanddatad !< get dbametaanddatad pointed by iterator
5104 procedure :: display => displaydbametaanddatad !< print a summary of object contents
5105 procedure :: toarray => toarray_dbametaanddatad !< return dbametaanddatad allocated array
5106end type dbametaanddatadlist
5107
5108!> metadata and real data
5109type, public,extends(dbadatar) :: dbametaanddatar
5110 type(dbametadata) :: metadata
5111 contains
5112 procedure :: display => dbametaanddatar_display !< print a summary of object contents
5113 procedure :: extrude => dbametaanddatar_extrude!< put data on DSN
5114end type dbametaanddatar
5115
5116!> metadata and real data double linked list
5117type, public, extends(list) :: dbametaanddatarlist
5118 contains
5119 procedure :: current => currentdbametaanddatar !< get dbametaanddatar pointed by iterator
5120 procedure :: display => displaydbametaanddatar !< print a summary of object contents
5121 procedure :: toarray => toarray_dbametaanddatar !< return dbametaanddatar allocated array
5122end type dbametaanddatarlist
5123
5124!> metadata and character data
5125type, public,extends(dbadatac) :: dbametaanddatac
5126 type(dbametadata) :: metadata
5127 contains
5128 procedure :: display => dbametaanddatac_display !< print a summary of object contents
5129 procedure :: extrude => dbametaanddatac_extrude!< put data on DSN
5130end type dbametaanddatac
5131
5132!> metadata and character data double linked list
5133type, public, extends(list) :: dbametaanddataclist
5134 contains
5135 procedure :: current => currentdbametaanddatac !< get dbametaanddatac pointed by iterator
5136 procedure :: display => displaydbametaanddatac !< print a summary of object contents
5137 procedure :: toarray => toarray_dbametaanddatac !< return dbametaanddatac allocated array
5138end type dbametaanddataclist
5139
5140!> filter to apply before ingest data
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 !< print a summary of object contents
5162 procedure :: dbaset => dbafilter_set !< set dballe parameters
5163 procedure :: equalmetadata => dbafilter_equal_dbametadata !> compare filter with dbametadata
5164!!$ procedure :: equaldata => dbafilter_equal_dbadata !> compare filter with dbadata
5165!!$ generic :: operator (==) => equalmetadata,equaldata !> == operator
5166 generic :: operator (==) => equalmetadata !> == operator
5167end type dbafilter
5168
5169!> User-defined constructors => dballe_class::dbafilter_init
5170interface dbafilter
5171 procedure dbafilter_init !< add constructor to shape generic interface
5172end interface
5173
5174contains
5175
5176!> print a summary of object contents
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
5190!> Get dbametaanddata pointed by iterator
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
5203!> equal operator for dbadata
5204elemental logical function dbadata_equal(this,that)
5205
5206class(dbadata), intent(in) :: this !< first element
5207class(dbadata), intent(in) :: that !< second element
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
5218!> return integer value
5219subroutine dbadata_geti(data,value)
5220class(dbadata), intent(in) :: data !< data object to be decoded
5221integer, intent(out) :: value !< returned value
5222value=imiss
5223
5224select type(data)
5225type is (dbadatai)
5226 value = data%value
5227end select
5228
5229end subroutine dbadata_geti
5230
5231
5232!> test missing value
5233logical function dbadata_c_e_i(data)
5234class(dbadata), intent(in) :: data !< data object to be tested
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
5245!> return real value
5246subroutine dbadata_getr(data,value)
5247class(dbadata), intent(in) :: data !< data object to be decoded
5248real, intent(out) :: value !< returned value
5249value=rmiss
5250
5251select type(data)
5252type is (dbadatar)
5253 value = data%value
5254end select
5255
5256end subroutine dbadata_getr
5257
5258!> test missing value
5259logical function dbadata_c_e_r(data)
5260class(dbadata), intent(in) :: data !< data object to be tested
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
5271!> return double precision value
5272subroutine dbadata_getd(data,value)
5273class(dbadata), intent(in) :: data !< data object to be decoded
5274doubleprecision, intent(out) :: value !< returned value
5275value=dmiss
5276
5277select type(data)
5278type is (dbadatad)
5279 value = data%value
5280end select
5281
5282end subroutine dbadata_getd
5283
5284!> test missing value
5285logical function dbadata_c_e_d(data)
5286class(dbadata), intent(in) :: data !< data object to be tested
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
5298!> return byte value
5299subroutine dbadata_getb(data,value)
5300class(dbadata), intent(in) :: data !< data object to be decoded
5301INTEGER(kind=int_b), intent(out) :: value !< returned value
5302value=bmiss
5303
5304select type(data)
5305type is (dbadatab)
5306 value = data%value
5307end select
5308
5309end subroutine dbadata_getb
5310
5311!> test missing value
5312logical function dbadata_c_e_b(data)
5313class(dbadata), intent(in) :: data !< data object to be tested
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
5324!> return character value
5325subroutine dbadata_getc(data,value)
5326class(dbadata), intent(in) :: data !< data object to be decoded
5327character(len=*), intent(out) :: value !< returned value
5328value=cmiss
5329
5330select type(data)
5331type is (dbadatac)
5332 value = data%value
5333end select
5334
5335end subroutine dbadata_getc
5336
5337
5338!> test missing value
5339logical function dbadata_c_e_c(data)
5340class(dbadata), intent(in) :: data !< data object to be tested
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
5352!> test missing value
5353logical function dbadata_c_e(data)
5354class(dbadata), intent(in) :: data !< data object to be tested
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
5362!> print a summary of object content
5363subroutine dbalevel_display(level)
5364class(dbalevel), intent(in) :: level
5365call display (level%vol7d_level)
5366end subroutine dbalevel_display
5367
5368!> Constructor
5369!! Without parameter it is initialized to missing
5370type(dbalevel) function dbalevel_init(level1, l1, level2, l2)
5371
5372INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
5373INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
5374INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
5375INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
5376
5377call init (dbalevel_init%vol7d_level,level1, l1, level2, l2)
5378end function dbalevel_init
5379
5380!> set parameters in dballe API
5381subroutine dbalevel_set(level,session)
5382class(dbalevel), intent(in) :: level
5383type(dbasession), intent(in) :: session !< dballe 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
5397!> query parameters from dballe API
5398subroutine dbalevel_enq(level,session)
5399class(dbalevel), intent(out) :: level
5400type(dbasession), intent(in) :: session !< dballe session
5401integer :: ier
5402
5403ier = idba_enqlevel(session%sehandle,&
5404 level%level1, level%l1, level%level2, level%l2)
5405
5406end subroutine dbalevel_enq
5407
5408!> set dballe station data context for level (in object, not dballe session)
5409type(dbalevel) function dbalevel_contextana()
5410
5411dbalevel_contextana=dbalevel()
5412
5413end function dbalevel_contextana
5414
5415
5416!> print a summary of object content
5417subroutine dbaana_display(ana)
5418class(dbaana), intent(in) :: ana
5419call display (ana%vol7d_ana)
5420end subroutine dbaana_display
5421
5422
5423!> Constructor
5424!! Without parameter it is initialized to missing
5425type(dbacoord) function dbacoord_init(lon, lat, ilon, ilat)
5426REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon !< longitudine
5427REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat !< latitudine
5428INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon !< integer longitude (nint(lon*1.d5)
5429INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat !< integer latitude (nint(lat*1.d5)
5430
5431CALL init(dbacoord_init%geo_coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
5432
5433end function dbacoord_init
5434
5435!> print a summary of object content
5436subroutine dbacoord_display(coord)
5437class(dbacoord), intent(in) :: coord
5438call display (coord%geo_coord)
5439end subroutine dbacoord_display
5440
5441!> Constructor
5442!! Without parameter it is initialized to missing
5443type(dbaana) function dbaana_init(coord,ident,lon, lat, ilon, ilat)
5444CHARACTER(len=*),INTENT(in),OPTIONAL :: ident !< identificativo del volo
5445TYPE(dbacoord),INTENT(IN),optional :: coord !< coordinate
5446REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon !< longitudine
5447REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat !< latitudine
5448INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon !< integer longitude (nint(lon*1.d5)
5449INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat !< integer latitude (nint(lat*1.d5)
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
5459!> set parameters in dballe API
5460subroutine dbaana_set(ana,session)
5461class(dbaana), intent(in) :: ana
5462type(dbasession), intent(in) :: session !< dballe 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
5478!> query parameters from dballe API
5479subroutine dbaana_enq(ana,session)
5480class(dbaana), intent(out) :: ana
5481type(dbasession), intent(in) :: session !< dballe 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
5494!> put data on DSN
5495subroutine dbaana_extrude(ana,session)
5496class(dbaana), intent(in) :: ana
5497type(dbasession), intent(in) :: session !< dballe 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
5510!> print a summary of object content
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
5524!> get dbaana pointed by iterator
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
5537!> set parameters in dballe API
5538subroutine dbadc_set(dc,session)
5539class(dbadc), intent(in) :: dc
5540type(dbasession), intent(in) :: session !< dballe session
5541
5542call dc%dat%dbaset(session)
5543
5544end subroutine dbadc_set
5545
5546!> print a summary of object content
5547subroutine dbadc_display(dc)
5548class(dbadc), intent(in) :: dc
5549
5550call dc%dat%display()
5551
5552end subroutine dbadc_display
5553
5554!> set parameters in dballe API
5555subroutine dbadcv_set(dcv,session)
5556class(dbadcv), intent(in) :: dcv
5557type(dbasession), intent(in) :: session !< dballe 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
5568!> put data on DSN
5569subroutine dbadcv_extrude(dcv,session,noattr,filter,template)
5570class(dbadcv), intent(in) :: dcv
5571type(dbasession), intent(in) :: session !< dballe session
5572logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
5573type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
5583!> put data on DSN
5584subroutine dbadc_extrude(data,session,noattr,filter,attronly,template)
5585class(dbadc), intent(in) :: data
5586type(dbasession), intent(in) :: session !< dballe session
5587logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
5588type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
5589logical, intent(in),optional :: attronly !< set to .true. to export attr only (no data)
5590character(len=*),intent(in),optional :: template
5591
5592call data%extrude(session,noattr,filter,attronly,template)
5593
5594end subroutine dbadc_extrude
5595
5596
5597!> print a summary of object content
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
5632!> dballe unsetb
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
5642!> dballe close_message
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
5687!> dballe messages_open_input
5688subroutine dbasession_messages_open_input(session,filename,mode,format,simplified)
5689class(dbasession), intent(in) :: session
5690character (len=*), intent(in) :: filename !< file name to open
5691character (len=*), intent(in),optional :: mode !< "r"/"w"/"a" the open mode ("r" for read, "w" for write or create, "a" for append)
5692character (len=*), intent(in),optional :: format !< the file format. It can be "BUFR", "CREX" or "JSON" (default="BUFR")
5693logical, intent(in),optional :: simplified !< rappresentation when interpret message (simplified/precise)
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
5713!> dballe messages_open_output
5714subroutine dbasession_messages_open_output(session,filename,mode,format)
5715class(dbasession), intent(in) :: session
5716character (len=*), intent(in) :: filename !< file name to open
5717character (len=*), intent(in),optional :: mode !< "r"/"w"/"a" the open mode ("r" for read, "w" for write or create, "a" for append)
5718character (len=*), intent(in),optional :: format !< the file format. It can be "BUFR", "CREX" o "JSON" (default="BUFR")
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
5734!> dballe messages_read_next
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
5744!> dballe messages_write_next
5745subroutine dbasession_messages_write_next(session,template)
5746class(dbasession), intent(in) :: session
5747character(len=*), optional :: template !< template to use writing BUFR/CREX
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
5763!> remove data from DSN
5764subroutine dbasession_dissolve_metadata(session,metadata)
5765class(dbasession), intent(in) :: session
5766type(dbametadata), intent(in) :: metadata(:) !< data are removed where those metadata match
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
5781!> remove attributes from DSN
5782subroutine dbasession_dissolveattr_metadata(session,metadata)
5783class(dbasession), intent(in) :: session
5784type(dbametadata), intent(in),optional :: metadata(:) !< attributes are removed where those metadata match
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
5819!> put data on DSN
5820subroutine dbadataattr_extrude(data,session,noattr,filter,attronly,template)
5821class(dbadataattr), intent(in) :: data
5822type(dbasession), intent(in) :: session !< dballe session
5823logical, intent(in),optional :: noattr !< set to .true. to put data only (no attribute)
5824type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
5825logical, intent(in),optional :: attronly !< set to .true. to put attr only (no data)
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
5929!> print a summary of object content
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
5941!> put data on DSN
5942subroutine dbadataattrv_extrude(dataattr,session,noattr,filter,attronly,template)
5943class(dbadataattrv), intent(in) :: dataattr
5944type(dbasession), intent(in) :: session !< dballe session
5945logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
5946type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
5947logical, intent(in),optional :: attronly !< set to .true. to export attr only (no data)
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
5963!> print a summary of object content
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
5974!> return integer value
5975subroutine dbadatai_geti(data,value)
5976class(dbadatai), intent(in) :: data
5977integer, intent(out) :: value !< value returned
5978value=data%value
5979end subroutine dbadatai_geti
5980
5981!> return real value
5982subroutine dbadatar_getr(data,value)
5983class(dbadatar), intent(in) :: data
5984real, intent(out) :: value !< value returned
5985value=data%value
5986end subroutine dbadatar_getr
5987
5988!> return double precision value
5989subroutine dbadatad_getd(data,value)
5990class(dbadatad), intent(in) :: data
5991doubleprecision, intent(out) :: value !< value returned
5992value=data%value
5993end subroutine dbadatad_getd
5994
5995!> return byte value
5996subroutine dbadatab_getb(data,value)
5997class(dbadatab), intent(in) :: data
5998integer(kind=int_b), intent(out) :: value !< value returned
5999value=data%value
6000end subroutine dbadatab_getb
6001
6002!> return character value
6003subroutine dbadatac_getc(data,value)
6004class(dbadatac), intent(in) :: data
6005character(len=*), intent(out) :: value !< value returned
6006value=data%value
6007end subroutine dbadatac_getc
6008
6009
6010!> Constructor
6011!! Without parameter it is initialized to missing
6012type(dbadatai) elemental function dbadatai_init(btable,value)
6013
6014character(len=*),INTENT(IN),OPTIONAL :: btable !< parameter descriptor
6015INTEGER,INTENT(IN),OPTIONAL :: value !< 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
6031!> Constructor
6032!! Without parameter it is initialized to missing
6033type(dbadatar) elemental function dbadatar_init(btable,value)
6034
6035character(len=*),INTENT(IN),OPTIONAL :: btable !< parameter descriptor
6036real,INTENT(IN),OPTIONAL :: value !< 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
6052!> Constructor
6053!! Without parameter it is initialized to missing
6054type(dbadatad) elemental function dbadatad_init(btable,value)
6055
6056character(len=*),INTENT(IN),OPTIONAL :: btable !< parameter descriptor
6057double precision,INTENT(IN),OPTIONAL :: value !< 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
6074!> Constructor
6075!! Without parameter it is initialized to missing
6076type(dbadatab) elemental function dbadatab_init(btable,value)
6077
6078character(len=*),INTENT(IN),OPTIONAL :: btable !< parameter descriptor
6079INTEGER(kind=int_b) ,INTENT(IN),OPTIONAL :: value !< 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
6095!> Constructor
6096!! Without parameter it is initialized to missing
6097type(dbadatac) elemental function dbadatac_init(btable,value)
6098
6099character(len=*),INTENT(IN),OPTIONAL :: btable !< parameter descriptor
6100character(len=*),INTENT(IN),OPTIONAL :: value !< 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
6117!> set parameters in dballe API
6118subroutine dbadatai_set(data,session)
6119class(dbadatai), intent(in) :: data
6120type(dbasession), intent(in) :: session !< dballe session
6121integer :: ier
6122if (.not. c_e(data%btable)) return
6123ier = idba_set(session%sehandle,data%btable,data%value)
6124end subroutine dbadatai_set
6125
6126!> print a summary of object content
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
6132!> set parameters in dballe API
6133subroutine dbadatar_set(data,session)
6134class(dbadatar), intent(in) :: data
6135type(dbasession), intent(in) :: session !< dballe session
6136integer :: ier
6137if (.not. c_e(data%btable)) return
6138ier = idba_set(session%sehandle,data%btable,data%value)
6139end subroutine dbadatar_set
6140
6141!> print a summary of object content
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
6148!> set parameters in dballe API
6149subroutine dbadatad_set(data,session)
6150class(dbadatad), intent(in) :: data
6151type(dbasession), intent(in) :: session !< dballe session
6152integer :: ier
6153if (.not. c_e(data%btable)) return
6154ier = idba_set(session%sehandle,data%btable,data%value)
6155end subroutine dbadatad_set
6156
6157!> print a summary of object content
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
6163!> set parameters in dballe API
6164subroutine dbadatab_set(data,session)
6165class(dbadatab), intent(in) :: data
6166type(dbasession), intent(in) :: session !< dballe session
6167integer :: ier
6168if (.not. c_e(data%btable)) return
6169ier = idba_set(session%sehandle,data%btable,data%value)
6170end subroutine dbadatab_set
6171
6172!> print a summary of object content
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
6178!> set parameters in dballe API
6179subroutine dbadatac_set(data,session)
6180class(dbadatac), intent(in) :: data
6181type(dbasession), intent(in) :: session !< dballe session
6182integer :: ier
6183if (.not. c_e(data%btable)) return
6184ier = idba_set(session%sehandle,data%btable,data%value)
6185end subroutine dbadatac_set
6186
6187!> print a summary of object content
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
6206!> print a summary of object content
6207subroutine dbatimerange_display(timerange)
6208class(dbatimerange), intent(in) :: timerange
6209call display (timerange%vol7d_timerange)
6210end subroutine dbatimerange_display
6211
6212!> set parameters in dballe API
6213subroutine dbatimerange_set(timerange,session)
6214class(dbatimerange), intent(in) :: timerange
6215type(dbasession), intent(in) :: session !< dballe 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
6228!> query parameters from dballe API
6229subroutine dbatimerange_enq(timerange,session)
6230class(dbatimerange), intent(out) :: timerange
6231type(dbasession), intent(in) :: session !< dballe session
6232integer :: ier
6233
6234ier = idba_enqtimerange(session%sehandle,&
6235 timerange%timerange, timerange%p1, timerange%p2)
6236
6237end subroutine dbatimerange_enq
6238
6239!> Constructor
6240!! Without parameter it is initialized to missing
6241type(dbatimerange) function dbatimerange_init(timerange, p1, p2)
6242INTEGER,INTENT(IN),OPTIONAL :: timerange !< tipo di intervallo temporale
6243INTEGER,INTENT(IN),OPTIONAL :: p1 !< valore per il primo istante temporale
6244INTEGER,INTENT(IN),OPTIONAL :: p2 !< valore per il secondo istante temporale
6245
6246call init (dbatimerange_init%vol7d_timerange,timerange, p1, p2)
6247end function dbatimerange_init
6248
6249!> set dballe station data context for timerange (in object, not dballe session)
6250type(dbatimerange) function dbatimerange_contextana()
6251
6252dbatimerange_contextana=dbatimerange()
6253
6254end function dbatimerange_contextana
6255
6256
6257!> print a summary of object content
6258subroutine dbanetwork_display(network)
6259class(dbanetwork), intent(in) :: network
6260call display (network%vol7d_network)
6261print *,"Priority=",network%priority
6262end subroutine dbanetwork_display
6263
6264!> set parameters in dballe API
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
6274!> query parameters from dballe API
6275subroutine dbanetwork_enq(network,session)
6276class(dbanetwork), intent(out) :: network
6277type(dbasession), intent(in) :: session !< dballe 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
6285!> Constructor
6286!! Without parameter it is initialized to missing
6287type(dbanetwork) function dbanetwork_init(name)
6288CHARACTER(len=*),INTENT(in),OPTIONAL :: name !< Mnemonic alias for type of report
6289
6290call init (dbanetwork_init%vol7d_network,name)
6291dbanetwork_init%priority=imiss
6292end function dbanetwork_init
6293
6294
6295!> print a summary of object content
6296subroutine dbadatetime_display(datetime)
6297class(dbadatetime), intent(in) :: datetime
6298call display (datetime%datetime)
6299end subroutine dbadatetime_display
6300
6301!> set parameters in dballe API
6302subroutine dbadatetime_set(datetime,session)
6303class(dbadatetime), intent(in) :: datetime
6304type(dbasession), intent(in) :: session !< dballe 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
6324!> query parameters from dballe API
6325subroutine dbadatetime_enq(datetime,session)
6326class(dbadatetime), intent(out) :: datetime
6327type(dbasession), intent(in) :: session !< dballe 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
6349!> Constructor
6350!! Without parameter it is initialized to missing
6351type(dbadatetime) function dbadatetime_init(dt)
6352type(datetime),INTENT(in),OPTIONAL :: dt !< date and time
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
6362!> set dballe station data context for date and time (in object, not dballe session)
6363type(dbadatetime) function dbadatetime_contextana()
6364
6365dbadatetime_contextana%datetime=datetime_new()
6366
6367end function dbadatetime_contextana
6368
6369
6370!> Constructor
6371!! Without parameter it is initialized to missing
6372type(dbametadata) function dbametadata_init(level,timerange,ana,network,datetime)
6373
6374type(dbalevel), intent(in), optional :: level !< level
6375type(dbatimerange), intent(in), optional :: timerange !< timerange
6376type(dbaana), intent(in), optional :: ana !< ana
6377type(dbanetwork), intent(in), optional :: network !< network
6378type(dbadatetime), intent(in), optional :: datetime !< date and time
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
6412!> print a summary of object content
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
6423!> set parameters in dballe API
6424subroutine dbametadata_set(metadata,session)
6425class(dbametadata), intent(in) :: metadata
6426type(dbasession), intent(in) :: session !< dballe 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
6448!> query parameters from dballe API
6449subroutine dbametadata_enq(metadata,session)
6450class(dbametadata), intent(out) :: metadata
6451type(dbasession), intent(in) :: session !< dballe 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
6462!> equal operator for dbafilter and dbametadata
6463logical function dbafilter_equal_dbametadata(this,that)
6464
6465class(dbafilter), intent(in) :: this !< first element
6466class(dbametadata), intent(in) :: that !< second element
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
6524!> equal operator for dbadcv and dbadata
6525!! if dbadcv%dcv is not allocated result is .true.
6526elemental logical function dbadcv_equal_dbadata(this,that)
6527
6528class(dbadcv), intent(in) :: this !< first element
6529class(dbadata), intent(in) :: that !< second element
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
6549!> equal operator for dbametadata
6550elemental logical function dbametadata_equal(this,that)
6551
6552class(dbametadata), intent(in) :: this !< first element
6553class(dbametadata), intent(in) :: that !< second element
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
6570!> Constructor
6571!! This is the filter we can use to limit results fron the ingest operation
6572!! Without parameter it is initialized to missing
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 !< prototype filter to use as default
6580type(dbaana),intent(in),optional :: ana !< ana filter
6581character(len=*),intent(in),optional :: var !< var filter
6582type(dbadatetime),intent(in),optional :: datetime !< date and time filter
6583type(dbalevel),intent(in),optional :: level !< level filter
6584type(dbatimerange),intent(in),optional :: timerange !< timerange filter
6585type(dbanetwork),intent(in),optional :: network !< network filter
6586type(dbacoord),intent(in),optional :: coordmin !< minimun coordinate filter
6587type(dbacoord),intent(in),optional :: coordmax !< maximum coordinate filter
6588type(dbadatetime),intent(in),optional :: datetimemin !< minumum date and time filter
6589type(dbadatetime),intent(in),optional :: datetimemax !< maximum date and time filter
6590integer,intent(in),optional :: limit !< Maximum number of results to return
6591character(len=*),intent(in),optional :: ana_filter !< Restricts the results to only those stations which have a pseudoana value that matches the filter. Examples: 'height>=1000', 'B02001=1', '1000<=height<=2000
6592character(len=*),intent(in),optional :: data_filter !< Restricts the results to only the variables of the given type, which have a value that matches the filter. Examples: 't<260', 'B22021>2', '10<=B22021<=20'
6593character(len=*),intent(in),optional :: attr_filter !< Restricts the results to only those data which have an attribute that matches the filter. Examples: 'conf>70', 'B33197=0', '25<=conf<=50'
6594character(len=*),intent(in),optional :: varlist !< Comma-separated list of variable B codes wanted on output
6595character(len=*),intent(in),optional :: starvarlist !< Comma-separated list of attribute B codes wanted on output
6596character(len=*),intent(in),optional :: anavarlist !< Comma-separated list of variable B codes wanted on output for ana
6597character(len=*),intent(in),optional :: anastarvarlist !< Comma-separated list of attribute B codes wanted on output for ana
6598integer,intent(in),optional :: priority !< priority on network wanted on output
6599integer,intent(in),optional :: priomin !< minimum priority on network wanted on output
6600integer,intent(in),optional :: priomax !< maximum priority on network wanted on output
6601logical,intent(in),optional :: contextana !< set contextana; if true we want to work on station data else on data
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 !< Comma-separated list of query modifiers. Can have one of: 'best' or obsoletes: 'bigana', 'nosort', 'stream'. Examples: 'best' obsoletes: 'nosort,stream'
6607logical,intent(in),optional :: anaonly !< only station data wanted on input/output
6608logical,intent(in),optional :: dataonly !< only data wanted on input/output
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
6865!> print a summary of object content
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
6910!> set parameters in dballe API
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
6989!> set dballe station data context for all metadata (in object, not dballe session)
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
7009!> print a summary of object content
7010subroutine dbametaanddata_display(metaanddata)
7011class(dbametaanddata), intent(in) :: metaanddata
7012
7013call metaanddata%metadata%display()
7014call metaanddata%dataattrv%display()
7015
7016end subroutine dbametaanddata_display
7017
7018!> put data on DSN
7019subroutine dbametaanddata_extrude(metaanddata,session,noattr,filter,attronly,template)
7020class(dbametaanddata), intent(in) :: metaanddata
7021type(dbasession), intent(in) :: session !< dballe session
7022logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
7023type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
7024logical, intent(in),optional :: attronly !< set to .true. to export attr only (no data)
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 !< dballe session
7045logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
7046type(dbafilter),intent(in) :: filter !< use this to filter wanted data
7047logical, intent(in),optional :: attronly !< set to .true. to export attr only (no data)
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
7067!> print a summary of object content
7068subroutine dbametaanddatav_display(metaanddatav)
7069class(dbametaanddatav), intent(in) :: metaanddatav
7070
7071call metaanddatav%metadata%display()
7072call metaanddatav%datav%display()
7073
7074end subroutine dbametaanddatav_display
7075
7076!> put data on DSN
7077subroutine dbametaanddatav_extrude(metaanddatav,session,noattr,filter,template)
7078class(dbametaanddatav), intent(in) :: metaanddatav
7079type(dbasession), intent(in) :: session !< dballe session
7080logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
7081type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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 !< dballe session
7097logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
7098type(dbafilter),intent(in) :: filter !< use this to filter wanted data
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
7117!> put data on DSN; extrude metaanddata list
7118subroutine dbametaanddatal_extrude(metaanddatal,session,noattr,filter,attronly,template)
7119class(dbametaanddatalist), intent(inout) :: metaanddatal !< ingestd data
7120class(dbasession), intent(in) :: session
7121logical, intent(in),optional :: noattr !< set to .true. to put data only (no attribute)
7122type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
7123type(dbametaanddata) :: metaanddata
7124logical, intent(in),optional :: attronly !< set to .true. to export attr only (no data)
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
7138!> print a summary of object content
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
7152!> Get dbametaanddatai pointed by iterator
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
7165!> get data from DSN
7166subroutine dbasession_ingest_metaanddatail(session,metaanddatal,filter)
7167class(dbasession), intent(inout) :: session
7168type(dbametaanddatailist), intent(inout) :: metaanddatal !< ingestd data
7169type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
7198!> return an array of dbametaanddatai
7199function toarray_dbametaanddatai(this)
7200type(dbametaanddatai),allocatable :: toarray_dbametaanddatai(:) !< array
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
7217!> print a summary of object content
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
7231!> Get dbametaanddatar pointed by iterator
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
7244!> get data from DSN
7245subroutine dbasession_ingest_metaanddatarl(session,metaanddatal,filter)
7246class(dbasession), intent(inout) :: session
7247type(dbametaanddatarlist), intent(inout) :: metaanddatal !<ingestd data
7248type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
7278!> return an array of dbametaanddatar
7279function toarray_dbametaanddatar(this)
7280type(dbametaanddatar),allocatable :: toarray_dbametaanddatar(:) !< array
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
7298!> print a summary of object content
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
7312!> Get dbametaanddatad pointed by iterator
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
7324!> get data from DSN
7325subroutine dbasession_ingest_metaanddatadl(session,metaanddatal,filter)
7326class(dbasession), intent(inout) :: session
7327type(dbametaanddatadlist), intent(inout) :: metaanddatal !<ingestd data
7328type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
7357!> return an array of dbametaanddatad
7358function toarray_dbametaanddatad(this)
7359type(dbametaanddatad),allocatable :: toarray_dbametaanddatad(:) !< array
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
7376!> print a summary of object content
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
7390!> Get dbametaanddatab pointed by iterator
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
7403!> get data from DSN
7404subroutine dbasession_ingest_metaanddatabl(session,metaanddatal,filter)
7405class(dbasession), intent(inout) :: session
7406type(dbametaanddatablist), intent(inout) :: metaanddatal !<ingestd data
7407type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
7436!> return an array of dbametaanddatab
7437function toarray_dbametaanddatab(this)
7438type(dbametaanddatab),allocatable :: toarray_dbametaanddatab(:) !< array
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
7455!> print a summary of object content
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
7469!> Get dbametaanddatac pointed by iterator
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
7482!> get data from DSN
7483subroutine dbasession_ingest_metaanddatacl(session,metaanddatal,filter)
7484class(dbasession), intent(inout) :: session
7485type(dbametaanddataclist), intent(inout) :: metaanddatal!< ingestd data
7486type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
7515!> return an array of dbametaanddatac
7516function toarray_dbametaanddatac(this)
7517type(dbametaanddatac),allocatable :: toarray_dbametaanddatac(:) !< array
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
7534!> print a summary of object content
7535subroutine dbametaanddatai_display(data)
7536class(dbametaanddatai), intent(in) :: data
7537
7538call data%metadata%display()
7539call data%dbadatai%display()
7540
7541end subroutine dbametaanddatai_display
7542
7543!> print a summary of object content
7544subroutine dbametaanddatab_display(data)
7545class(dbametaanddatab), intent(in) :: data
7546
7547call data%metadata%display()
7548call data%dbadatab%display()
7549
7550end subroutine dbametaanddatab_display
7551
7552!> print a summary of object content
7553subroutine dbametaanddatad_display(data)
7554class(dbametaanddatad), intent(in) :: data
7555
7556call data%metadata%display()
7557call data%dbadatad%display()
7558
7559end subroutine dbametaanddatad_display
7560
7561!> print a summary of object content
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
7571!> print a summary of object content
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
7581!> put data on DSN
7582subroutine dbametaanddatai_extrude(metaanddatai,session)
7583class(dbametaanddatai), intent(in) :: metaanddatai
7584type(dbasession), intent(in) :: session !< dballe 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
7600!> put data on DSN
7601subroutine dbametaanddatab_extrude(metaanddatab,session)
7602class(dbametaanddatab), intent(in) :: metaanddatab
7603type(dbasession), intent(in) :: session !< dballe 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
7619!> put data on DSN
7620subroutine dbametaanddatad_extrude(metaanddatad,session)
7621class(dbametaanddatad), intent(in) :: metaanddatad
7622type(dbasession), intent(in) :: session !< dballe 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
7638!> put data on DSN
7639subroutine dbametaanddatar_extrude(metaanddatar,session)
7640class(dbametaanddatar), intent(in) :: metaanddatar
7641type(dbasession), intent(in) :: session !< dballe 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
7657!> put data on DSN
7658subroutine dbametaanddatac_extrude(metaanddatac,session)
7659class(dbametaanddatac), intent(in) :: metaanddatac
7660type(dbasession), intent(in) :: session !< dballe 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
7676!> get data from DSN
7677subroutine dbasession_ingest_ana(session,ana)
7678class(dbasession), intent(inout) :: session
7679type(dbaana), intent(out),optional :: ana !< 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
7695!> get data from DSN
7696subroutine dbasession_ingest_anav(session,anav)
7697class(dbasession), intent(inout) :: session
7698type(dbaana), intent(out),allocatable :: anav(:) !< array of ana
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
7717!> get data from DSN
7718subroutine dbasession_ingest_anal(session,anal)
7719class(dbasession), intent(inout) :: session
7720type(dbaanalist), intent(out) :: anal !< double linked list of ana
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
7732!> get data from DSN
7733subroutine dbasession_ingest_metaanddata(session,metaanddata,noattr,filter)
7734class(dbasession), intent(inout) :: session
7735type(dbametaanddata), intent(inout),optional :: metaanddata !< ingested data
7736logical,intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
7737type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
7996!> get data from DSN
7997subroutine dbasession_ingest_metaanddatav(session,metaanddatav,noattr,filter)
7998class(dbasession), intent(inout) :: session
7999type(dbametaanddata), intent(inout),allocatable :: metaanddatav(:) !< ingestd data
8000logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
8001type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
8044!> Get data fron DSN; ingest metaanddata list
8045subroutine dbasession_ingest_metaanddatal(session,metaanddatal,noattr,filter)
8046class(dbasession), intent(inout) :: session
8047type(dbametaanddatalist), intent(out) :: metaanddatal !< ingestd data
8048logical, intent(in),optional :: noattr !< set to .true. to get data only (no attribute)
8049type(dbafilter),intent(in),optional :: filter !< use this to filter wanted data
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
8090!> Get data from DSN
8091subroutine dbasession_ingest_metaanddatai(session,metaanddata)
8092class(dbasession), intent(inout) :: session
8093type(dbametaanddatai), intent(inout),optional :: metaanddata !< ingestd data
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
8111!> Get data from DSN
8112subroutine dbasession_ingest_metaanddataiv(session,metaanddatav)
8113class(dbasession), intent(inout) :: session
8114type(dbametaanddatai), intent(inout),allocatable :: metaanddatav(:) !< ingestd data
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
8133!> Get data from DSN
8134subroutine dbasession_ingest_metaanddatab(session,metaanddata)
8135class(dbasession), intent(inout) :: session
8136type(dbametaanddatab), intent(inout),optional :: metaanddata !< ingestd data
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
8154!> Get data from DSN
8155subroutine dbasession_ingest_metaanddatabv(session,metaanddatav)
8156class(dbasession), intent(inout) :: session
8157type(dbametaanddatab), intent(inout),allocatable :: metaanddatav(:) !<ingestd data
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
8176!> get data from DSN
8177subroutine dbasession_ingest_metaanddatad(session,metaanddata)
8178class(dbasession), intent(inout) :: session
8179type(dbametaanddatad), intent(inout),optional :: metaanddata !< ingestd data
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
8197!> Get data from DSN
8198subroutine dbasession_ingest_metaanddatadv(session,metaanddatav)
8199class(dbasession), intent(inout) :: session
8200type(dbametaanddatad), intent(inout),allocatable :: metaanddatav(:) !<ingestd data
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
8218!> get data from DSN
8219subroutine dbasession_ingest_metaanddatar(session,metaanddata)
8220class(dbasession), intent(inout) :: session
8221type(dbametaanddatar), intent(inout),optional :: metaanddata !< ingestd data
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
8239!> Get data from DSN
8240subroutine dbasession_ingest_metaanddatarv(session,metaanddatav)
8241class(dbasession), intent(inout) :: session
8242type(dbametaanddatar), intent(inout),allocatable :: metaanddatav(:) !<ingestd data
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
8261!> get data from DSN
8262subroutine dbasession_ingest_metaanddatac(session,metaanddata)
8263class(dbasession), intent(inout) :: session
8264type(dbametaanddatac), intent(inout),optional :: metaanddata !< ingestd data
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
8282!> Get data from DSN
8283subroutine dbasession_ingest_metaanddatacv(session,metaanddatav)
8284class(dbasession), intent(inout) :: session
8285type(dbametaanddatac), intent(inout),allocatable :: metaanddatav(:) !<ingestd data
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
8302!> Constructor
8303!! Without parameter it is initialized to missing
8304type(dbaconnection) function dbaconnection_init(dsn, user, password,categoryappend,idbhandle)
8305character (len=*), intent(in), optional :: dsn !< DSN (dballe/ODBC definition)
8306character (len=*), intent(in), optional :: user !< username to use
8307character (len=*), intent(in), optional :: password !< password to use
8308character(len=*),INTENT(in),OPTIONAL :: categoryappend !< appennde questo suffisso al namespace category di log4fortran
8309integer,INTENT(in),OPTIONAL :: idbhandle !< dsn connection; if present it will be used
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
8338!> remove dballe connection
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
8355!> Constructor
8356!! Without parameter it is initialized to missing
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 !< dballe connection
8360character (len=*), intent(in), optional :: anaflag !< controls access to pseudoana records and can have these values "read": pseudoana records cannot be modified; "write": pseudoana records can be added and removed.
8361character (len=*), intent(in), optional :: dataflag !< control access to observed data and can have these values "read": data cannot be modified in any way; "add": data can be added to the database, but existing data cannot be modified. Deletions are disabled. This is used to insert new data in the database while preserving the data that was already present in it; "write": data can freely be added, overwritten and deleted.
8362character (len=*), intent(in), optional :: attrflag !< controls access to data attributes and can have these values "read": attributes cannot be modified in any way; "write": attributes can freely be added, overwritten and deleted. Note that some combinations are illegal, such as pseudoana=read and data=add (when adding a new data, it's sometimes necessary to insert new pseudoana records), or data=rewrite and attr=read (when deleting data, their attributes are deleted as well).
8363character (len=*), intent(in), optional :: filename !< optional file name to use
8364character (len=*), intent(in), optional :: mode !< "r"/"w"/"a" the open mode ("r" for read, "w" for write or create, "a" for append)
8365character (len=*), intent(in), optional :: template !< template to use for write on file
8366logical,INTENT(in),OPTIONAL :: write !< enable write on DSN/file ( default=.false. )
8367logical,INTENT(in),OPTIONAL :: wipe !< clean DSN/file and initialize it ( default=.false. )
8368character(len=*), INTENT(in),OPTIONAL :: repinfo !< optional file repinfo.csv to use with wipe ( default="" )
8369character(len=*),intent(in),optional :: format !< the file format. It can be "BUFR", "CREX" or "JSON". (default="BUFR")
8370logical,intent(in),optional :: simplified !< rappresentation for interpreted message (simplified/precise)
8371logical,intent(in),optional :: memdb !< if true set a memdb ready for import data from file (default=true if filename present else false)
8372logical,intent(in),optional :: loadfile !< if true import from file to memdb (default=true if filename present else false)
8373character(len=*),INTENT(in),OPTIONAL :: categoryappend !< name to append to namespace category of log4fortran
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
8610!> clean all setting on dballe API
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
8622!> dballe remove_all
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
8634!> dballe prendilo
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
8645!> dballe var_related
8646subroutine dbasession_var_related(session,btable)
8647class(dbasession), intent(in) :: session
8648character(len=*),INTENT(IN) :: btable !< descrittore variabile
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
8657!> set parameters in dballe API needed for station data
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
8668!> dballe dimenticami
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
8679!> dballe critica
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
8690!> dballe scusa
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
8701!> set parameters in dballe API
8702subroutine dbasession_set(session,metadata,datav,data,datetime,ana,network,level,timerange,filter)
8703class(dbasession), intent(in) :: session
8704type (dbametadata),optional :: metadata !< metadata
8705class(dbadcv),optional :: datav !< data array
8706class(dbadata),optional :: data !< data
8707type (dbadatetime),optional :: datetime !< date and time
8708type (dbaana),optional :: ana !< ana
8709type (dbanetwork),optional :: network !< network
8710type (dbalevel),optional :: level !< level
8711type (dbatimerange),optional :: timerange !< timerange
8712type (dbafilter),optional :: filter !< filter for wanted data
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!> clear a dballe session
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
8941!> clear a dballe session
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
8967!> rewind a file associated to a session (needed to restart reading)
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
9023!>\example example_dballe.F03
9024!!\brief Sample program to demostrate the dballe_class module.
9025!!
9026!! This module have examples to read/write/manipulate data from/to DB or BUFR.
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.