← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/smd/smd-subgroups/smd_coords.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
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* 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:
src/smd/smd-subgroups/smd_coords.F
1
 
      subroutine smd_coords_init_system()
2
 
      implicit none
3
 
#include "errquit.fh"
4
 
#include "inp.fh"
5
 
#include "mafdecls.fh"
6
 
#include "rtdb.fh"
7
 
#include "util.fh"
8
 
#include "global.fh"
9
 
c     
10
 
      character*32 sp_coords,sp_atom
11
 
      character*32 tag,pname
12
 
      logical result
13
 
 
14
 
      pname = "smd_coords_init_system"
15
 
c
16
 
      tag = "atom"
17
 
      call smd_system_get_component(sp_atom,tag,result)
18
 
      if(.not.result)
19
 
     >  call errquit(
20
 
     >       pname//'no component '//tag,0,0)
21
 
 
22
 
      tag = "coordinates"
23
 
      call smd_system_get_component(sp_coords,tag,result)
24
 
      if(.not.result)
25
 
     >  call errquit(
26
 
     >       pname//'no component '//tag,0,0)
27
 
 
28
 
      call smd_coords_init(sp_coords,sp_atom)
29
 
      
30
 
      call smd_coords_read(sp_coords)
31
 
c
32
 
      return
33
 
      end
34
 
 
35
 
      subroutine smd_coords_init(sp_coords,sp_atom)
36
 
      implicit none
37
 
#include "errquit.fh"
38
 
#include "inp.fh"
39
 
#include "mafdecls.fh"
40
 
#include "rtdb.fh"
41
 
#include "util.fh"
42
 
#include "global.fh"
43
 
c     
44
 
      character*(*) sp_coords
45
 
      character*(*) sp_atom
46
 
c
47
 
      character*32 pname
48
 
      integer na
49
 
c
50
 
      pname = "smd_coords_init"
51
 
c
52
 
c      write(*,*) "in "//pname
53
 
c
54
 
c     get total number of atoms 
55
 
c     -------------------------
56
 
      call smd_atom_ntot(sp_atom,na)
57
 
      if(na.le.0)
58
 
     >  call errquit(
59
 
     >       pname//'no atoms ',0, RTDB_ERR)
60
 
c
61
 
c     create coords data structures
62
 
c     ---------------------------
63
 
      call smd_namespace_create(sp_coords)
64
 
      call smd_data_create(sp_coords,"coords",3*na,MT_DBL)
65
 
 
66
 
      return
67
 
      end
68
 
 
69
 
      subroutine smd_coords_read(sp_coords)
70
 
      implicit none
71
 
#include "errquit.fh"
72
 
#include "inp.fh"
73
 
#include "mafdecls.fh"
74
 
#include "rtdb.fh"
75
 
#include "util.fh"
76
 
#include "global.fh"
77
 
c     
78
 
      character*(*) sp_coords
79
 
      integer rtdb
80
 
c
81
 
      character*32 pname
82
 
      character*72 tag
83
 
      integer i_c
84
 
      integer na
85
 
      logical result
86
 
c
87
 
      pname = "smd_coords_read"
88
 
c
89
 
      write(*,*) "in "//pname
90
 
c
91
 
c     fill in coordinates from pdb file if any
92
 
c     ----------------------------------------
93
 
      tag = "coords"
94
 
      call smd_data_get_index(sp_coords,tag,i_c,result)
95
 
      if(.not. result) 
96
 
     >  call errquit(
97
 
     >       pname//'error getting index for '//tag,0, RTDB_ERR)
98
 
c
99
 
      call smd_data_get_size(sp_coords,tag,na,result)
100
 
      if(.not. result) 
101
 
     >  call errquit(
102
 
     >       pname//'error getting index for '//tag,0, RTDB_ERR)
103
 
      if(na.le.0)
104
 
     >call errquit(
105
 
     >     pname//'no atoms ',0, RTDB_ERR)
106
 
      na = na/3
107
 
 
108
 
 
109
 
      call smd_coordfile_read_coords(na,
110
 
     +                          dbl_mb(i_c))
111
 
 
112
 
 
113
 
      return
114
 
      end
115
 
 
116
 
      subroutine smd_coords_rebox()
117
 
      implicit none
118
 
#include "errquit.fh"
119
 
#include "inp.fh"
120
 
#include "mafdecls.fh"
121
 
#include "rtdb.fh"
122
 
#include "util.fh"
123
 
#include "global.fh"
124
 
c     
125
 
      character*32 sp_coords
126
 
c
127
 
      character*72 tag
128
 
      character*30 pname
129
 
      integer na
130
 
      integer i_c,i_lrc,i_lc
131
 
      logical result
132
 
 
133
 
      pname = "smd_atom_rebox"
134
 
 
135
 
c
136
 
c     get atomic coordinates
137
 
c     ----------------------
138
 
      call smd_system_get_component(sp_coords,"coordinates",result)
139
 
      if(.not.result)
140
 
     >  call errquit(
141
 
     >       pname//'no coordinates ',0,0)
142
 
 
143
 
      tag = "coords"
144
 
      call smd_data_get_index(sp_coords,tag,i_c,result)
145
 
      if(.not. result)
146
 
     >  call errquit(
147
 
     >       pname//'error getting index for '//tag,0, RTDB_ERR)
148
 
 
149
 
      call smd_data_get_size(sp_coords,tag,na,result)
150
 
      if(.not. result)
151
 
     >  call errquit(
152
 
     >       pname//'error getting index for '//tag,0, RTDB_ERR)
153
 
 
154
 
      na = na/3
155
 
 
156
 
      call smd_lat_rebox(na,
157
 
     >                    dbl_mb(i_c))
158
 
 
159
 
      return
160
 
      end
161
 
 
162
 
      subroutine smd_coords_print(un)
163
 
      implicit none
164
 
#include "errquit.fh"
165
 
#include "inp.fh"
166
 
#include "mafdecls.fh"
167
 
#include "rtdb.fh"
168
 
#include "util.fh"
169
 
#include "global.fh"
170
 
c     
171
 
      integer un
172
 
      character*32 sp_coords
173
 
c
174
 
      character*72 tag
175
 
      character*30 pname
176
 
      integer na
177
 
      integer i_c,i_lrc,i_lc
178
 
      logical result
179
 
 
180
 
      pname = "smd_atom_rebox"
181
 
 
182
 
c
183
 
c     get atomic coordinates
184
 
c     ----------------------
185
 
      call smd_system_get_component(sp_coords,"coordinates",result)
186
 
      if(.not.result)
187
 
     >  call errquit(
188
 
     >       pname//'no coordinates ',0,0)
189
 
 
190
 
      tag = "coords"
191
 
      call smd_data_get_index(sp_coords,tag,i_c,result)
192
 
      if(.not. result)
193
 
     >  call errquit(
194
 
     >       pname//'error getting index for '//tag,0, RTDB_ERR)
195
 
 
196
 
      call smd_data_get_size(sp_coords,tag,na,result)
197
 
      if(.not. result)
198
 
     >  call errquit(
199
 
     >       pname//'error getting index for '//tag,0, RTDB_ERR)
200
 
 
201
 
      na = na/3
202
 
 
203
 
      
204
 
      call smd_util_print_force_array(un,na,
205
 
     >                           dbl_mb(i_c))  
206
 
 
207
 
      return
208
 
      end
209
 
 
210
 
      subroutine smd_coords_update()
211
 
      implicit none
212
 
#include "errquit.fh"
213
 
#include "inp.fh"
214
 
#include "mafdecls.fh"
215
 
#include "rtdb.fh"
216
 
#include "util.fh"
217
 
#include "smd_system.fh"
218
 
c     
219
 
      character*72 sp_vel
220
 
      character*72 sp_coords
221
 
      character*72 sp_mass
222
 
      character*72 sp_force
223
 
      character*72 sp_shakelist
224
 
      character*32 pname
225
 
      character*80 tag
226
 
      integer nt,na
227
 
      integer i_f
228
 
      integer i_m,i_c,i_v
229
 
      logical result
230
 
      integer rtdb
231
 
      double precision ekin, tstep
232
 
      logical oshake
233
 
      integer i_is1,i_is2,i_ds,ns
234
 
      integer h_ncc,i_ncc
235
 
      integer h_nvv,i_nvv
236
 
      integer h_dcc,i_dcc
237
 
      integer h_nrij,i_nrij
238
 
      integer h_orij,i_orij
239
 
c
240
 
      pname = "smd_coords_update"
241
 
c
242
 
c      write(*,*) "in "//pname
243
 
c
244
 
      call  smd_rtdb_get_handle(rtdb)
245
 
c
246
 
c     get components
247
 
c     --------------
248
 
      tag = "velocity"
249
 
      call smd_system_get_component(sp_vel,tag,result)
250
 
      if(.not.result)
251
 
     >  call errquit(
252
 
     >       pname//'no component '//tag,0,0)
253
 
 
254
 
      tag = "mass"
255
 
      call smd_system_get_component(sp_mass,tag,result)
256
 
      if(.not.result)
257
 
     >  call errquit(
258
 
     >       pname//'no component '//tag,0,0)
259
 
 
260
 
      tag = "force"
261
 
      call smd_system_get_component(sp_force,tag,result)
262
 
      if(.not.result)
263
 
     >  call errquit(
264
 
     >       pname//'no component '//tag,0,0)
265
 
 
266
 
      tag = "coordinates"
267
 
      call smd_system_get_component(sp_coords,tag,result)
268
 
      if(.not.result)
269
 
     >  call errquit(
270
 
     >       pname//'no component '//tag,0,0)
271
 
 
272
 
c
273
 
c     get velocity array
274
 
c     ------------------
275
 
      tag = "vel"
276
 
      call smd_data_get_index(sp_vel,tag,i_v,result)
277
 
      if(.not. result) 
278
 
     >  call errquit(
279
 
     >       pname//'error getting index for'//tag,0, 0)
280
 
      call  smd_data_get_size(sp_vel,tag,na,result)
281
 
      if(.not. result)
282
 
     >  call errquit(
283
 
     >       pname//'error getting index for'//tag,0, 0)
284
 
      na = na/3
285
 
 
286
 
c
287
 
c     get mass array
288
 
c     ------------------
289
 
      tag = "mass"
290
 
      call smd_data_get_index(sp_mass,tag,i_m,result)
291
 
      if(.not. result) 
292
 
     >  call errquit(
293
 
     >       pname//'error getting index for'//tag,0, 0)
294
 
c
295
 
c     get force array
296
 
c     ---------------
297
 
      tag = "force"
298
 
      call smd_data_get_index(sp_force,tag,i_f,result)
299
 
      if(.not. result) 
300
 
     >  call errquit(
301
 
     >       pname//'error getting index for'//tag,0, 0)
302
 
 
303
 
c
304
 
c     get coord array
305
 
c     ---------------
306
 
      tag = "coords"
307
 
      call smd_data_get_index(sp_coords,tag,i_c,result)
308
 
      if(.not. result) 
309
 
     >  call errquit(
310
 
     >       pname//'error getting index for'//tag,0, 0)
311
 
 
312
 
c
313
 
c     get time step
314
 
c     -------------
315
 
      tag="smd:step"
316
 
        if (.not.rtdb_get(rtdb,tag,mt_dbl,1,tstep)) 
317
 
     >      call errquit(pname//'failed to store'//tag,0,
318
 
     >       RTDB_ERR)
319
 
 
320
 
 
321
 
      oshake = smd_system_shake()
322
 
 
323
 
      if(oshake) then
324
 
 
325
 
        tag = "shakelist"
326
 
        call smd_system_get_component(sp_shakelist,tag,result)
327
 
        if(.not.result)
328
 
     >    call errquit(
329
 
     >         pname//'no component '//tag,0,0)
330
 
 
331
 
        tag = "shake:i1"
332
 
        call smd_data_get_index(sp_shakelist,tag,i_is1,result)
333
 
        if(.not. result) 
334
 
     >    call errquit(
335
 
     >         pname//'error getting index for '//tag,0, 0)
336
 
 
337
 
        tag = "shake:i2"
338
 
        call smd_data_get_index(sp_shakelist,tag,i_is2,result)
339
 
        if(.not. result) 
340
 
     >    call errquit(
341
 
     >         pname//'error getting index for '//tag,0, 0)
342
 
 
343
 
        tag = "shake:distance"
344
 
        call smd_data_get_index(sp_shakelist,tag,i_ds,result)
345
 
        if(.not. result) 
346
 
     >    call errquit(
347
 
     >         pname//'error getting index for '//tag,0, 0)
348
 
 
349
 
        call smd_data_get_size(sp_shakelist,tag,ns,result)
350
 
        if(.not. result) 
351
 
     >    call errquit(
352
 
     >         pname//'error getting size for '//tag,0, 0)
353
 
 
354
 
        if(.not.ma_push_get(mt_dbl,na*3,'i_ncc',h_ncc,i_ncc))
355
 
     +   call errquit(pname//'Failed to allocate memory',
356
 
     +   0, MA_ERR)
357
 
 
358
 
        if(.not.ma_push_get(mt_dbl,na*3,'i_nvv',h_nvv,i_nvv))
359
 
     +   call errquit(pname//'Failed to allocate memory',
360
 
     +   0, MA_ERR)
361
 
 
362
 
        if(.not.ma_push_get(mt_dbl,na*3,'i_dcc',h_dcc,i_dcc))
363
 
     +   call errquit(pname//'Failed to allocate memory',
364
 
     +   0, MA_ERR)
365
 
 
366
 
        if(.not.ma_push_get(mt_dbl,ns*3,'i_nrij',h_nrij,i_nrij))
367
 
     +   call errquit(pname//'Failed to allocate memory',
368
 
     +   0, MA_ERR)
369
 
 
370
 
        if(.not.ma_push_get(mt_dbl,ns*3,'i_orij',h_orij,i_orij))
371
 
     +   call errquit(pname//'Failed to allocate memory',
372
 
     +   0, MA_ERR)
373
 
 
374
 
      end if
375
 
      if(oshake) then
376
 
            call smd_leapf_shake(na,
377
 
     >                           ns,
378
 
     >                           tstep,
379
 
     >                           ekin,
380
 
     >                           dbl_mb(i_m),
381
 
     >                           int_mb(i_is1),
382
 
     >                           int_mb(i_is2),
383
 
     >                           dbl_mb(i_ds),
384
 
     >                           dbl_mb(i_ncc),
385
 
     >                           dbl_mb(i_nvv),
386
 
     >                           dbl_mb(i_dcc),
387
 
     >                           dbl_mb(i_nrij),
388
 
     >                           dbl_mb(i_orij),
389
 
     >                           dbl_mb(i_f),
390
 
     >                           dbl_mb(i_v),
391
 
     >                           dbl_mb(i_c))
392
 
 
393
 
 
394
 
      else
395
 
      call smd_leapf(na,
396
 
     >                 tstep,
397
 
     >                 ekin,
398
 
     >                 dbl_mb(i_m),
399
 
     >                 dbl_mb(i_f),
400
 
     >                 dbl_mb(i_v),
401
 
     >                 dbl_mb(i_c))
402
 
 
403
 
      end if
404
 
 
405
 
      call smd_coords_rebox()
406
 
 
407
 
      if(oshake) then
408
 
 
409
 
        if(.not.ma_pop_stack(h_orij))
410
 
     &   call errquit(pname//'Failed to deallocate stack h_orij',0,
411
 
     &         MA_ERR)
412
 
 
413
 
        if(.not.ma_pop_stack(h_nrij))
414
 
     &   call errquit(pname//'Failed to deallocate stack h_nrij',0,
415
 
     &         MA_ERR)
416
 
 
417
 
        if(.not.ma_pop_stack(h_dcc))
418
 
     &   call errquit(pname//'Failed to deallocate stack h_dcc',0,
419
 
     &         MA_ERR)
420
 
 
421
 
        if(.not.ma_pop_stack(h_nvv))
422
 
     &   call errquit(pname//'Failed to deallocate stack h_nvv',0,
423
 
     &         MA_ERR)
424
 
 
425
 
 
426
 
        if(.not.ma_pop_stack(h_ncc))
427
 
     &   call errquit(pname//'Failed to deallocate stack h_ncc',0,
428
 
     &         MA_ERR)
429
 
 
430
 
      end if
431
 
 
432
 
      return
433
 
      end