source/wham/src-HCD/boxshift.f

   1
   2 c------------------------------------------------------------------------
   3       double precision function boxshift(x,boxsize)
   4       implicit none
   5       double precision x,boxsize
   6       double precision xtemp
   7       xtemp=dmod(x,boxsize)
   8       if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then
   9         boxshift=xtemp-boxsize
  10       else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then
  11         boxshift=xtemp+boxsize
  12       else
  13         boxshift=xtemp
  14       endif
  15       return
  16       end
  17 c--------------------------------------------------------------------------
  18       subroutine closest_img(xi,yi,zi,xj,yj,zj)
  19       include 'DIMENSIONS'
  20       include 'COMMON.CHAIN'
  21       integer xshift,yshift,zshift,subchap
  22       double precision dist_init,xj_safe,yj_safe,zj_safe,
  23      & xj_temp,yj_temp,zj_temp,dist_temp
  24       xj_safe=xj
  25       yj_safe=yj
  26       zj_safe=zj
  27       dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  28       subchap=0
  29       do xshift=-1,1
  30         do yshift=-1,1
  31           do zshift=-1,1
  32             xj=xj_safe+xshift*boxxsize
  33             yj=yj_safe+yshift*boxysize
  34             zj=zj_safe+zshift*boxzsize
  35             dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  36             if(dist_temp.lt.dist_init) then
  37               dist_init=dist_temp
  38               xj_temp=xj
  39               yj_temp=yj
  40               zj_temp=zj
  41               subchap=1
  42             endif
  43           enddo
  44         enddo
  45       enddo
  46       if (subchap.eq.1) then
  47         xj=xj_temp-xi
  48         yj=yj_temp-yi
  49         zj=zj_temp-zi
  50       else
  51         xj=xj_safe-xi
  52         yj=yj_safe-yi
  53         zj=zj_safe-zi
  54       endif
  55       return
  56       end
  57 c--------------------------------------------------------------------------
  58       subroutine to_box(xi,yi,zi)
  59       implicit none
  60       include 'DIMENSIONS'
  61       include 'COMMON.CHAIN'
  62       double precision xi,yi,zi
  63       xi=dmod(xi,boxxsize)
  64       if (xi.lt.0.0d0) xi=xi+boxxsize
  65       yi=dmod(yi,boxysize)
  66       if (yi.lt.0.0d0) yi=yi+boxysize
  67       zi=dmod(zi,boxzsize)
  68       if (zi.lt.0.0d0) zi=zi+boxzsize
  69       return
  70       end
  71 c--------------------------------------------------------------------------
  72       subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
  73       implicit none
  74       include 'DIMENSIONS'
  75       include 'COMMON.CHAIN'
  76       double precision xi,yi,zi,sslipi,ssgradlipi
  77       double precision fracinbuf
  78       double precision sscalelip,sscagradlip
  79
  80       if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then
  81 C the energy transfer exist
  82         if (zi.lt.buflipbot) then
  83 C what fraction I am in
  84           fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
  85 C lipbufthick is thickenes of lipid buffore
  86           sslipi=sscalelip(fracinbuf)
  87           ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
  88         elseif (zi.gt.bufliptop) then
  89           fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
  90           sslipi=sscalelip(fracinbuf)
  91           ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
  92         else
  93           sslipi=1.0d0
  94           ssgradlipi=0.0
  95         endif
  96       else
  97         sslipi=0.0d0
  98         ssgradlipi=0.0
  99       endif
 100       return
 101       end