source: enyflx.f@ e40e335

Last change on this file since e40e335 was e40e335, checked in by baerbaer <baerbaer@…>, 16 years ago

Initial import to BerliOS corresponding to 3.0.4

git-svn-id: svn+ssh://svn.berlios.de/svnroot/repos/smmp/trunk@1 26dc1dd8-5c4e-0410-9ffe-d298b4865968

  • Property mode set to 100644
File size: 5.7 KB
Line 
1c **************************************************************
2c
3c This file contains the subroutines: enyflx
4c
5c Copyright 2003 Frank Eisenmenger, U.H.E. Hansmann,
6c Shura Hayryan, Chin-Ku
7c Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
8c Jan H. Meinke, Sandipan Mohanty
9c
10c **************************************************************
11
12
13 real*8 function enyflx(nml)
14
15c .......................................................................
16c
17c PURPOSE: Calculate internal energy of molecule 'nml' with FLEX dataset
18c
19c CALLS: none
20c
21c .......................................................................
22
23 include 'INCL.H'
24
25 ntlvr=nvrml(nml)
26 if (ntlvr.eq.0) then
27 write (*,'(a,i4)')
28 # ' enyflx> No variables defined in molecule #',nml
29 return
30 endif
31
32 enyflx=0.0
33 eyel=0.0
34 eyvw=0.0
35 eyhb=0.0
36 eyvr=0.0
37
38 ifivr=ivrml1(nml)
39 i1s=imsml1(nml)+nmsml(nml)
40
41 do io=ifivr+ntlvr-1,ifivr,-1 ! ______ over variables in desc. order
42 iv=iorvr(io) ! index of var.
43
44 ia=iatvr(iv) ! prim.mv.at
45 it=ityvr(iv) ! type
46 ic=iclvr(iv) ! class
47
48 if (it.eq.3) then ! torsion
49 vr=toat(ia)
50
51 e0=e0to(ic)
52 if (e0.ne.0.0) eyvr=eyvr+e0*(1.0+sgto(ic)*cos(vr*rnto(ic)))
53
54 elseif (it.eq.2) then ! b.angle
55 vr=baat(ia)
56 elseif (it.eq.1) then ! b.length
57 vr=blat(ia)
58 endif
59
60 i2s=i1s-1 ! last m.s per 'iv'
61 i1s=imsvr1(iv) ! 1st m.s
62
63 do ims=i1s,i2s ! __ loop over m.s
64 i1=latms1(ims)
65 i2=latms2(ims)
66
67 do i=i1,i2 ! __ loop over atoms i ===================
68
69 ity=ityat(i)
70 cqi=conv*cgat(i)
71
72 xi=xat(i)
73 yi=yat(i)
74 zi=zat(i)
75
76 do ivw=ivwat1(i),ivwat2(i) ! over vdW-domains of 'i'
77 do j=lvwat1(ivw),lvwat2(ivw) ! atoms j
78
79 jty=ityat(j)
80
81 xj=xat(j)
82 yj=yat(j)
83 zj=zat(j)
84
85 xij=xj-xi
86 yij=yj-yi
87 zij=zj-zi
88
89 rij2=xij*xij+yij*yij+zij*zij
90 rij6=rij2**3
91 rij12=rij6*rij6
92 rij=sqrt(rij2)
93 if(epsd) then
94c --------------------------------- distance dependent dielectric constant
95 sr=slp_f*rij
96 ep=plt-(sr*sr+2.0*sr+2.0)*(plt-1.0)*exp(-sr)/2.0
97 else
98 ep=1.0d0
99 end if
100
101 eyel=eyel+cqi*cgat(j)/(rij*ep)
102
103 evw=aij(ity,jty)/rij12-cij(ity,jty)/rij6
104
105 ijhb=ihbty(ity,jty)
106 if (ijhb.ne.0.and.rij.le.cohb) then ! HB Possible
107
108 if (ijhb.gt.0) then ! i=H,j=acceptor
109 iowh=iowat(i)
110 px=xi-xat(iowh)
111 py=yi-yat(iowh)
112 pz=zi-zat(iowh)
113 else ! i=acceptor,j=H
114 jowh=iowat(j)
115 px=xat(jowh)-xj
116 py=yat(jowh)-yj
117 pz=zat(jowh)-zj
118 endif
119
120 cth=(xij*px+yij*py+zij*pz)/(rij*
121 # sqrt(px*px+py*py+pz*pz))
122
123 if (cth.gt.0.0) then
124 eyhb=eyhb+ evw + cth*(
125 # (ahb(ity,jty)-aij(ity,jty))/rij12-
126 # (chb(ity,jty)-cij(ity,jty))/rij6 )
127 else ! No Hydrogen Bond
128 eyvw=eyvw + evw
129 endif
130 else
131 eyvw=eyvw + evw
132 endif
133
134 enddo ! ... atoms j
135 enddo ! ... vdW-domains of i
136
137 do i14=i14at1(i),i14at2(i) ! over 1-4 partners of 'i'
138 j=l14at(i14)
139
140 jty=ityat(j)
141
142 xj=xat(j)
143 yj=yat(j)
144 zj=zat(j)
145
146 xij=xj-xi
147 yij=yj-yi
148 zij=zj-zi
149
150 rij2=xij*xij+yij*yij+zij*zij
151 rij6=rij2**3
152 rij12=rij6*rij6
153 rij=sqrt(rij2)
154 if(epsd) then
155c --------------------------------- distance dependent dielectric constant
156 sr=slp_f*rij
157 ep=plt-(sr*sr+2.0*sr+2.0)*(plt-1.)*exp(-sr)/2.0
158 else
159 ep=1.0d0
160 end if
161
162 eyel=eyel+ cqi*cgat(j)/(rij*ep)
163
164 evw=a14(ity,jty)/rij12-cij(ity,jty)/rij6
165
166 ijhb=ihbty(ity,jty)
167 if (ijhb.ne.0.and.rij.le.cohb) then ! HB Possible
168
169 if (ijhb.gt.0) then ! i=H,j=acceptor
170 iowh=iowat(i)
171 px=xi-xat(iowh)
172 py=yi-yat(iowh)
173 pz=zi-zat(iowh)
174 else ! i=acceptor,j=H
175 jowh=iowat(j)
176 px=xat(jowh)-xj
177 py=yat(jowh)-yj
178 pz=zat(jowh)-zj
179 endif
180
181 cth=(xij*px+yij*py+zij*pz)/(rij*
182 # sqrt(px*px+py*py+pz*pz))
183
184 if (cth.gt.0.0) then
185 eyhb=eyhb+ evw + cth*(
186 # (ahb(ity,jty)-a14(ity,jty))/rij12-
187 # (chb(ity,jty)-cij(ity,jty))/rij6 )
188 else ! No Hydrogen Bond
189 eyvw=eyvw + evw
190 endif
191 else
192 eyvw=eyvw + evw
193 endif
194
195 enddo ! ... 1-4-partners of i
196
197 enddo ! ... atoms i
198 enddo ! ... m.s.
199
200 enddo ! ... variables
201
202 eysm = eyel + eyvw + eyhb + eyvr
203 enyflx=eysm
204 return
205 end
206
Note: See TracBrowser for help on using the repository browser.