1      subroutine smd_rtdb_close(action)
2      implicit none
3#include "rtdb.fh"
4#include "smd_rtdb_data.fh"
5#include "mafdecls.fh"
6c
7      character*(*) action
8c
9      integer rtdb
10      logical result
11      character*30 pname
12
13      pname = "smd_rtdb_close"
14      call smd_rtdb_get_handle(rtdb)
15      if(rtdb.lt.0) call errquit(pname//"no rtdb to close")
16      if(.not.rtdb_close(rtdb,action))
17     >     call errquit(pname//" while rtdb_close",0,0)
18      call smd_rtdb_set_handle(-1000)
19
20      end
21
22      subroutine smd_rtdb_open(fname,action)
23      implicit none
24#include "rtdb.fh"
25#include "smd_rtdb_data.fh"
26#include "mafdecls.fh"
27c
28      character*(*) fname
29      character*(*) action
30c
31      integer rtdb
32      logical result
33      character*30 pname
34
35      pname = "smd_rtdb_close"
36      call smd_rtdb_get_handle(rtdb)
37      if(rtdb.ge.0) call errquit(pname//"close rtdb first")
38      if(.not.rtdb_open(fname,action,rtdb))
39     >     call errquit(pname//" while rtdb_open",0,0)
40      call smd_rtdb_set_handle(rtdb)
41
42      end
43
44      subroutine smd_rtdb_get_handle(rtdb)
45      implicit none
46#include "rtdb.fh"
47#include "smd_rtdb_data.fh"
48#include "mafdecls.fh"
49c
50      integer rtdb
51c
52      logical result
53      character*30 pname
54
55      pname = "smd_rtdb_get_handle"
56      call smd_rtdb_get_int("smd:rtdb_handle",1,rtdb,result)
57      if(.not.result) call errquit(pname//"no rtdb component",0,0)
58
59      end
60
61      subroutine smd_rtdb_set_handle(rtdb)
62      implicit none
63#include "rtdb.fh"
64#include "smd_rtdb_data.fh"
65#include "mafdecls.fh"
66c
67      integer rtdb
68c
69      logical result
70      character*30 pname
71
72      pname = "smd_rtdb_set_handle"
73      call smd_rtdb_put_int("smd:rtdb_handle",1,rtdb,result)
74      if(.not.result) call errquit(pname//"no rtdb component",0,0)
75
76      end
77
78      subroutine smd_rtdb_get_istart(istart)
79      implicit none
80#include "rtdb.fh"
81#include "smd_rtdb_data.fh"
82#include "mafdecls.fh"
83c
84      integer istart
85c
86      logical result
87      character*30 pname
88c
89      pname = "smd_rtdb_get_istart"
90      call smd_rtdb_get_int("smd:fragment_istart",1,istart,result)
91      if(.not.result) call errquit(pname//"no rtdb component",0,0)
92
93      end
94
95      subroutine smd_rtdb_get_iend(iend)
96      implicit none
97#include "rtdb.fh"
98#include "smd_rtdb_data.fh"
99#include "mafdecls.fh"
100c
101      integer iend
102c
103      logical result
104      character*30 pname
105c
106      pname = "smd_rtdb_get_iend"
107      call smd_rtdb_get_int("smd:fragment_iend",1,iend,result)
108      if(.not.result) call errquit(pname//"no rtdb component",0,0)
109
110      end
111
112      subroutine smd_rtdb_get_nproc(nproc)
113      implicit none
114#include "rtdb.fh"
115#include "smd_rtdb_data.fh"
116#include "mafdecls.fh"
117c
118      integer nproc
119c
120      logical result
121      character*30 pname
122c
123      pname = "smd_rtdb_get_nproc"
124      call smd_rtdb_get_int("smd:fragment_nproc",1,nproc,result)
125      if(.not.result) call errquit(pname//"no rtdb component",0,0)
126
127      end
128
129      subroutine smd_rtdb_get_name(rtdb_name)
130      implicit none
131#include "rtdb.fh"
132#include "smd_rtdb_data.fh"
133#include "mafdecls.fh"
134#include "errquit.fh"
135c
136      character*(*) rtdb_name
137c
138      integer rtdb
139      character*30 pname
140      logical result
141
142      pname = "smd_rtdb_get_name"
143c      call smd_rtdb_get_handle(rtdb)
144c      if(.not. rtdb_getfname(rtdb, rtdb_name)) call
145c     *        errquit(pname//'rtdb_getfname failed',0,0)
146      call smd_rtdb_get_string("smd:rtdb_name",1,rtdb_name,result)
147      if(.not.result) call errquit(pname//"no rtdb component",0,0)
148
149
150      end
151
152      subroutine smd_rtdb_get_operiodic(operiodic)
153      implicit none
154#include "rtdb.fh"
155#include "smd_rtdb_data.fh"
156#include "mafdecls.fh"
157c
158      logical operiodic
159c
160      double precision latt(3,3)
161      character*32 pname
162      character*80 tag
163      double precision a(3)
164      integer i
165c
166      pname = "smd_lat_rtdb_read"
167c
168c      write(*,*) "in "//pname
169c
170      tag="smd:operiodic"
171      if (rtdb_get(smd_rtdb,tag,mt_log,1,operiodic))
172     >    return
173
174      operiodic = .true.
175      tag="smd:lat_a"
176      if (.not.rtdb_get(smd_rtdb,tag,mt_dbl,3,a(1)))
177     >      operiodic=.false.
178
179
180      end
181
182      subroutine smd_rtdb_get_paramfile(filename,result)
183      implicit none
184#include "rtdb.fh"
185#include "smd_rtdb_data.fh"
186#include "mafdecls.fh"
187c
188      character*(*) filename
189      logical result
190c
191
192      result = .true.
193      if(.not.rtdb_cget(smd_rtdb,'smd:paramfile',1,filename))
194     >   result = .false.
195      end
196
197      subroutine smd_rtdb_get_coordfile(filename,result)
198      implicit none
199#include "rtdb.fh"
200#include "smd_rtdb_data.fh"
201#include "mafdecls.fh"
202#include "global.fh"
203
204c
205      character*(*) filename
206      logical result
207c
208      character*30 pname
209
210      pname = "smd_rtdb_get_coordfile"
211
212      result = .true.
213      if(.not.rtdb_cget(smd_rtdb,'smd:coordfile',1,filename))
214     >   result = .false.
215
216      end
217
218      subroutine smd_rtdb_get_veloc_input(filename,result)
219      implicit none
220#include "rtdb.fh"
221#include "smd_rtdb_data.fh"
222#include "mafdecls.fh"
223#include "global.fh"
224
225c
226      character*(*) filename
227      logical result
228c
229      character*30 pname
230
231      pname = "smd_rtdb_get_veloc:input"
232
233      result = .true.
234      if(.not.rtdb_cget(smd_rtdb,'smd:veloc:input',1,filename))
235     >   result = .false.
236
237      end
238
239      subroutine smd_rtdb_init(parallel,rtdb)
240      implicit none
241#include "rtdb.fh"
242#include "smd_rtdb_data.fh"
243#include "mafdecls.fh"
244#include "smd_const_data.fh"
245
246      logical parallel
247      integer rtdb
248c
249      character*(smd_string_size) namespace
250      character*(smd_string_size) tag
251      logical ignore,result,oldmode
252      character*30 pname
253
254      pname = "smd_rtdb_init"
255      oldmode = rtdb_parallel(parallel)
256      smd_rtdb = rtdb
257c      if(.not. rtdb_getfname(rtdb, smd_rtdb_name)) call
258c     *        errquit('rtdb_getfname failed',0,0)
259
260      smd_istart=0
261      smd_iend  =0
262      smd_nproc =0
263      ignore = rtdb_get(rtdb,"smd:istart",mt_int,1,smd_istart)
264      ignore = rtdb_get(rtdb,"smd:iend",mt_int,1,smd_iend)
265      ignore = rtdb_get(rtdb,"smd:nproc",mt_int,1,smd_nproc)
266
267      tag = "rtdb"
268      call smd_system_get_component(namespace,tag,result)
269      if(.not.result)
270     >  call errquit(
271     >       pname//'no component '//tag,0,0)
272
273      call smd_namespace_create(namespace)
274
275      call smd_data_namespace_rtdb_get(rtdb,namespace,"smd")
276      oldmode = rtdb_parallel(oldmode)
277      end
278
279      subroutine smd_rtdb_get_log(dname,ndim,datum,result)
280      implicit none
281c
282#include "mafdecls.fh"
283#include "errquit.fh"
284#include "smd_const_data.fh"
285      character*(smd_string_size) sname
286      character*(*) dname
287      integer ndim
288      logical datum(ndim)
289c
290      integer ind
291      logical result
292      integer ns,nd
293      character*30 pname
294      character*72 buffer
295      integer i
296      integer ndim1
297
298      pname = "smd_rtdb_get_log"
299
300      call smd_system_get_component(sname,"rtdb",result)
301      if(.not.result) call errquit(pname//"no rtdb component",0,0)
302      call smd_data_get_log(sname,dname,ndim,datum,result)
303      return
304      end
305
306      subroutine smd_rtdb_get_int(dname,ndim,datum,result)
307      implicit none
308c
309#include "mafdecls.fh"
310#include "errquit.fh"
311#include "smd_const_data.fh"
312      character*(smd_string_size) sname
313      character*(*) dname
314      integer ndim
315      integer datum(ndim)
316c
317      integer ind
318      logical result
319      integer ns,nd
320      character*30 pname
321      character*72 buffer
322      integer i
323      integer ndim1
324
325      pname = "smd_rtdb_get_int"
326
327      call smd_system_get_component(sname,"rtdb",result)
328      if(.not.result) call errquit(pname//"no rtdb component",0,0)
329      call smd_data_get_int(sname,dname,ndim,datum,result)
330      return
331      end
332
333      subroutine smd_rtdb_put_int(dname,ndim,datum,result)
334      implicit none
335c
336#include "mafdecls.fh"
337#include "errquit.fh"
338#include "smd_const_data.fh"
339      character*(smd_string_size) sname
340      character*(*) dname
341      integer ndim
342      integer datum(ndim)
343c
344      integer ind
345      logical result
346      integer ns,nd
347      character*30 pname
348      character*72 buffer
349      integer i
350      integer ndim1
351
352      pname = "smd_rtdb_put_int"
353
354      call smd_system_get_component(sname,"rtdb",result)
355      if(.not.result) return
356      call smd_data_put_int(sname,dname,ndim,datum)
357      return
358      end
359
360      subroutine smd_rtdb_get_dbl(dname,ndim,datum,result)
361      implicit none
362c
363#include "mafdecls.fh"
364#include "errquit.fh"
365#include "smd_const_data.fh"
366      character*(smd_string_size) sname
367      character*(*) dname
368      integer ndim
369      double precision datum(ndim)
370c
371      integer ind
372      logical result
373      integer ns,nd
374      character*30 pname
375      character*72 buffer
376      integer i
377      integer ndim1
378
379      pname = "smd_rtdb_get_dbl"
380
381      call smd_system_get_component(sname,"rtdb",result)
382      if(.not.result) call errquit(pname//"no rtdb component",0,0)
383      call smd_data_get_dbl(sname,dname,ndim,datum,result)
384      return
385      end
386
387      subroutine smd_rtdb_get_string(dname,ndim,datum,result)
388      implicit none
389c
390#include "mafdecls.fh"
391#include "errquit.fh"
392#include "smd_const_data.fh"
393#include "inp.fh"
394      character*(*) dname
395      integer ndim
396      integer dtype
397      character*(*) datum(ndim)
398c
399      integer ind
400      integer ns,nd
401      character*30 pname
402      character*72 buffer
403      integer i
404      integer ndim1
405      integer chunk
406      logical result
407      character*(smd_string_size) sname
408
409      pname = "smd_rtdb_get_string"
410
411      call smd_system_get_component(sname,"rtdb",result)
412      if(.not.result) call errquit(pname//"no rtdb component",0,0)
413      call smd_data_get_string(sname,dname,ndim,datum,result)
414      return
415      end
416
417c $Id$
418