1      block data initial_smd_energy_data
2      implicit none
3#include "smd_energy_data.fh"
4c
5      data smd_energy_name /"total",
6     c                      "kinetic",
7     c                      "vdw",
8     c                      "electrostatic",
9     c                      "ewald self",
10     c                      "ewald reciprocal",
11     c                      "ewald excluded",
12     c                      "ewald real"/
13
14
15      end
16
17      subroutine smd_energy_init_system()
18      implicit none
19#include "errquit.fh"
20#include "inp.fh"
21#include "mafdecls.fh"
22#include "rtdb.fh"
23#include "util.fh"
24#include "global.fh"
25c
26      character*32 sp_energy
27      character*32 tag,pname
28      logical result
29
30      pname = "smd_energy_init_system"
31c
32      tag = "energy"
33      call smd_system_get_component(sp_energy,tag,result)
34      if(.not.result)
35     >  call errquit(
36     >       pname//'no component '//tag,0,0)
37
38      call smd_energy_init(sp_energy)
39
40      return
41      end
42
43      subroutine smd_energy_init(sp_energy)
44      implicit none
45#include "errquit.fh"
46#include "inp.fh"
47#include "mafdecls.fh"
48#include "rtdb.fh"
49#include "util.fh"
50#include "global.fh"
51#include "smd_energy_data.fh"
52c
53      character*(*) sp_energy
54c
55      character*32 pname
56      integer na
57c
58      pname = "smd_energy_init"
59c
60c      write(*,*) "in "//pname
61c
62c     create energy data structures
63c     ---------------------------
64      call smd_namespace_create(sp_energy)
65      call smd_data_create(sp_energy,"energy",smd_energy_nc,MT_DBL)
66      call smd_data_create(sp_energy,"oenergy",smd_energy_nc,MT_LOG)
67      return
68      end
69
70      subroutine smd_energy_set_component(aname,avalue)
71      implicit none
72#include "errquit.fh"
73#include "inp.fh"
74#include "mafdecls.fh"
75#include "rtdb.fh"
76#include "global.fh"
77#include "smd_energy_data.fh"
78c
79      character*(*) aname
80      double precision avalue
81c
82      character*32 pname
83      integer nrec
84      integer i
85      logical result
86      logical ocase
87      integer i_e
88      integer i_oe
89      character*32 sp_energy
90      character*32 tag
91c
92      pname = "smd_energy_set_component"
93c
94c      write(*,*) "in "//pname
95c
96      call smd_system_get_component(sp_energy,"energy",result)
97      if(.not.result)
98     >  call errquit(
99     >       pname//'no energy ',0,0)
100
101      tag = "energy"
102      call smd_data_get_index(sp_energy,tag,i_e,result)
103      if(.not. result)
104     >  call errquit(
105     >       pname//'error getting index for '//tag,0, RTDB_ERR)
106      tag = "oenergy"
107      call smd_data_get_index(sp_energy,tag,i_oe,result)
108      if(.not. result)
109     >  call errquit(
110     >       pname//'error getting index for '//tag,0, RTDB_ERR)
111
112c
113c     case sensitive
114      ocase = .true.
115c
116      nrec = smd_energy_nc
117c
118      tag = aname
119      result = inp_match(nrec,ocase,aname,smd_energy_name,i)
120      if(.not. result)
121     >  call errquit(
122     >       pname//'no component '//tag,0, RTDB_ERR)
123
124      dbl_mb(i_e+i-1) = avalue
125      log_mb(i_oe+i-1) = .true.
126
127      return
128      end
129
130      subroutine smd_energy_unset_component(aname)
131      implicit none
132#include "errquit.fh"
133#include "inp.fh"
134#include "mafdecls.fh"
135#include "rtdb.fh"
136#include "global.fh"
137#include "smd_energy_data.fh"
138c
139      character*(*) aname
140c
141      character*32 pname
142      integer nrec
143      integer i
144      logical result
145      logical ocase
146      integer i_e
147      integer i_oe
148      character*32 sp_energy
149      character*32 tag
150cc
151      pname = "smd_energy_set_component"
152c
153      write(*,*) "in "//pname
154c
155      call smd_system_get_component(sp_energy,"energy",result)
156      if(.not.result)
157     >  call errquit(
158     >       pname//'no energy ',0,0)
159
160      tag = "energy"
161      call smd_data_get_index(sp_energy,tag,i_e,result)
162      if(.not. result)
163     >  call errquit(
164     >       pname//'error getting index for '//tag,0, RTDB_ERR)
165      tag = "oenergy"
166      call smd_data_get_index(sp_energy,tag,i_oe,result)
167      if(.not. result)
168     >  call errquit(
169     >       pname//'error getting index for '//tag,0, RTDB_ERR)
170c
171c     case sensitive
172      ocase = .true.
173c
174      nrec = smd_energy_nc
175c
176      tag = aname
177      result = inp_match(nrec,ocase,aname,smd_energy_name,i)
178      if(.not. result)
179     >  call errquit(
180     >       pname//'no component '//tag,0, RTDB_ERR)
181
182      log_mb(i_oe+i-1) = .false.
183      dbl_mb(i_e+i-1) = 0.0d0
184
185      return
186      end
187
188      subroutine smd_energy_get_component(avalue,aname,oexist)
189      implicit none
190#include "errquit.fh"
191#include "inp.fh"
192#include "mafdecls.fh"
193#include "rtdb.fh"
194#include "global.fh"
195#include "smd_energy_data.fh"
196c
197      character*(*) aname
198      double precision avalue
199c
200      character*32 pname
201      integer nrec
202      integer i
203      logical oexist,result
204      logical ocase
205      integer i_e
206      integer i_oe
207      character*32 sp_energy
208      character*32 tag
209c
210      pname = "smd_energy_get_component"
211c
212      write(*,*) "in "//pname
213c
214      call smd_system_get_component(sp_energy,"energy",result)
215      if(.not.result)
216     >  call errquit(
217     >       pname//'no energy ',0,0)
218
219      tag = "energy"
220      call smd_data_get_index(sp_energy,tag,i_e,result)
221      if(.not. result)
222     >  call errquit(
223     >       pname//'error getting index for '//tag,0, RTDB_ERR)
224      tag = "oenergy"
225      call smd_data_get_index(sp_energy,tag,i_oe,result)
226      if(.not. result)
227     >  call errquit(
228     >       pname//'error getting index for '//tag,0, RTDB_ERR)
229c
230c     case sensitive
231      ocase = .true.
232c
233      nrec = smd_energy_nc
234c
235      tag = aname
236      result = inp_match(nrec,ocase,aname,smd_energy_name,i)
237      if(.not. result)
238     >  call errquit(
239     >       pname//'no component '//tag,0, RTDB_ERR)
240
241      avalue = dbl_mb(i_e+i-1)
242      oexist = log_mb(i_oe+i-1)
243
244      return
245      end
246
247      subroutine smd_energy_print(un)
248      implicit none
249#include "errquit.fh"
250#include "inp.fh"
251#include "mafdecls.fh"
252#include "rtdb.fh"
253#include "global.fh"
254#include "smd_energy_data.fh"
255c
256      integer un
257c
258      character*32 pname
259      integer nrec
260      integer i
261      logical oexist,result
262      logical ocase
263      integer i_e
264      integer i_oe
265      character*32 sp_energy
266      character*32 tag
267c
268      pname = "smd_energy_print"
269c
270c      write(*,*) "in "//pname
271c
272      call smd_system_get_component(sp_energy,"energy",result)
273      if(.not.result)
274     >  call errquit(
275     >       pname//'no energy ',0,0)
276
277      tag = "energy"
278      call smd_data_get_index(sp_energy,tag,i_e,result)
279      if(.not. result)
280     >  call errquit(
281     >       pname//'error getting index for '//tag,0, RTDB_ERR)
282      tag = "oenergy"
283      call smd_data_get_index(sp_energy,tag,i_oe,result)
284      if(.not. result)
285     >  call errquit(
286     >       pname//'error getting index for '//tag,0, RTDB_ERR)
287c
288      do i=1,smd_energy_nc
289        oexist = log_mb(i_oe+i-1)
290        if(oexist)
291     >     write(un,'(A16," : ", F16.6)')
292     >     smd_energy_name(i),dbl_mb(i_e+i-1)
293      end do
294
295      return
296      end
297
298      subroutine smd_energy_compute()
299      implicit none
300#include "errquit.fh"
301#include "inp.fh"
302#include "mafdecls.fh"
303#include "rtdb.fh"
304#include "global.fh"
305#include "smd_energy_data.fh"
306c
307      integer un
308c
309      character*32 pname
310      integer nrec
311      integer i
312      logical oexist,result
313      logical ocase
314      integer i_e
315      integer i_oe
316      character*32 sp_energy
317      character*32 tag
318c
319      pname = "smd_energy_compute"
320c
321      write(*,*) "in "//pname
322c
323      call smd_system_get_component(sp_energy,"energy",result)
324      if(.not.result)
325     >  call errquit(
326     >       pname//'no energy ',0,0)
327
328      tag = "energy"
329      call smd_data_get_index(sp_energy,tag,i_e,result)
330      if(.not. result)
331     >  call errquit(
332     >       pname//'error getting index for '//tag,0, RTDB_ERR)
333      tag = "oenergy"
334      call smd_data_get_index(sp_energy,tag,i_oe,result)
335      if(.not. result)
336     >  call errquit(
337     >       pname//'error getting index for '//tag,0, RTDB_ERR)
338c
339      dbl_mb(i_e+3) = 0.0d0
340      do i=5,8
341          dbl_mb(i_e+3) = dbl_mb(i_e+3)+ dbl_mb(i_e+i-1)
342      end do
343      log_mb(i_oe+3) = .true.
344
345      dbl_mb(i_e) = 0.0d0
346      do i=2,4
347          dbl_mb(i_e) = dbl_mb(i_e)+ dbl_mb(i_e+i-1)
348      end do
349      log_mb(i_oe) = .true.
350
351      return
352      end
353
354c $Id$
355