1c $Id$
2
3      subroutine bq_tag_ncent(namespace,tag)
4      implicit none
5#include "util.fh"
6#include "inp.fh"
7
8      character*(*) tag
9c
10      integer n
11      character*255 namespace
12c
13      n=inp_strlen(namespace)
14      tag="bq:"//namespace(1:n)//":ncenter"
15
16      end
17
18      subroutine bq_tag_coord(namespace,tag)
19      implicit none
20#include "util.fh"
21#include "inp.fh"
22
23      character*(*) tag
24c
25      integer n
26      character*255 namespace
27c
28      n=inp_strlen(namespace)
29      tag="bq:"//namespace(1:n)//":coord"
30
31      end
32
33      subroutine bq_tag_charge(namespace,tag)
34      implicit none
35#include "util.fh"
36#include "inp.fh"
37
38      character*(*) tag
39c
40      integer n
41      character*255 namespace
42c
43      n=inp_strlen(namespace)
44      tag="bq:"//namespace(1:n)//":charge"
45
46      end
47C>
48C> \ingroup bq
49C> @{
50C>
51C> \brief Store a Bq instance on the runtime database
52C>
53      function bq_rtdb_store(irtdb,handle)
54      implicit none
55#include "mafdecls.fh"
56#include "errquit.fh"
57#include "rtdb.fh"
58       integer irtdb  !< [Input] The RTDB handle
59       integer handle !< [Input] The Bq instance handle
60       logical bq_rtdb_store
61c      local variables
62       integer ncent
63       integer i_c
64       integer i_q
65       character*(32) pname
66       character*(255) tag
67       character*(255) namespace
68
69       logical  bq_ncenter
70       external bq_ncenter
71
72       logical  bq_check_handle
73       external bq_check_handle
74
75       logical  bq_namespace
76       external bq_namespace
77
78       logical  bq_index_coord
79       external bq_index_coord
80
81       logical  bq_index_charge
82       external bq_index_charge
83
84       pname = "bq_rtdb_store"
85
86       bq_rtdb_store= .true.
87       if(.not.bq_check_handle(handle)) then
88         bq_rtdb_store = .false.
89         return
90       end if
91
92       if(.not.bq_ncenter(handle,ncent))
93     &       call errquit('bq_ncenter failed',0,0)
94       if(.not.bq_namespace(handle,namespace))
95     &       call errquit('bq_namespace failed',0,0)
96       if(.not.bq_index_coord(handle,i_c))
97     &       call errquit('bq_index_coord failed',0,0)
98       if(.not.bq_index_charge(handle,i_q))
99     &       call errquit('bq_index_charge failed',0,0)
100
101       call bq_tag_ncent(namespace,tag)
102       if(.not. rtdb_put(irtdb,tag,mt_int,1,ncent))
103     &      call errquit(
104     &      pname//' unable to store ncenter',
105     &      0, RTDB_ERR)
106
107
108       call bq_tag_coord(namespace,tag)
109       if(.not. rtdb_put(irtdb,tag,mt_dbl,3*ncent,dbl_mb(i_c)))
110     &      call errquit(
111     &      pname//' unable to store coord',
112     &      0, RTDB_ERR)
113
114       call bq_tag_charge(namespace,tag)
115       if(.not. rtdb_put(irtdb,tag,mt_dbl,ncent,dbl_mb(i_q)))
116     &      call errquit(
117     &      pname//' unable to store charge',
118     &      0, RTDB_ERR)
119
120       return
121       end
122C>
123C> \brief Delete a Bq instance from the runtime database
124C>
125      subroutine bq_rtdb_delete(irtdb,namespace)
126      implicit none
127#include "mafdecls.fh"
128#include "errquit.fh"
129#include "rtdb.fh"
130       integer irtdb           !< [Input] The RTDB handle
131       character*(*) namespace !< [Input] The Bq instance name
132c      local variables
133       character*(32) pname
134       character*(255) tag
135       logical ignore
136
137       pname = "bq_rtdb_delete"
138
139       call bq_tag_ncent(namespace,tag)
140       ignore = rtdb_delete(irtdb,tag)
141
142       call bq_tag_coord(namespace,tag)
143       ignore = rtdb_delete(irtdb,tag)
144
145       call bq_tag_charge(namespace,tag)
146       ignore = rtdb_delete(irtdb,tag)
147
148       if(rtdb_cget(irtdb,"bq" , 1,tag)) then
149         if(tag.eq.namespace) then
150          ignore = rtdb_delete(irtdb,"bq")
151         end if
152       end if
153
154       return
155       end
156C>
157C> \brief Load a Bq instance from the runtime database
158C>
159C> Attempts to load a Bq instance from the runtime database.
160C> If the Bq instance on the RTDB is incomplete this function
161C> will abort with an error message and not return.
162C>
163C> \return Returns .true. if the Bq instance was loaded successfully,
164C> and .false. if it was not found.
165C>
166      function bq_rtdb_load(irtdb,handle)
167      implicit none
168#include "mafdecls.fh"
169#include "errquit.fh"
170#include "rtdb.fh"
171       integer irtdb  !< [Input] The RTDB handle
172       integer handle !< [Input] The Bq instance handle
173       logical bq_rtdb_load
174c      local variables
175       integer ncent
176       integer h_c
177       integer h_q
178       character*(32) pname
179       character*(255) tag
180       character*(255) namespace
181
182       integer ma_type,n
183
184       logical  bq_ncenter
185       external bq_ncenter
186
187       logical  bq_check_handle
188       external bq_check_handle
189
190       logical  bq_namespace
191       external bq_namespace
192
193       logical  bq_pset_mem
194       external bq_pset_mem
195
196       pname = "bq_rtdb_load"
197
198       bq_rtdb_load= .true.
199       if(.not.bq_check_handle(handle)) then
200         bq_rtdb_load = .false.
201         return
202       end if
203
204       if(.not.bq_ncenter(handle,ncent))
205     &       call errquit('bq_ncenter failed',0,0)
206       if(ncent.ne.0) then
207         bq_rtdb_load = .false.
208         write(*,*) pname//"empty bq set first"
209         return
210       end if
211        if(.not.bq_namespace(handle,namespace))
212     &       call errquit('bq_namespace failed',0,0)
213
214       call bq_tag_ncent(namespace,tag)
215       if(.not. rtdb_get(irtdb,tag,mt_int,1,ncent)) then
216         bq_rtdb_load = .false.
217         return
218       end if
219
220       call bq_tag_coord(namespace,tag)
221       if(.not. rtdb_ma_get(irtdb,tag,ma_type,n,h_c))
222     &      call errquit(
223     &      pname//' unable to get coord',
224     &      0, RTDB_ERR)
225       if(ma_type.ne.MT_DBL) call errquit(
226     &      pname//' illegal type for coord',ma_type,MA_ERR)
227
228
229       call bq_tag_charge(namespace,tag)
230       if(.not. rtdb_ma_get(irtdb,tag,ma_type,n,h_q))
231     &      call errquit(
232     &      pname//' unable to get charge',
233     &      0, RTDB_ERR)
234       if(ma_type.ne.MT_DBL) call errquit(
235     &      pname//' illegal type for charge',ma_type,MA_ERR)
236
237       if(.not. bq_pset_mem(handle,ncent,h_q,h_c))
238     &      call errquit(
239     &      pname//' unable to pset bq',
240     &      0, 0)
241
242       return
243       end
244C> @}
245