source: enysol_p.f@ 32289cd

Last change on this file since 32289cd was 32289cd, checked in by baerbaer <baerbaer@…>, 14 years ago

Explicitly declare variables.

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

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