Adding dyn_ss and triss potentials to src-M wham

[unres.git] / source / wham / src-M / parmread.F

diff --git a/source/wham/src-M/parmread.F b/source/wham/src-M/parmread.F
index b2b64d5..9633858 100644 (file)
--- a/source/wham/src-M/parmread.F
+++ b/source/wham/src-M/parmread.F
@@ -55,6 +55,32 @@ C Assign virtual-bond length
 
       write (iout,*) "iparm",iparm," myparm",myparm
 c If reading not own parameters, skip assignment
+      call reada(controlcard,"DTRISS",dtriss,1.0D0)
+      call reada(controlcard,"ATRISS",atriss,0.3D0)
+      call reada(controlcard,"BTRISS",btriss,0.02D0)
+      call reada(controlcard,"CTRISS",ctriss,1.0D0)
+      dyn_ss=(index(controlcard,'DYN_SS').gt.0)
+      do i=1,maxres
+        dyn_ss_mask(i)=.false.
+      enddo
+      do i=1,maxres-1
+        do j=i+1,maxres
+          dyn_ssbond_ij(i,j)=1.0d300
+        enddo
+      enddo
+      call reada(controlcard,"HT",Ht,0.0D0)
+      if (dyn_ss) then
+        ss_depth=ebr/wsc-0.25*eps(1,1)
+        Ht=Ht/wsc-0.25*eps(1,1)
+        akcm=akcm*wstrain/wsc
+        akth=akth*wstrain/wsc
+        akct=akct*wstrain/wsc
+        v1ss=v1ss*wstrain/wsc
+        v2ss=v2ss*wstrain/wsc
+        v3ss=v3ss*wstrain/wsc
+      else
+        ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain
+      endif
 
       if (iparm.eq.myparm .or. .not.separate_parset) then
 
@@ -295,6 +321,7 @@ C
 C Read the parameters of Utheta determined from ab initio surfaces
 C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
 C
+c      write (iout,*) "tu dochodze"
       read (ithep,*) nthetyp,ntheterm,ntheterm2,
      &  ntheterm3,nsingle,ndouble
       nntheterm=max0(ntheterm,ntheterm2,ntheterm3)
@@ -302,6 +329,7 @@ C
       do i=-ntyp1,-1
         ithetyp(i)=-ithetyp(-i)
       enddo
+c      write (iout,*) "tu dochodze"
       do iblock=1,2
       do i=-maxthetyp,maxthetyp
         do j=-maxthetyp,maxthetyp
@@ -420,14 +448,14 @@ C
               write (iout,'(//a,10x,a)') " l","a[l]"
               write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k,iblock)
               write (iout,'(i2,1pe15.5)')
-     &           (l,aathet(l,i,j,k),l=1,ntheterm)
+     &           (l,aathet(l,i,j,k,iblock),l=1,ntheterm)
             do l=1,ntheterm2
               write (iout,'(//2h m,4(9x,a,3h[m,i1,1h]))')
      &          "b",l,"c",l,"d",l,"e",l
               do m=1,nsingle
                 write (iout,'(i2,4(1pe15.5))') m,
-     &          bbthet(m,l,i,j,k),ccthet(m,l,i,j,k,iblock),
-     &          ddthet(m,l,i,j,k),eethet(m,l,i,j,k,iblock)
+     &          bbthet(m,l,i,j,k,iblock),ccthet(m,l,i,j,k,iblock),
+     &          ddthet(m,l,i,j,k,iblock),eethet(m,l,i,j,k,iblock)
               enddo
             enddo
             do l=1,ntheterm3
@@ -980,8 +1008,10 @@ C
         bpp (i,j)=-2.0D0*epp(i,j)*rri
         ael6(i,j)=elpp6(i,j)*4.2D0**6
         ael3(i,j)=elpp3(i,j)*4.2D0**3
+        lprint=.true.
         if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j),
      &                    ael6(i,j),ael3(i,j)
+         lprint=.false.
         enddo
       enddo
 C
@@ -1022,13 +1052,17 @@ C----------------------- LJK potential --------------------------------
       endif
       goto 50
 C---------------------- GB or BP potential -----------------------------
-   30 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),
-     &  (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip0(i),i=1,ntyp),
-     &  (alp(i),i=1,ntyp)
+   30 do i=1,ntyp
+       read (isidep,*)(eps(i,j),j=i,ntyp)
+      enddo
+      read (isidep,*)(sigma0(i),i=1,ntyp)
+      read (isidep,*)(sigii(i),i=1,ntyp)
+      read (isidep,*)(chip(i),i=1,ntyp)
+      read (isidep,*)(alp(i),i=1,ntyp)
 C For the GB potential convert sigma'**2 into chi'
       if (ipot.eq.4) then
        do i=1,ntyp
-         chip(i)=(chip0(i)-1.0D0)/(chip0(i)+1.0D0)
+         chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0)
         enddo
       endif
       if (lprint) then