Merge branch 'devel' of mmka:unres into devel

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

diff --git a/source/wham/src-M/store_parm.F b/source/wham/src-M/store_parm.F
index ad64f47..8c44422 100644 (file)
--- a/source/wham/src-M/store_parm.F
+++ b/source/wham/src-M/store_parm.F
@@ -81,35 +81,50 @@ c Store bond angle parameters
       nsingle_all(iparm)=nsingle
       ndouble_all(iparm)=ndouble
       nntheterm_all(iparm)=nntheterm
-      do i=1,ntyp1
+      do i=-ntyp,ntyp
         ithetyp_all(i,iparm)=ithetyp(i)
       enddo
-      do i=1,maxthetyp1
-        do j=1,maxthetyp1
-          do k=1,maxthetyp1
-            aa0thet_all(i,j,k,iparm)=aa0thet(i,j,k)
+      do iblock=1,2
+      do i=-maxthetyp1,maxthetyp1
+        do j=-maxthetyp1,maxthetyp1
+          do k=-maxthetyp1,maxthetyp1
+            aa0thet_all(i,j,k,iblock,iparm)=aa0thet(i,j,k,iblock)
             do l=1,ntheterm
-              aathet_all(l,i,j,k,iparm)=aathet(l,i,j,k)
+              aathet_all(l,i,j,k,iblock,iparm)=aathet(l,i,j,k,iblock)
             enddo
             do l=1,ntheterm2
               do m=1,nsingle
-                bbthet_all(m,l,i,j,k,iparm)=bbthet(m,l,i,j,k)
-                ccthet_all(m,l,i,j,k,iparm)=ccthet(m,l,i,j,k)
-                ddthet_all(m,l,i,j,k,iparm)=ddthet(m,l,i,j,k)
-                eethet_all(m,l,i,j,k,iparm)=eethet(m,l,i,j,k)
+                bbthet_all(m,l,i,j,k,iblock,iparm)=
+     & bbthet(m,l,i,j,k,iblock)
+                ccthet_all(m,l,i,j,k,iblock,iparm)=
+     &ccthet(m,l,i,j,k,iblock)
+                ddthet_all(m,l,i,j,k,iblock,iparm)=
+     &ddthet(m,l,i,j,k,iblock)
+                eethet_all(m,l,i,j,k,iblock,iparm)=
+     &eethet(m,l,i,j,k,iblock)
               enddo
             enddo
             do l=1,ntheterm3
               do m=1,ndouble
                 do mm=1,ndouble
-                 ffthet_all(mm,m,l,i,j,k,iparm)=ffthet(mm,m,l,i,j,k)
-                 ggthet_all(mm,m,l,i,j,k,iparm)=ggthet(mm,m,l,i,j,k)
+                if (iblock.eq.1) then
+                 ffthet_all1(mm,m,l,i,j,k,iparm)=
+     &   ffthet(mm,m,l,i,j,k,iblock)
+                 ggthet_all1(mm,m,l,i,j,k,iparm)=
+     &ggthet(mm,m,l,i,j,k,iblock)
+                  else
+                 ffthet_all2(mm,m,l,i,j,k,iparm)=
+     &   ffthet(mm,m,l,i,j,k,iblock)
+                 ggthet_all2(mm,m,l,i,j,k,iparm)=
+     &ggthet(mm,m,l,i,j,k,iblock)
+                  endif
                 enddo
               enddo
             enddo
           enddo
         enddo
       enddo
+      enddo
 #endif
 #ifdef CRYST_SC
 c Store the sidechain rotamer parameters
@@ -337,35 +352,50 @@ c Restore bond angle parameters
       nsingle=nsingle_all(iparm)
       ndouble=ndouble_all(iparm)
       nntheterm=nntheterm_all(iparm)
-      do i=1,ntyp1
+      do i=-ntyp,ntyp
         ithetyp(i)=ithetyp_all(i,iparm)
       enddo
-      do i=1,maxthetyp1
-        do j=1,maxthetyp1
-          do k=1,maxthetyp1
-            aa0thet(i,j,k)=aa0thet_all(i,j,k,iparm)
+      do iblock=1,2
+      do i=-maxthetyp1,maxthetyp1
+        do j=-maxthetyp1,maxthetyp1
+          do k=-maxthetyp1,maxthetyp1
+            aa0thet(i,j,k,iblock)=aa0thet_all(i,j,k,iblock,iparm)
             do l=1,ntheterm
-              aathet(l,i,j,k)=aathet_all(l,i,j,k,iparm)
+              aathet(l,i,j,k,iblock)=aathet_all(l,i,j,k,iblock,iparm)
             enddo
             do l=1,ntheterm2
               do m=1,nsingle
-                bbthet(m,l,i,j,k)=bbthet_all(m,l,i,j,k,iparm)
-                ccthet(m,l,i,j,k)=ccthet_all(m,l,i,j,k,iparm)
-                ddthet(m,l,i,j,k)=ddthet_all(m,l,i,j,k,iparm)
-                eethet(m,l,i,j,k)=eethet_all(m,l,i,j,k,iparm)
+                bbthet(m,l,i,j,k,iblock)=
+     &bbthet_all(m,l,i,j,k,iblock,iparm)
+                ccthet(m,l,i,j,k,iblock)=
+     &ccthet_all(m,l,i,j,k,iblock,iparm)
+                ddthet(m,l,i,j,k,iblock)=
+     &ddthet_all(m,l,i,j,k,iblock,iparm)
+                eethet(m,l,i,j,k,iblock)=
+     &eethet_all(m,l,i,j,k,iblock,iparm)
               enddo
             enddo
             do l=1,ntheterm3
               do m=1,ndouble
                 do mm=1,ndouble
-                 ffthet(mm,m,l,i,j,k)=ffthet_all(mm,m,l,i,j,k,iparm)
-                 ggthet(mm,m,l,i,j,k)=ggthet_all(mm,m,l,i,j,k,iparm)
+                if (iblock.eq.1) then
+                 ffthet(mm,m,l,i,j,k,iblock)=
+     &ffthet_all1(mm,m,l,i,j,k,iparm)
+                 ggthet(mm,m,l,i,j,k,iblock)=
+     &ggthet_all1(mm,m,l,i,j,k,iparm)
+                else
+                 ffthet(mm,m,l,i,j,k,iblock)=
+     &ffthet_all2(mm,m,l,i,j,k,iparm)
+                 ggthet(mm,m,l,i,j,k,iblock)=
+     &ggthet_all2(mm,m,l,i,j,k,iparm)
+                endif
                 enddo
               enddo
             enddo
           enddo
         enddo
       enddo
+      enddo
 #endif
 c Restore the sidechain rotamer parameters
 #ifdef CRYST_SC