source: enysol.f@ bd2278d

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

Reformatting comments and continuation marks.

Fortran 90 and higher use ! to mark comments no matter where they are in the
code. The only valid continuation marker is &.
I also added the SMMP.kdevelop.filelist to the repository to make it easier
to use kdevelop.

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

  • Property mode set to 100644
File size: 9.3 KB
Line 
1! **************************************************************
2!
3! This file contains the subroutines: enysol,tessel
4!
5! Copyright 2003-2005 Frank Eisenmenger, U.H.E. Hansmann,
6! Shura Hayryan, Chin-Ku
7! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
8! Jan H. Meinke, Sandipan Mohanty
9!
10! **************************************************************
11
12
13 real*8 function enysol(nmol)
14
15 include 'INCL.H'
16! --------------------------------------------------------------
17!
18! Double Cubic Lattice algorithm for calculating the
19! solvation energy of proteins using
20! solvent accessible area method.
21!
22! if nmol == 0 do solvation energy over all residues.
23! CALLS: nursat
24!
25! -------------------------------------------------------------
26! TODO: Check the solvent energy for multiple molecules
27 dimension numbox(mxat),inbox(mxbox+1),indsort(mxat),look(mxat)
28 dimension xyz(mxinbox,3),radb(mxinbox),radb2(mxinbox)
29 logical surfc(mxpoint)
30
31! common/ressurf/surfres(mxrs)
32
33 eyslh = 0.0
34 eyslp = 0.0
35 if (nmol.eq.0) then
36 nrslow=irsml1(1)
37 nrshi=irsml2(ntlml)
38 else
39 nrslow = irsml1(nmol)
40 nrshi = irsml2(nmol)
41 endif
42 nlow = iatrs1(nrslow)
43 nup = iatrs2(nrshi)
44 do i=nrslow,nrshi
45 surfres(i) = 0.0d0
46 end do
47
48 numat= nup - nlow + 1
49
50 do i=1,mxbox+1
51 inbox(i)=0
52 end do
53
54 asa=0.0d0
55 vdvol=0.0d0
56 eysl=0.0d0
57
58 avr_x=xat(nlow)
59 avr_y=yat(nlow)
60 avr_z=zat(nlow)
61 xmin=xat(nlow)
62 ymin=yat(nlow)
63 zmin=zat(nlow)
64 xmax=xmin
65 ymax=ymin
66 zmax=zmin
67
68 rmax=rvdw(nlow)
69
70 do j=nlow+1,nup
71 if(xat(j).le.xmin) then
72 xmin=xat(j)
73 else if(xat(j).ge.xmax) then
74 xmax=xat(j)
75 end if
76 avr_x=avr_x+xat(j)
77 if(yat(j).le.ymin) then
78 ymin=yat(j)
79 else if(yat(j).ge.ymax) then
80 ymax=yat(j)
81 end if
82 avr_y=avr_y+yat(j)
83 if(zat(j).le.zmin) then
84 zmin=zat(j)
85 else if(zat(j).ge.zmax) then
86 zmax=zat(j)
87 end if
88 avr_z=avr_z+zat(j)
89 if(rvdw(j).ge.rmax) rmax=rvdw(j)
90 end do
91
92 avr_x=avr_x/dble(numat)
93 avr_y=avr_y/dble(numat)
94 avr_z=avr_z/dble(numat)
95 diamax=2.d0*rmax
96
97! The sizes of the big box
98
99 sizex=xmax-xmin
100 sizey=ymax-ymin
101 sizez=zmax-zmin
102
103! How many maximal diameters in each size ?
104
105 ndx=sizex/diamax + 1
106 ndy=sizey/diamax + 1
107 ndz=sizez/diamax + 1
108
109! We may need the number of quadratic boxes in (X,Y) plane
110
111 nqxy=ndx*ndy
112
113! The number of cubic boxes of the size "diamax"
114
115 ncbox=nqxy*ndz
116 if(ncbox.ge.mxbox) then
117 print *,'enysol> bad ncbox',ncbox
118 stop
119 end if
120
121! Let us shift the borders to home all boxes
122
123 shiftx=(dble(ndx)*diamax-sizex)/2.d0
124 shifty=(dble(ndy)*diamax-sizey)/2.d0
125 shiftz=(dble(ndz)*diamax-sizez)/2.d0
126 xmin=xmin-shiftx
127 ymin=ymin-shifty
128 zmin=zmin-shiftz
129 xmax=xmax+shiftx
130 ymax=ymax+shifty
131 zmax=zmax+shiftz
132
133! Finding the box of each atom
134
135 do j=nlow,nup
136 mx=min(int(max((xat(j)-xmin)/diamax,0.0d0)),ndx-1)
137 my=min(int(max((yat(j)-ymin)/diamax,0.0d0)),ndy-1)
138 mz=min(int(max((zat(j)-zmin)/diamax,0.0d0)),ndz-1)
139 nboxj=mx+my*ndx+mz*nqxy+1
140 numbox(j)=nboxj
141 if (nboxj.gt.mxbox) then
142 write(*,'(a)') 'enysol> bad mxboxe-2'
143 write(*,*) 'diagnostics ...'
144 write(*,*) 'atom ',j
145 write(*,*) 'position ',xat(j),yat(j),zat(j)
146 write(*,*) 'box indices ',mx,my,mz
147 write(*,*) 'resulting boxindex and limit ',nboxj,mxbox
148
149 stop
150 else
151 inbox(nboxj)=inbox(nboxj)+1
152 end if
153 end do
154
155! Summation over the boxes
156
157 do i=1,ncbox
158 inbox(i+1)=inbox(i+1)+inbox(i)
159 end do
160
161
162! Sorting the atoms by the their box numbers
163
164 do i=nlow,nup
165 j=numbox(i)
166 jj=inbox(j)
167 indsort(jj)=i
168 inbox(j)=jj-1
169 end do
170
171! Getting started
172
173 do iz=0,ndz-1 ! Over the boxes along Z-axis
174 do iy=0,ndy-1 !Over the boxes along Y-axis
175 do ix=0,ndx-1 !Over the boxes along X-axis
176
177 ibox=ix+iy*ndx+iz*nqxy + 1
178
179! Does this box contain atoms ?
180
181 lbn=inbox(ibox+1)-inbox(ibox)
182
183 if(lbn.gt.0) then ! There are some atoms
184 nsx=max(ix-1,0)
185 nsy=max(iy-1,0)
186 nsz=max(iz-1,0)
187 nex=min(ix+1,ndx-1)
188 ney=min(iy+1,ndy-1)
189 nez=min(iz+1,ndz-1)
190
191! Atoms in the boxes around
192
193 jcnt=1
194 do jz=nsz,nez
195 do jy=nsy,ney
196 do jx=nsx,nex
197 jbox=jx+jy*ndx+jz*nqxy+1
198 do ii=inbox(jbox)+1,inbox(jbox+1)
199 if(rvdw(indsort(ii)).gt.0.0d0) then
200 look(jcnt)=indsort(ii)
201 jcnt=jcnt+1
202 end if
203 end do
204 end do
205 end do
206 end do
207
208 do ia=inbox(ibox)+1,inbox(ibox+1)
209 jbi=indsort(ia)
210 trad=rvdw(jbi)
211 if(trad.gt.0.0) then
212 nnei=0
213 do ib=1,jcnt-1
214 jtk=look(ib)
215 if(jtk.ne.jbi)then
216 dx=(xat(jbi)-xat(jtk))/trad
217 dy=(yat(jbi)-yat(jtk))/trad
218 dz=(zat(jbi)-zat(jtk))/trad
219 dd=dx*dx+dy*dy+dz*dz
220 akrad=rvdw(jtk)/trad
221 dr=1.0d0+akrad
222 dr=dr*dr
223!c if contact
224 if(dd.le.dr) then
225 nnei=nnei+1
226 xyz(nnei,1)=dx
227 xyz(nnei,2)=dy
228 xyz(nnei,3)=dz
229 radb(nnei)=akrad
230 radb2(nnei)=akrad*akrad
231 end if
232 end if
233 end do
234!c
235 do il=1,npnt
236 surfc(il)=.false.
237 end do
238
239! Check overlap
240
241 lst=1
242 do il=1,npnt
243 sdd = 0.0d0
244 do ilk=1,3
245 sdd = sdd +(xyz(lst,ilk)+spoint(il,ilk))**2
246 end do
247 if(sdd.gt.radb2(lst)) then
248 do ik=1,nnei
249 sdd =0.0d0
250 do ilk=1,3
251 sdd = sdd +(xyz(ik,ilk)+spoint(il,ilk))**2
252 end do
253 if(sdd.le.radb2(ik)) then
254 lst=ik
255 go to 99
256 end if
257 end do
258 99 continue
259
260 if(ik.gt.nnei)then
261 surfc(il)=.true.
262 end if
263 end if
264 end do
265
266 icount=0
267 dx=0.0d0
268 dy=0.0d0
269 dz=0.0d0
270 do il=1,npnt
271 if(surfc(il)) then
272 icount=icount+1
273 dx=dx+spoint(il,1)
274 dy=dy+spoint(il,2)
275 dz=dz+spoint(il,3)
276 end if
277 end do
278 sdr=4.d0*pi*trad*trad/dble(npnt)
279 area = sdr*dble(icount)
280 volume = sdr/3.0d0*(trad*dble(icount)
281 & +(xat(jbi)-avr_x)*dx
282 & +(yat(jbi)-avr_y)*dy
283 & +(zat(jbi)-avr_z)*dz)
284
285 asa=asa+area
286 vdvol=vdvol+volume
287 eysl=eysl+area*sigma(jbi)
288! Separate hydrophilic (h) and hyrdophobic (p) contributions to eysl
289 if (sigma(jbi).lt.0) then
290 eyslp = eyslp + area * sigma(jbi)
291 asap = asap + area
292 endif
293 if (sigma(jbi).gt.0) then
294 eyslh = eyslh + area * sigma(jbi)
295 asah = asah + area
296 endif
297! Measure how much a residue is solvent accessible:
298 jres = nursat(jbi)
299 surfres(jres) = surfres(jres) + area
300 end if
301 end do
302 end if
303 end do
304 end do
305 end do
306
307!
308 if (isolscl) then
309 nhx=0
310 mhx=0
311 nbt=0
312 mbt=0
313 call helix(nhx,mhx,nbt,mbt)
314 eysl=((nhx+nbt)*eysl)/(irsml2(ntlml)-irsml1(1))
315 endif
316
317 enysol = eysl
318
319 return
320 end
321! *********************
322 subroutine tessel
323 include 'INCL.H'
324 character lin*80
325
326! Skipping comment lines, which begin with '!'
327 read(20,'(a)') lin
328 do while(lin(1:1).eq.'!')
329 read (20,'(a)') lin
330 end do
331
332! The first non-comment line is the number of the surface points
333
334 read(lin(1:5),'(i5)') npnt
335! write(*,'(a,i5)') 'the number of points---->',npnt
336
337! Read the surface points
338
339 do i=1,npnt
340 read(20,'(3f20.10)') spoint(i,1),spoint(i,2),spoint(i,3)
341! write(31,'(3f20.10)') spoint(i,1),spoint(i,2),spoint(i,3)
342 end do
343
344 return
345
346 end
347
Note: See TracBrowser for help on using the repository browser.