← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/smd/smdlib/smd_leapf_shake.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/smdlib/smd_leapf_shake.F
 
1
c
 
2
c $Id: smd_leapf_shake.F 19707 2010-10-29 17:59:36Z d3y133 $
 
3
c
 
4
 
 
5
      subroutine smd_leapf_shake(natms,
 
6
     >                           ntcons,
 
7
     >                           tstep,
 
8
     >                           ekin,
 
9
     >                           mass,
 
10
     >                           icon1,
 
11
     >                           icon2,
 
12
     >                           consdist,
 
13
     >                           ncc,
 
14
     >                           nvv,
 
15
     >                           dcc,
 
16
     >                           nrij,
 
17
     >                           orij,
 
18
     >                           fff,
 
19
     >                           vvv,
 
20
     >                           ccc)
 
21
 
 
22
      implicit none
 
23
c
 
24
      integer natms
 
25
      integer ntcons
 
26
      double precision tstep
 
27
      double precision ekin
 
28
      double precision mass(natms)
 
29
      integer          icon1(ntcons)
 
30
      integer          icon2(ntcons)
 
31
      double precision consdist(ntcons)
 
32
      double precision ncc(3,natms),nvv(3,natms),dcc(3,natms)
 
33
      double precision nrij(3,ntcons),orij(3,ntcons)
 
34
      double precision fff(3,natms)
 
35
      double precision vvv(3,natms)
 
36
      double precision ccc(3,natms)
 
37
 
 
38
      integer i,j,it,maxit,iatm1,iatm2
 
39
 
 
40
      double precision   force,rma,rmb
 
41
      double precision   tmpvx,tmpvy,tmpvz
 
42
      double precision   tstepsq,rtstep,tol,mxdiff
 
43
      double precision   nrijsq,dijsq,diffsq,dotprod
 
44
      character*(42) pname
 
45
 
 
46
      pname = "smd_leapf_shake"
 
47
      write(*,*) "in "//pname
 
48
 
 
49
      ekin=0.0
 
50
      tstepsq=tstep**2
 
51
      rtstep=1.0/tstep
 
52
      tol=1.0d-8
 
53
      maxit=100
 
54
      mxdiff = 0.0d0
 
55
 
 
56
 
 
57
      do i=1,ntcons
 
58
 
 
59
       iatm1=icon1(i)
 
60
       iatm2=icon2(i)
 
61
 
 
62
       orij(1,i)=ccc(1,iatm1)-ccc(1,iatm2)
 
63
       orij(2,i)=ccc(2,iatm1)-ccc(2,iatm2)
 
64
       orij(3,i)=ccc(3,iatm1)-ccc(3,iatm2)
 
65
 
 
66
      enddo
 
67
 
 
68
      call smd_lat_rebox(ntcons,orij)
 
69
 
 
70
      do i=1,natms
 
71
 
 
72
       ncc(1,i)=ccc(1,i)
 
73
       ncc(2,i)=ccc(2,i)
 
74
       ncc(3,i)=ccc(3,i)
 
75
 
 
76
       nvv(1,i)=vvv(1,i)+fff(1,i)*tstep/mass(i)
 
77
       nvv(2,i)=vvv(2,i)+fff(2,i)*tstep/mass(i)
 
78
       nvv(3,i)=vvv(3,i)+fff(3,i)*tstep/mass(i)
 
79
 
 
80
       ccc(1,i)=ncc(1,i)+tstep*nvv(1,i)
 
81
       ccc(2,i)=ncc(2,i)+tstep*nvv(2,i)
 
82
       ccc(3,i)=ncc(3,i)+tstep*nvv(3,i)
 
83
 
 
84
      enddo 
 
85
 
 
86
 
 
87
      do i=1,maxit
 
88
 
 
89
       do j=1,ntcons
 
90
 
 
91
        iatm1=icon1(j)
 
92
        iatm2=icon2(j)
 
93
 
 
94
        nrij(1,j)=ccc(1,iatm1)-ccc(1,iatm2)
 
95
        nrij(2,j)=ccc(2,iatm1)-ccc(2,iatm2)
 
96
        nrij(3,j)=ccc(3,iatm1)-ccc(3,iatm2)
 
97
 
 
98
       enddo
 
99
 
 
100
       call smd_lat_rebox(ntcons,nrij) 
 
101
 
 
102
       do j=1,natms
 
103
        dcc(1,j)=0.0
 
104
        dcc(2,j)=0.0
 
105
        dcc(3,j)=0.0
 
106
       enddo
 
107
 
 
108
       do j=1,ntcons
 
109
 
 
110
        iatm1=icon1(j)
 
111
        iatm2=icon2(j)
 
112
 
 
113
        nrijsq=nrij(1,j)**2+nrij(2,j)**2+nrij(3,j)**2
 
114
        dijsq=consdist(j)**2
 
115
        diffsq=dijsq-nrijsq
 
116
        mxdiff=max(mxdiff,abs(diffsq)/consdist(j))
 
117
 
 
118
        dotprod=orij(1,j)*nrij(1,j)
 
119
     $         +orij(2,j)*nrij(2,j)
 
120
     $         +orij(3,j)*nrij(3,j)
 
121
 
 
122
        rma= tstepsq/mass(iatm1)
 
123
        rmb=-tstepsq/mass(iatm2)
 
124
        force=diffsq/(-2.0*(rma-rmb)*dotprod)
 
125
 
 
126
        dcc(1,iatm1)=dcc(1,iatm1)-rma*orij(1,j)*force
 
127
        dcc(2,iatm1)=dcc(2,iatm1)-rma*orij(2,j)*force
 
128
        dcc(3,iatm1)=dcc(3,iatm1)-rma*orij(3,j)*force
 
129
        dcc(1,iatm2)=dcc(1,iatm2)-rmb*orij(1,j)*force
 
130
        dcc(2,iatm2)=dcc(2,iatm2)-rmb*orij(2,j)*force
 
131
        dcc(3,iatm2)=dcc(3,iatm2)-rmb*orij(3,j)*force
 
132
 
 
133
 
 
134
       enddo
 
135
 
 
136
       do j=1,ntcons
 
137
 
 
138
        iatm1=icon1(j)
 
139
        iatm2=icon2(j)
 
140
 
 
141
        ccc(1,iatm1)=ccc(1,iatm1)+0.5*dcc(1,iatm1)
 
142
        ccc(2,iatm1)=ccc(2,iatm1)+0.5*dcc(2,iatm1)
 
143
        ccc(3,iatm1)=ccc(3,iatm1)+0.5*dcc(3,iatm1)
 
144
        ccc(1,iatm2)=ccc(1,iatm2)+0.5*dcc(1,iatm2)
 
145
        ccc(2,iatm2)=ccc(2,iatm2)+0.5*dcc(2,iatm2)
 
146
        ccc(3,iatm2)=ccc(3,iatm2)+0.5*dcc(3,iatm2)
 
147
 
 
148
       enddo
 
149
 
 
150
       mxdiff=mxdiff*0.5
 
151
 
 
152
       if(mxdiff.lt.tol)goto 100
 
153
 
 
154
      enddo
 
155
 
 
156
100   continue
 
157
 
 
158
      do i=1,natms
 
159
 
 
160
       nvv(1,i)=(ccc(1,i)-ncc(1,i))*rtstep
 
161
       nvv(2,i)=(ccc(2,i)-ncc(2,i))*rtstep
 
162
       nvv(3,i)=(ccc(3,i)-ncc(3,i))*rtstep
 
163
 
 
164
       tmpvx=0.5*(nvv(1,i)+vvv(1,i))
 
165
       tmpvy=0.5*(nvv(2,i)+vvv(2,i))
 
166
       tmpvz=0.5*(nvv(3,i)+vvv(3,i))
 
167
 
 
168
       ekin=ekin+mass(i)*(tmpvx**2+tmpvy**2+tmpvz**2)
 
169
 
 
170
       fff(1,i)=(nvv(1,i)-vvv(1,i))*mass(i)*rtstep
 
171
       fff(2,i)=(nvv(2,i)-vvv(2,i))*mass(i)*rtstep
 
172
       fff(3,i)=(nvv(3,i)-vvv(3,i))*mass(i)*rtstep
 
173
 
 
174
       vvv(1,i)=nvv(1,i)
 
175
       vvv(2,i)=nvv(2,i)
 
176
       vvv(3,i)=nvv(3,i)
 
177
 
 
178
      enddo
 
179
 
 
180
 
 
181
      ekin=0.5*ekin
 
182
 
 
183
      write(*,*) "out "//pname
 
184
    
 
185
      return
 
186
 
 
187
      END