corrections

[unres.git] / source / cluster / wham / src-HCD / boxshift.f

diff --git a/source/cluster/wham/src-HCD/boxshift.f b/source/cluster/wham/src-HCD/boxshift.f
new file mode 100644 (file)
index 0000000..29d3406
--- /dev/null
+++ b/source/cluster/wham/src-HCD/boxshift.f
@@ -0,0 +1,101 @@
+
+c------------------------------------------------------------------------
+      double precision function boxshift(x,boxsize)
+      implicit none
+      double precision x,boxsize
+      double precision xtemp
+      xtemp=dmod(x,boxsize)
+      if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then
+        boxshift=xtemp-boxsize
+      else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then
+        boxshift=xtemp+boxsize
+      else
+        boxshift=xtemp
+      endif
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine closest_img(xi,yi,zi,xj,yj,zj)
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      integer xshift,yshift,zshift,subchap
+      double precision dist_init,xj_safe,yj_safe,zj_safe,
+     & xj_temp,yj_temp,zj_temp,dist_temp
+      xj_safe=xj
+      yj_safe=yj
+      zj_safe=zj
+      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+      subchap=0
+      do xshift=-1,1
+        do yshift=-1,1
+          do zshift=-1,1
+            xj=xj_safe+xshift*boxxsize
+            yj=yj_safe+yshift*boxysize
+            zj=zj_safe+zshift*boxzsize
+            dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+            if(dist_temp.lt.dist_init) then
+              dist_init=dist_temp
+              xj_temp=xj
+              yj_temp=yj
+              zj_temp=zj
+              subchap=1
+            endif
+          enddo
+        enddo
+      enddo
+      if (subchap.eq.1) then
+        xj=xj_temp-xi
+        yj=yj_temp-yi
+        zj=zj_temp-zi
+      else
+        xj=xj_safe-xi
+        yj=yj_safe-yi
+        zj=zj_safe-zi
+      endif
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine to_box(xi,yi,zi)
+      implicit none
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      double precision xi,yi,zi
+      xi=dmod(xi,boxxsize)
+      if (xi.lt.0.0d0) xi=xi+boxxsize
+      yi=dmod(yi,boxysize)
+      if (yi.lt.0.0d0) yi=yi+boxysize
+      zi=dmod(zi,boxzsize)
+      if (zi.lt.0.0d0) zi=zi+boxzsize
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+      implicit none
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      double precision xi,yi,zi,sslipi,ssgradlipi
+      double precision fracinbuf
+      double precision sscalelip,sscagradlip
+
+      if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then
+C the energy transfer exist
+        if (zi.lt.buflipbot) then
+C what fraction I am in
+          fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+          sslipi=sscalelip(fracinbuf)
+          ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+        elseif (zi.gt.bufliptop) then
+          fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+          sslipi=sscalelip(fracinbuf)
+          ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+        else
+          sslipi=1.0d0
+          ssgradlipi=0.0
+        endif
+      else
+        sslipi=0.0d0
+        ssgradlipi=0.0
+      endif
+      return
+      end