~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/smd/smdlib/smd_energy.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      block data initial_smd_energy_data
 
2
      implicit none
 
3
#include "smd_energy_data.fh"
 
4
c     
 
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"
 
25
c     
 
26
      character*32 sp_energy
 
27
      character*32 tag,pname
 
28
      logical result
 
29
 
 
30
      pname = "smd_energy_init_system"
 
31
c
 
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"
 
52
c     
 
53
      character*(*) sp_energy
 
54
c
 
55
      character*32 pname
 
56
      integer na
 
57
c
 
58
      pname = "smd_energy_init"
 
59
c
 
60
c      write(*,*) "in "//pname
 
61
c
 
62
c     create energy data structures
 
63
c     ---------------------------
 
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"
 
78
c     
 
79
      character*(*) aname
 
80
      double precision avalue
 
81
c
 
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
 
91
c
 
92
      pname = "smd_energy_set_component"
 
93
c
 
94
c      write(*,*) "in "//pname
 
95
c
 
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
 
 
112
c
 
113
c     case sensitive
 
114
      ocase = .true.
 
115
c
 
116
      nrec = smd_energy_nc
 
117
c
 
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"
 
138
c     
 
139
      character*(*) aname
 
140
c
 
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
 
150
cc
 
151
      pname = "smd_energy_set_component"
 
152
c
 
153
      write(*,*) "in "//pname
 
154
c
 
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)
 
170
c
 
171
c     case sensitive
 
172
      ocase = .true.
 
173
c
 
174
      nrec = smd_energy_nc
 
175
c
 
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"
 
196
c     
 
197
      character*(*) aname
 
198
      double precision avalue
 
199
c
 
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
 
209
c
 
210
      pname = "smd_energy_get_component"
 
211
c
 
212
      write(*,*) "in "//pname
 
213
c
 
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)
 
229
c
 
230
c     case sensitive
 
231
      ocase = .true.
 
232
c
 
233
      nrec = smd_energy_nc
 
234
c
 
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"
 
255
c     
 
256
      integer un
 
257
c
 
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
 
267
c
 
268
      pname = "smd_energy_print"
 
269
c
 
270
c      write(*,*) "in "//pname
 
271
c
 
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)
 
287
c
 
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"
 
306
c     
 
307
      integer un
 
308
c
 
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
 
318
c
 
319
      pname = "smd_energy_compute"
 
320
c
 
321
      write(*,*) "in "//pname
 
322
c
 
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)
 
338
c
 
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
 
 
354
c $Id: smd_energy.F 21176 2011-10-10 06:35:49Z d3y133 $