Merge branch 'lipid' into AFM
[unres.git] / source / wham / src-M / parmread.F
index b2b64d5..0cf2755 100644 (file)
@@ -35,6 +35,8 @@ C
       character*16 key
       integer iparm
       double precision ip,mp
+      character*6 res1
+C      write (iout,*) "KURWA"
 C
 C Body
 C
@@ -55,6 +57,66 @@ C Assign virtual-bond length
 
       write (iout,*) "iparm",iparm," myparm",myparm
 c If reading not own parameters, skip assignment
+      call reada(controlcard,"D0CM",d0cm,3.78d0)
+      call reada(controlcard,"AKCM",akcm,15.1d0)
+      call reada(controlcard,"AKTH",akth,11.0d0)
+      call reada(controlcard,"AKCT",akct,12.0d0)
+      call reada(controlcard,"V1SS",v1ss,-1.08d0)
+      call reada(controlcard,"V2SS",v2ss,7.61d0)
+      call reada(controlcard,"V3SS",v3ss,13.7d0)
+      call reada(controlcard,"EBR",ebr,-5.50D0)
+      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)
+      write(iout,*) "ATRISS",atriss
+      write(iout,*) "BTRISS",btriss
+      write(iout,*) "CTRISS",ctriss
+      write(iout,*) "DTRISS",dtriss
+
+C      do i=1,maxres
+C        dyn_ss_mask(i)=.false.
+C      enddo
+C      ebr=-12.0D0
+c
+c Old arbitrary potential - commented out.
+c
+c      dbr= 4.20D0
+c      fbr= 3.30D0
+c
+c Constants of the disulfide-bond potential determined based on the RHF/6-31G**
+c energy surface of diethyl disulfide.
+c A. Liwo and U. Kozlowska, 11/24/03
+c
+      D0CM = 3.78d0
+      AKCM = 15.1d0
+      AKTH = 11.0d0
+      AKCT = 12.0d0
+      V1SS =-1.08d0
+      V2SS = 7.61d0
+      V3SS = 13.7d0
+
+      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)
+C      if (dyn_ss) then
+C        ss_depth=ebr/wsc-0.25*eps(1,1)
+C        write(iout,*) HT,wsc,eps(1,1),'KURWA'
+C        Ht=Ht/wsc-0.25*eps(1,1)
+       
+C        akcm=akcm*whpb/wsc
+C        akth=akth*whpb/wsc
+C        akct=akct*whpb/wsc
+C        v1ss=v1ss*whpb/wsc
+C        v2ss=v2ss*whpb/wsc
+C        v3ss=v3ss*whpb/wsc
+C      else
+C        ss_depth=ebr/whpb-0.25*eps(1,1)*wsc/whpb
+C      endif
 
       if (iparm.eq.myparm .or. .not.separate_parset) then
 
@@ -78,7 +140,9 @@ c
       wvdwpp=ww(16)
       wbond=ww(18)
       wsccor=ww(19)
-
+      whpb=ww(15)
+      wstrain=ww(15)
+      wliptran=ww(22)
       endif
 
       call card_concat(controlcard,.false.)
@@ -150,7 +214,7 @@ c Read the virtual-bond parameters, masses, and moments of inertia
 c and Stokes' radii of the peptide group and side chains
 c
 #ifdef CRYST_BOND
-      read (ibond,*) vbldp0,akp
+      read (ibond,*) vbldp0,vbldpdum,akp
       do i=1,ntyp
         nbondterm(i)=1
         read (ibond,*) vbldsc0(1,i),aksc(1,i)
@@ -162,7 +226,7 @@ c
         endif
       enddo
 #else
-      read (ibond,*) ijunk,vbldp0,akp,rjunk
+      read (ibond,*) ijunk,vbldp0,vbldpdum,akp,rjunk
       do i=1,ntyp
         read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i),
      &   j=1,nbondterm(i))
@@ -188,6 +252,11 @@ c
           enddo
         enddo
       endif
+       read(iliptranpar,*) pepliptran
+       do i=1,ntyp
+       read(iliptranpar,*) liptranene(i)
+       enddo
+       close(iliptranpar)
 #ifdef CRYST_THETA
 C
 C Read the parameters of the probability distribution/energy expression 
@@ -295,6 +364,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
+      write (iout,*) "tu dochodze"
       read (ithep,*) nthetyp,ntheterm,ntheterm2,
      &  ntheterm3,nsingle,ndouble
       nntheterm=max0(ntheterm,ntheterm2,ntheterm3)
@@ -302,6 +372,7 @@ C
       do i=-ntyp1,-1
         ithetyp(i)=-ithetyp(-i)
       enddo
+      write (iout,*) "tu dochodze"
       do iblock=1,2
       do i=-maxthetyp,maxthetyp
         do j=-maxthetyp,maxthetyp
@@ -330,11 +401,13 @@ C
         enddo
       enddo
       enddo
+C      write (iout,*) "KURWA1"
       do iblock=1,2
       do i=0,nthetyp
         do j=-nthetyp,nthetyp
           do k=-nthetyp,nthetyp
             read (ithep,'(6a)') res1
+            write(iout,*) res1,i,j,k
             read (ithep,*) aa0thet(i,j,k,iblock)
             read (ithep,*)(aathet(l,i,j,k,iblock),l=1,ntheterm)
             read (ithep,*)
@@ -352,6 +425,7 @@ C
           enddo
         enddo
       enddo
+C       write(iout,*) "KURWA1.1"
 C
 C For dummy ends assign glycine-type coefficients of theta-only terms; the
 C coefficients of theta-and-gamma-dependent terms are zero.
@@ -371,6 +445,7 @@ C
         aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0
       enddo
       enddo
+C       write(iout,*) "KURWA1.5"
 C Substitution for D aminoacids from symmetry.
       do iblock=1,2
       do i=-nthetyp,0
@@ -420,14 +495,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
@@ -449,7 +524,7 @@ C
       call flush(iout)
       endif
 #endif
-
+C      write(iout,*) 'KURWA2'
 #ifdef CRYST_SC
 C
 C Read the parameters of the probability distribution/energy expression
@@ -557,6 +632,7 @@ C
       enddo
 #endif
       close(irotam)
+C      write (iout,*) 'KURWAKURWA'
 #ifdef CRYST_TOR
 C
 C Read torsional parameters in old format
@@ -980,8 +1056,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 +1100,24 @@ 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)
+      do i=1,ntyp
+       read (isidep,*)(epslip(i,j),j=i,ntyp)
+C       print *,"WARNING!!"
+C       do j=1,ntyp
+C       epslip(i,j)=epslip(i,j)+0.05d0
+C       enddo
+      enddo
 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
@@ -1063,6 +1152,7 @@ C Calculate the "working" parameters of SC interactions.
       do i=2,ntyp
         do j=1,i-1
          eps(i,j)=eps(j,i)
+          epslip(i,j)=epslip(j,i)
         enddo
       enddo
       do i=1,ntyp
@@ -1080,6 +1170,7 @@ C Calculate the "working" parameters of SC interactions.
       do i=1,ntyp
        do j=i,ntyp
          epsij=eps(i,j)
+          epsijlip=epslip(i,j)
          if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then
            rrij=sigma(i,j)
           else
@@ -1091,10 +1182,16 @@ C Calculate the "working" parameters of SC interactions.
          epsij=eps(i,j)
          sigeps=dsign(1.0D0,epsij)
          epsij=dabs(epsij)
-         aa(i,j)=epsij*rrij*rrij
-         bb(i,j)=-sigeps*epsij*rrij
-         aa(j,i)=aa(i,j)
-         bb(j,i)=bb(i,j)
+         aa_aq(i,j)=epsij*rrij*rrij
+         bb_aq(i,j)=-sigeps*epsij*rrij
+         aa_aq(j,i)=aa_aq(i,j)
+         bb_aq(j,i)=bb_aq(i,j)
+          sigeps=dsign(1.0D0,epsijlip)
+          epsijlip=dabs(epsijlip)
+          aa_lip(i,j)=epsijlip*rrij*rrij
+          bb_lip(i,j)=-sigeps*epsijlip*rrij
+          aa_lip(j,i)=aa_lip(i,j)
+          bb_lip(j,i)=bb_lip(i,j)
          if (ipot.gt.2) then
            sigt1sq=sigma0(i)**2
            sigt2sq=sigma0(j)**2
@@ -1183,7 +1280,7 @@ C
 C
 C Define the constants of the disulfide bridge
 C
-      ebr=-5.50D0
+C      ebr=-12.0D0
 c
 c Old arbitrary potential - commented out.
 c
@@ -1194,21 +1291,36 @@ c Constants of the disulfide-bond potential determined based on the RHF/6-31G**
 c energy surface of diethyl disulfide.
 c A. Liwo and U. Kozlowska, 11/24/03
 c
-      D0CM = 3.78d0
-      AKCM = 15.1d0
-      AKTH = 11.0d0
-      AKCT = 12.0d0
-      V1SS =-1.08d0
-      V2SS = 7.61d0
-      V3SS = 13.7d0
+C      D0CM = 3.78d0
+C      AKCM = 15.1d0
+C      AKTH = 11.0d0
+C      AKCT = 12.0d0
+C      V1SS =-1.08d0
+C      V2SS = 7.61d0
+C      V3SS = 13.7d0
+      write (iout,*) dyn_ss,'dyndyn'
+      if (dyn_ss) then
+        ss_depth=ebr/wsc-0.25*eps(1,1)
+C        write(iout,*) akcm,whpb,wsc,'KURWA'
+        Ht=Ht/wsc-0.25*eps(1,1)
 
-      if (lprint) then
+        akcm=akcm*whpb/wsc
+        akth=akth*whpb/wsc
+        akct=akct*whpb/wsc
+        v1ss=v1ss*whpb/wsc
+        v2ss=v2ss*whpb/wsc
+        v3ss=v3ss*whpb/wsc
+      else
+        ss_depth=ebr/whpb-0.25*eps(1,1)*wsc/whpb
+      endif
+
+C      if (lprint) then
       write (iout,'(/a)') "Disulfide bridge parameters:"
       write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
       write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
       write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
       write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,
      & ' v3ss:',v3ss
-      endif
+C      endif
       return
       end