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

« back to all changes in this revision

Viewing changes to src/smd/smd-subgroups/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
* 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
 
c
2
 
c $Id: smd_leapf_shake.F,v 1.1 2008-04-18 17:48:13 marat Exp $
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(natms,3),nvv(natms,3),dcc(natms,3)
33
 
      double precision nrij(ntcons,3),orij(ntcons,3)
34
 
      double precision fff(natms,3)
35
 
      double precision vvv(natms,3)
36
 
      double precision ccc(natms,3)
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
 
 
45
 
      ekin=0.0
46
 
      tstepsq=tstep**2
47
 
      rtstep=1.0/tstep
48
 
      tol=1.0d-8
49
 
      maxit=100
50
 
      mxdiff = 0.0d0
51
 
 
52
 
      write(40,*) ntcons
53
 
      do i=1,ntcons
54
 
 
55
 
       iatm1=icon1(i)
56
 
       iatm2=icon2(i)
57
 
 
58
 
       orij(i,1)=ccc(iatm1,1)-ccc(iatm2,1)
59
 
       orij(i,2)=ccc(iatm1,2)-ccc(iatm2,2)
60
 
       orij(i,3)=ccc(iatm1,3)-ccc(iatm2,3)
61
 
       write(40,*) consdist(i)
62
 
 
63
 
      enddo
64
 
 
65
 
      call smd_lat_rebox(ntcons,orij)
66
 
 
67
 
      do i=1,natms
68
 
 
69
 
       ncc(i,1)=ccc(i,1)
70
 
       ncc(i,2)=ccc(i,2)
71
 
       ncc(i,3)=ccc(i,3)
72
 
 
73
 
       nvv(i,1)=vvv(i,1)+fff(i,1)*tstep/mass(i)
74
 
       nvv(i,2)=vvv(i,2)+fff(i,2)*tstep/mass(i)
75
 
       nvv(i,3)=vvv(i,3)+fff(i,3)*tstep/mass(i)
76
 
 
77
 
       ccc(i,1)=ncc(i,1)+tstep*nvv(i,1)
78
 
       ccc(i,2)=ncc(i,2)+tstep*nvv(i,2)
79
 
       ccc(i,3)=ncc(i,3)+tstep*nvv(i,3)
80
 
 
81
 
      enddo 
82
 
 
83
 
 
84
 
      do i=1,maxit
85
 
 
86
 
       do j=1,ntcons
87
 
 
88
 
        iatm1=icon1(j)
89
 
        iatm2=icon2(j)
90
 
 
91
 
        nrij(j,1)=ccc(iatm1,1)-ccc(iatm2,1)
92
 
        nrij(j,2)=ccc(iatm1,2)-ccc(iatm2,2)
93
 
        nrij(j,3)=ccc(iatm1,3)-ccc(iatm2,3)
94
 
 
95
 
       enddo
96
 
       write(50,*) i,nrij(1,1), nrij(1,2),nrij(1,3)
97
 
 
98
 
       call smd_lat_rebox(ntcons,nrij) 
99
 
       write(50,*) i,nrij(1,1), nrij(1,2),nrij(1,3)
100
 
 
101
 
       do j=1,natms
102
 
        dcc(j,1)=0.0
103
 
        dcc(j,2)=0.0
104
 
        dcc(j,3)=0.0
105
 
       enddo
106
 
 
107
 
       do j=1,ntcons
108
 
 
109
 
        iatm1=icon1(j)
110
 
        iatm2=icon2(j)
111
 
 
112
 
        nrijsq=nrij(j,1)**2+nrij(j,2)**2+nrij(j,3)**2
113
 
        dijsq=consdist(j)**2
114
 
        diffsq=dijsq-nrijsq
115
 
        mxdiff=max(mxdiff,abs(diffsq)/consdist(j))
116
 
 
117
 
        dotprod=orij(j,1)*nrij(j,1)
118
 
     $         +orij(j,2)*nrij(j,2)
119
 
     $         +orij(j,3)*nrij(j,3)
120
 
 
121
 
        rma= tstepsq/mass(iatm1)
122
 
        rmb=-tstepsq/mass(iatm2)
123
 
        force=diffsq/(-2.0*(rma-rmb)*dotprod)
124
 
 
125
 
        dcc(iatm1,1)=dcc(iatm1,1)-rma*orij(j,1)*force
126
 
        dcc(iatm1,2)=dcc(iatm1,2)-rma*orij(j,2)*force
127
 
        dcc(iatm1,3)=dcc(iatm1,3)-rma*orij(j,3)*force
128
 
        dcc(iatm2,1)=dcc(iatm2,1)-rmb*orij(j,1)*force
129
 
        dcc(iatm2,2)=dcc(iatm2,2)-rmb*orij(j,2)*force
130
 
        dcc(iatm2,3)=dcc(iatm2,3)-rmb*orij(j,3)*force
131
 
 
132
 
        write(50,*) i,dotprod,diffsq
133
 
 
134
 
       enddo
135
 
 
136
 
       do j=1,ntcons
137
 
 
138
 
        iatm1=icon1(j)
139
 
        iatm2=icon2(j)
140
 
 
141
 
        ccc(iatm1,1)=ccc(iatm1,1)+0.5*dcc(iatm1,1)
142
 
        ccc(iatm1,2)=ccc(iatm1,2)+0.5*dcc(iatm1,2)
143
 
        ccc(iatm1,3)=ccc(iatm1,3)+0.5*dcc(iatm1,3)
144
 
        ccc(iatm2,1)=ccc(iatm2,1)+0.5*dcc(iatm2,1)
145
 
        ccc(iatm2,2)=ccc(iatm2,2)+0.5*dcc(iatm2,2)
146
 
        ccc(iatm2,3)=ccc(iatm2,3)+0.5*dcc(iatm2,3)
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(i,1)=(ccc(i,1)-ncc(i,1))*rtstep
161
 
       nvv(i,2)=(ccc(i,2)-ncc(i,2))*rtstep
162
 
       nvv(i,3)=(ccc(i,3)-ncc(i,3))*rtstep
163
 
 
164
 
       tmpvx=0.5*(nvv(i,1)+vvv(i,1))
165
 
       tmpvy=0.5*(nvv(i,2)+vvv(i,2))
166
 
       tmpvz=0.5*(nvv(i,3)+vvv(i,3))
167
 
 
168
 
       ekin=ekin+mass(i)*(tmpvx**2+tmpvy**2+tmpvz**2)
169
 
 
170
 
       fff(i,1)=(nvv(i,1)-vvv(i,1))*mass(i)*rtstep
171
 
       fff(i,2)=(nvv(i,2)-vvv(i,2))*mass(i)*rtstep
172
 
       fff(i,3)=(nvv(i,3)-vvv(i,3))*mass(i)*rtstep
173
 
 
174
 
       vvv(i,1)=nvv(i,1)
175
 
       vvv(i,2)=nvv(i,2)
176
 
       vvv(i,3)=nvv(i,3)
177
 
 
178
 
       write(30,*) fff(i,1),vvv(i,1),ncc(i,1)
179
 
      enddo
180
 
 
181
 
      ekin=0.5*ekin
182
 
 
183
 
      return
184
 
 
185
 
      END