Introduction of SS to newcorr and SSS to src_MD-M
[unres.git] / source / unres / src_MD-M / parmread.F
index 33f017c..3296e45 100644 (file)
@@ -212,46 +212,65 @@ C
      &  ntheterm3,nsingle,ndouble
       nntheterm=max0(ntheterm,ntheterm2,ntheterm3)
       read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1)
-      do i=1,maxthetyp
-        do j=1,maxthetyp
-          do k=1,maxthetyp
-            aa0thet(i,j,k)=0.0d0
+      do i=-ntyp1,-1
+        ithetyp(i)=-ithetyp(-i)
+      enddo
+      do iblock=1,2
+      do i=-maxthetyp,maxthetyp
+        do j=-maxthetyp,maxthetyp
+          do k=-maxthetyp,maxthetyp
+            aa0thet(i,j,k,iblock)=0.0d0
             do l=1,ntheterm
-              aathet(l,i,j,k)=0.0d0
+              aathet(l,i,j,k,iblock)=0.0d0
             enddo
             do l=1,ntheterm2
               do m=1,nsingle
-                bbthet(m,l,i,j,k)=0.0d0
-                ccthet(m,l,i,j,k)=0.0d0
-                ddthet(m,l,i,j,k)=0.0d0
-                eethet(m,l,i,j,k)=0.0d0
+                bbthet(m,l,i,j,k,iblock)=0.0d0
+                ccthet(m,l,i,j,k,iblock)=0.0d0
+                ddthet(m,l,i,j,k,iblock)=0.0d0
+                eethet(m,l,i,j,k,iblock)=0.0d0
               enddo
             enddo
             do l=1,ntheterm3
               do m=1,ndouble
                 do mm=1,ndouble
-                 ffthet(mm,m,l,i,j,k)=0.0d0
-                 ggthet(mm,m,l,i,j,k)=0.0d0
+                 ffthet(mm,m,l,i,j,k,iblock)=0.0d0
+                 ggthet(mm,m,l,i,j,k,iblock)=0.0d0
                 enddo
               enddo
             enddo
           enddo
         enddo
-      enddo 
-      do i=1,nthetyp
-        do j=1,nthetyp
-          do k=1,nthetyp
-            read (ithep,'(3a)',end=111,err=111) res1,res2,res3
-            read (ithep,*,end=111,err=111) aa0thet(i,j,k)
-            read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm)
+      enddo
+      enddo
+c VAR:iblock means terminally blocking group 1=non-proline 2=proline
+      do iblock=1,2 
+c VAR:ntethtyp is type of theta potentials type currently 0=glycine 
+c VAR:1=non-glicyne non-proline 2=proline
+c VAR:negative values for D-aminoacid
+      do i=0,nthetyp
+        do j=-nthetyp,nthetyp
+          do k=-nthetyp,nthetyp
+            read (ithep,'(6a)',end=111,err=111) res1
+            read (ithep,*,end=111,err=111) aa0thet(i,j,k,iblock)
+c VAR: aa0thet is variable describing the average value of Foureir
+c VAR: expansion series
+c VAR: aathet is foureir expansion in theta/2 angle for full formula
+c VAR: look at the fitting equation in Kozlowska et al., J. Phys.:
+Condens. Matter 19 (2007) 285203 and Sieradzan et al., unpublished
             read (ithep,*,end=111,err=111)
-     &       ((bbthet(lll,ll,i,j,k),lll=1,nsingle),
-     &        (ccthet(lll,ll,i,j,k),lll=1,nsingle),
-     &        (ddthet(lll,ll,i,j,k),lll=1,nsingle),
-     &        (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2)
+     &(aathet(l,i,j,k,iblock),l=1,ntheterm)
             read (ithep,*,end=111,err=111)
-     &      (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k),
-     &         ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k),
+     &       ((bbthet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+     &        (ccthet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+     &        (ddthet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+     &        (eethet(lll,ll,i,j,k,iblock),lll=1,nsingle),
+     &        ll=1,ntheterm2)
+            read (ithep,*,end=111,err=111)
+     &      (((ffthet(llll,lll,ll,i,j,k,iblock),
+     &         ffthet(lll,llll,ll,i,j,k,iblock),
+     &         ggthet(llll,lll,ll,i,j,k,iblock),
+     &         ggthet(lll,llll,ll,i,j,k,iblock),
      &         llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3)
           enddo
         enddo
@@ -259,21 +278,75 @@ C
 C
 C For dummy ends assign glycine-type coefficients of theta-only terms; the
 C coefficients of theta-and-gamma-dependent terms are zero.
-C
+C IF YOU WANT VALENCE POTENTIALS FOR DUMMY ATOM UNCOMENT BELOW (NOT
+C RECOMENTDED AFTER VERSION 3.3)
+c      do i=1,nthetyp
+c        do j=1,nthetyp
+c          do l=1,ntheterm
+c            aathet(l,i,j,nthetyp+1,iblock)=aathet(l,i,j,1,iblock)
+c            aathet(l,nthetyp+1,i,j,iblock)=aathet(l,1,i,j,iblock)
+c          enddo
+c          aa0thet(i,j,nthetyp+1,iblock)=aa0thet(i,j,1,iblock)
+c          aa0thet(nthetyp+1,i,j,iblock)=aa0thet(1,i,j,iblock)
+c        enddo
+c        do l=1,ntheterm
+c          aathet(l,nthetyp+1,i,nthetyp+1,iblock)=aathet(l,1,i,1,iblock)
+c        enddo
+c        aa0thet(nthetyp+1,i,nthetyp+1,iblock)=aa0thet(1,i,1,iblock)
+c      enddo
+c      enddo
+C AND COMMENT THE LOOPS BELOW
       do i=1,nthetyp
         do j=1,nthetyp
           do l=1,ntheterm
-            aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1)
-            aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j)
+            aathet(l,i,j,nthetyp+1,iblock)=0.0d0
+            aathet(l,nthetyp+1,i,j,iblock)=0.0d0
           enddo
-          aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1)
-          aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j)
+          aa0thet(i,j,nthetyp+1,iblock)=0.0d0
+          aa0thet(nthetyp+1,i,j,iblock)=0.0d0
         enddo
         do l=1,ntheterm
-          aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1)
+          aathet(l,nthetyp+1,i,nthetyp+1,iblock)=0.0d0
         enddo
-        aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1)
+        aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0
+      enddo
       enddo
+C TILL HERE
+C Substitution for D aminoacids from symmetry.
+      do iblock=1,2
+      do i=-nthetyp,0
+        do j=-nthetyp,nthetyp
+          do k=-nthetyp,nthetyp
+           aa0thet(i,j,k,iblock)=aa0thet(-i,-j,-k,iblock)
+           do l=1,ntheterm
+           aathet(l,i,j,k,iblock)=aathet(l,-i,-j,-k,iblock) 
+           enddo
+           do ll=1,ntheterm2
+            do lll=1,nsingle
+            bbthet(lll,ll,i,j,k,iblock)=bbthet(lll,ll,-i,-j,-k,iblock)
+            ccthet(lll,ll,i,j,k,iblock)=-ccthet(lll,ll,-i,-j,-k,iblock)
+            ddthet(lll,ll,i,j,k,iblock)=ddthet(lll,ll,-i,-j,-k,iblock)
+            eethet(lll,ll,i,j,k,iblock)=-eethet(lll,ll,-i,-j,-k,iblock)
+            enddo
+          enddo
+          do ll=1,ntheterm3
+           do lll=2,ndouble
+            do llll=1,lll-1
+            ffthet(llll,lll,ll,i,j,k,iblock)=
+     &      ffthet(llll,lll,ll,-i,-j,-k,iblock) 
+            ffthet(lll,llll,ll,i,j,k,iblock)=
+     &      ffthet(lll,llll,ll,-i,-j,-k,iblock)
+            ggthet(llll,lll,ll,i,j,k,iblock)=
+     &      -ggthet(llll,lll,ll,-i,-j,-k,iblock)
+            ggthet(lll,llll,ll,i,j,k,iblock)=
+     &      -ggthet(lll,llll,ll,-i,-j,-k,iblock)      
+            enddo !ll
+           enddo  !lll  
+          enddo   !llll
+         enddo    !k
+        enddo     !j
+       enddo      !i
+      enddo       !iblock
 C
 C Control printout of the coefficients of virtual-bond-angle potentials
 C
@@ -285,16 +358,16 @@ C
               write (iout,'(//4a)') 
      &         'Type ',onelett(i),onelett(j),onelett(k) 
               write (iout,'(//a,10x,a)') " l","a[l]"
-              write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k)
+              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),
-     &          ddthet(m,l,i,j,k),eethet(m,l,i,j,k)
+     &          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
@@ -303,8 +376,10 @@ C
               do m=2,ndouble
                 do n=1,m-1
                   write (iout,'(i1,1x,i1,4(1pe15.5))') n,m,
-     &              ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k),
-     &              ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k)
+     &              ffthet(n,m,l,i,j,k,iblock),
+     &              ffthet(m,n,l,i,j,k,iblock),
+     &              ggthet(n,m,l,i,j,k,iblock),
+     &              ggthet(m,n,l,i,j,k,iblock)
                 enddo
               enddo
             enddo
@@ -313,6 +388,53 @@ C
       enddo
       call flush(iout)
       endif
+      write (2,*) "Start reading THETA_PDB",ithep_pdb
+      do i=1,ntyp
+c      write (2,*) 'i=',i
+        read (ithep_pdb,*,err=111,end=111)
+     &     a0thet(i),(athet(j,i,1,1),j=1,2),
+     &    (bthet(j,i,1,1),j=1,2)
+        read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3)
+        read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3)
+        read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
+        sigc0(i)=sigc0(i)**2
+      enddo
+      do i=1,ntyp
+      athet(1,i,1,-1)=athet(1,i,1,1)
+      athet(2,i,1,-1)=athet(2,i,1,1)
+      bthet(1,i,1,-1)=-bthet(1,i,1,1)
+      bthet(2,i,1,-1)=-bthet(2,i,1,1)
+      athet(1,i,-1,1)=-athet(1,i,1,1)
+      athet(2,i,-1,1)=-athet(2,i,1,1)
+      bthet(1,i,-1,1)=bthet(1,i,1,1)
+      bthet(2,i,-1,1)=bthet(2,i,1,1)
+      enddo
+      do i=-ntyp,-1
+      a0thet(i)=a0thet(-i)
+      athet(1,i,-1,-1)=athet(1,-i,1,1)
+      athet(2,i,-1,-1)=-athet(2,-i,1,1)
+      bthet(1,i,-1,-1)=bthet(1,-i,1,1)
+      bthet(2,i,-1,-1)=-bthet(2,-i,1,1)
+      athet(1,i,-1,1)=athet(1,-i,1,1)
+      athet(2,i,-1,1)=-athet(2,-i,1,1)
+      bthet(1,i,-1,1)=-bthet(1,-i,1,1)
+      bthet(2,i,-1,1)=bthet(2,-i,1,1)
+      athet(1,i,1,-1)=-athet(1,-i,1,1)
+      athet(2,i,1,-1)=athet(2,-i,1,1)
+      bthet(1,i,1,-1)=bthet(1,-i,1,1)
+      bthet(2,i,1,-1)=-bthet(2,-i,1,1)
+      theta0(i)=theta0(-i)
+      sig0(i)=sig0(-i)
+      sigc0(i)=sigc0(-i)
+       do j=0,3
+        polthet(j,i)=polthet(j,-i)
+       enddo
+       do j=1,3
+         gthet(j,i)=gthet(j,-i)
+       enddo
+      enddo
+      write (2,*) "End reading THETA_PDB"
+      close (ithep_pdb)
 #endif
       close(ithep)
 #ifdef CRYST_SC
@@ -415,6 +537,50 @@ C
          enddo  
        endif
       enddo
+C
+C Read the parameters of the probability distribution/energy expression
+C of the side chains.
+C
+      write (2,*) "Start reading ROTAM_PDB"
+      do i=1,ntyp
+        read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i)
+        if (i.eq.10) then
+          dsc_inv(i)=0.0D0
+        else
+          dsc_inv(i)=1.0D0/dsc(i)
+        endif
+        if (i.ne.10) then
+        do j=1,nlob(i)
+          do k=1,3
+            do l=1,3
+              blower(l,k,j)=0.0D0
+            enddo
+          enddo
+        enddo
+        bsc(1,i)=0.0D0
+        read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3),
+     &    ((blower(k,l,1),l=1,k),k=1,3)
+        do j=2,nlob(i)
+          read (irotam_pdb,*,end=112,err=112) bsc(j,i)
+          read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3),
+     &                                 ((blower(k,l,j),l=1,k),k=1,3)
+        enddo
+        do j=1,nlob(i)
+          do k=1,3
+            do l=1,k
+              akl=0.0D0
+              do m=1,3
+                akl=akl+blower(k,m,j)*blower(l,m,j)
+              enddo
+              gaussc(k,l,j,i)=akl
+              gaussc(l,k,j,i)=akl
+            enddo
+          enddo
+        enddo
+        endif
+      enddo
+      close (irotam_pdb)
+      write (2,*) "End reading ROTAM_PDB"
 #endif
       close(irotam)
 
@@ -453,7 +619,7 @@ C
       do i=-ntyp,-1
        itortyp(i)=-itortyp(-i)
       enddo
-c      write (iout,*) 'ntortyp',ntortyp
+      write (iout,*) 'ntortyp',ntortyp
       do i=0,ntortyp-1
         do j=-ntortyp+1,ntortyp-1
           read (itorp,*,end=113,err=113) nterm(i,j,iblock),
@@ -620,6 +786,9 @@ cc maxinter is maximum interaction sites
           read (isccor,*,end=119,err=119)
      &nterm_sccor(i,j),nlor_sccor(i,j)
           v0ijsccor=0.0d0
+          v0ijsccor1=0.0d0
+          v0ijsccor2=0.0d0
+          v0ijsccor3=0.0d0
           si=-1.0d0
           nterm_sccor(-i,j)=nterm_sccor(i,j)
           nterm_sccor(-i,-j)=nterm_sccor(i,j)
@@ -660,45 +829,51 @@ cc maxinter is maximum interaction sites
                endif
             endif
             v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j)
+            v0ijsccor1=v0ijsccor+si*v1sccor(k,l,-i,j)
+            v0ijsccor2=v0ijsccor+si*v1sccor(k,l,i,-j)
+            v0ijsccor3=v0ijsccor+si*v1sccor(k,l,-i,-j)
             si=-si
           enddo
           do k=1,nlor_sccor(i,j)
-            read (isccor,*,end=113,err=113) kk,vlor1sccor(k,i,j),
+            read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j),
      &        vlor2sccor(k,i,j),vlor3sccor(k,i,j)
             v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/
      &(1+vlor3sccor(k,i,j)**2)
           enddo
-          v0sccor(i,j)=v0ijsccor
+          v0sccor(l,i,j)=v0ijsccor
+          v0sccor(l,-i,j)=v0ijsccor1
+          v0sccor(l,i,-j)=v0ijsccor2
+          v0sccor(l,-i,-j)=v0ijsccor3         
         enddo
       enddo
       enddo
       close (isccor)
 #else
-      read (isccor,*,end=113,err=113) (isccortyp(i),i=1,ntyp)
+      read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp)
 c      write (iout,*) 'ntortyp',ntortyp
       maxinter=3
 cc maxinter is maximum interaction sites
       do l=1,maxinter
       do i=1,nsccortyp
         do j=1,nsccortyp
-          read (isccor,*,end=113,err=113)
+          read (isccor,*,end=119,err=119)
      & nterm_sccor(i,j),nlor_sccor(i,j)
           v0ijsccor=0.0d0
           si=-1.0d0
 
           do k=1,nterm_sccor(i,j)
-            read (isccor,*,end=113,err=113) kk,v1sccor(k,l,i,j)
+            read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j)
      &    ,v2sccor(k,l,i,j)
             v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j)
             si=-si
           enddo
           do k=1,nlor_sccor(i,j)
-            read (isccor,*,end=113,err=113) kk,vlor1sccor(k,i,j),
+            read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j),
      &        vlor2sccor(k,i,j),vlor3sccor(k,i,j)
             v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/
      &(1+vlor3sccor(k,i,j)**2)
           enddo
-          v0sccor(i,j)=v0ijsccor
+          v0sccor(i,j,iblock)=v0ijsccor
         enddo
       enddo
       enddo
@@ -866,8 +1041,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
+c        lprint=.true.
         if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j),
      &                    ael6(i,j),ael3(i,j)
+c        lprint=.false.
         enddo
       enddo
 C
@@ -888,7 +1065,7 @@ C
      & ', exponents are ',expon,2*expon 
       goto (10,20,30,30,40) ipot
 C----------------------- LJ potential ---------------------------------
-   10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
+   10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),
      &   (sigma0(i),i=1,ntyp)
       if (lprint) then
        write (iout,'(/a/)') 'Parameters of the LJ potential:'
@@ -900,7 +1077,7 @@ C----------------------- LJ potential ---------------------------------
       endif
       goto 50
 C----------------------- LJK potential --------------------------------
-   20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
+   20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),
      &  (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp)
       if (lprint) then
        write (iout,'(/a/)') 'Parameters of the LJK potential:'
@@ -913,9 +1090,13 @@ C----------------------- LJK potential --------------------------------
       endif
       goto 50
 C---------------------- GB or BP potential -----------------------------
-   30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
-     &  (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp),
-     &  (alp(i),i=1,ntyp)
+   30 do i=1,ntyp
+       read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp)
+      enddo
+      read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp)
+      read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp)
+      read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp)
+      read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp)
 C For the GB potential convert sigma'**2 into chi'
       if (ipot.eq.4) then
        do i=1,ntyp
@@ -934,7 +1115,7 @@ C For the GB potential convert sigma'**2 into chi'
       endif
       goto 50
 C--------------------- GBV potential -----------------------------------
-   40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
+   40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),
      &  (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp),
      &  (chip(i),i=1,ntyp),(alp(i),i=1,ntyp)
       if (lprint) then
@@ -1062,7 +1243,7 @@ C
         bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6
         bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6
       enddo
-
+c      lprint=.true.
       if (lprint) then
         write (iout,*) "Parameters of SC-p interactions:"
         do i=1,ntyp
      &     eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2)
         enddo
       endif
+c      lprint=.false.
 #endif
 C
 C Define the constants of the disulfide bridge
 C
-      ebr=-5.50D0
+      ebr=-12.00D0
 c
 c Old arbitrary potential - commented out.
 c