X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fsrc%2Fstore_parm.F;h=acac0c348f290ecc2132f2facf8a20ce0a246b2a;hb=ddce4f732732bf7162e10539c3d94788be664317;hp=ce0047fd063e736202e6aaec7bf007c28da8680b;hpb=56b6e687a929b4935fe39b4abd8beb4e05265199;p=unres.git diff --git a/source/wham/src/store_parm.F b/source/wham/src/store_parm.F index ce0047f..acac0c3 100644 --- a/source/wham/src/store_parm.F +++ b/source/wham/src/store_parm.F @@ -19,7 +19,7 @@ C include 'COMMON.SCROT' include 'COMMON.SCCOR' include 'COMMON.ALLPARM' - integer i,j,k,l,m,mm,iparm + integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii c Store weights ww_all(1,iparm)=wsc @@ -53,11 +53,15 @@ c Store bond parameters enddo c Store bond angle parameters #ifdef CRYST_THETA - do i=1,ntyp + do i=-ntyp,ntyp a0thet_all(i,iparm)=a0thet(i) + do ichir1=-1,1 + do ichir2=-1,1 do j=1,2 - athet_all(j,i,iparm)=athet(j,i) - bthet_all(j,i,iparm)=bthet(j,i) + athet_all(j,i,ichir1,ichir2,iparm)=athet(j,i,ichir1,ichir2) + bthet_all(j,i,ichir1,ichir2,iparm)=bthet(j,i,ichir1,ichir2) + enddo + enddo enddo do j=0,3 polthet_all(j,i,iparm)=polthet(j,i) @@ -80,39 +84,56 @@ c Store bond angle parameters do i=1,ntyp1 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 - do i=1,ntyp - nlob_all(i,iparm)=nlob(i) - do j=1,nlob(i) - bsc_all(j,i,iparm)=bsc(j,i) + do i=-ntyp,ntyp + iii=iabs(i) + if (i.eq.0) cycle + nlob_all(iii,iparm)=nlob(iii) + do j=1,nlob(iii) + bsc_all(j,iii,iparm)=bsc(j,iii) do k=1,3 censc_all(k,j,i,iparm)=censc(k,j,i) enddo @@ -131,44 +152,48 @@ c Store the sidechain rotamer parameters enddo #endif c Store the torsional parameters - do i=1,ntortyp - do j=1,ntortyp - v0_all(i,j,iparm)=v0(i,j) - nterm_all(i,j,iparm)=nterm(i,j) - nlor_all(i,j,iparm)=nlor(i,j) - do k=1,nterm(i,j) - v1_all(k,i,j,iparm)=v1(k,i,j) - v2_all(k,i,j,iparm)=v2(i,i,j) - enddo - do k=1,nlor(i,j) - vlor1_all(k,i,j,iparm)=vlor1(k,i,j) - vlor2_all(k,i,j,iparm)=vlor2(k,i,j) - vlor3_all(k,i,j,iparm)=vlor3(k,i,j) - enddo - enddo - enddo + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + v0_all(i,j,iblock,iparm)=v0(i,j,iblock) + nterm_all(i,j,iblock,iparm)=nterm(i,j,iblock) + nlor_all(i,j,iblock,iparm)=nlor(i,j,iblock) + do k=1,nterm(i,j,iblock) + v1_all(k,i,j,iblock,iparm)=v1(k,i,j,iblock) + v2_all(k,i,j,iblock,iparm)=v2(k,i,j,iblock) + enddo + do k=1,nlor(i,j,iblock) + vlor1_all(k,i,j,iparm)=vlor1(k,i,j) + vlor2_all(k,i,j,iparm)=vlor2(k,i,j) + vlor3_all(k,i,j,iparm)=vlor3(k,i,j) + enddo + enddo + enddo + enddo c Store the double torsional parameters - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - ntermd1_all(i,j,k,iparm)=ntermd_1(i,j,k) - ntermd2_all(i,j,k,iparm)=ntermd_2(i,j,k) - do l=1,ntermd_1(i,j,k) - v1c_all(1,l,i,j,k,iparm)=v1c(1,l,i,j,k) - v1c_all(2,l,i,j,k,iparm)=v1c(2,l,i,j,k) - v2c_all(1,l,i,j,k,iparm)=v2c(1,l,i,j,k) - v2c_all(2,l,i,j,k,iparm)=v2c(2,l,i,j,k) - enddo - do l=1,ntermd_2(i,j,k) - do m=1,ntermd_2(i,j,k) - v2s_all(l,m,i,j,k,iparm)=v2s(l,m,i,j,k) - enddo - enddo - enddo - enddo + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 + ntermd1_all(i,j,k,iblock,iparm)=ntermd_1(i,j,k,iblock) + ntermd2_all(i,j,k,iblock,iparm)=ntermd_2(i,j,k,iblock) + do l=1,ntermd_1(i,j,k,iblock) + v1c_all(1,l,i,j,k,iblock,iparm)=v1c(1,l,i,j,k,iblock) + v1c_all(2,l,i,j,k,iblock,iparm)=v1c(2,l,i,j,k,iblock) + v2c_all(1,l,i,j,k,iblock,iparm)=v2c(1,l,i,j,k,iblock) + v2c_all(2,l,i,j,k,iblock,iparm)=v2c(2,l,i,j,k,iblock) + enddo + do l=1,ntermd_2(i,j,k,iblock) + do m=1,ntermd_2(i,j,k,iblock) + v2s_all(l,m,i,j,k,iblock,iparm)=v2s(l,m,i,j,k,iblock) + enddo + enddo + enddo + enddo + enddo enddo c Store parameters of the cumulants - do i=1,nloctyp + do i=-nloctyp,nloctyp do j=1,2 b1_all(j,i,iparm)=b1(j,i) b1tilde_all(j,i,iparm)=b1tilde(j,i) @@ -264,7 +289,7 @@ C include 'COMMON.SCROT' include 'COMMON.SCCOR' include 'COMMON.ALLPARM' - integer i,j,k,l,m,mm,iparm + integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii c Restore weights wsc=ww_all(1,iparm) @@ -298,12 +323,17 @@ c Restore bond parameters enddo c Restore bond angle parameters #ifdef CRYST_THETA - do i=1,ntyp + do i=-ntyp,ntyp a0thet(i)=a0thet_all(i,iparm) + + do ichir1=-1,1 + do ichir2=-1,1 do j=1,2 - athet(j,i)=athet_all(j,i,iparm) - bthet(j,i)=bthet_all(j,i,iparm) - enddo + athet(j,i,ichir1,ichir2)=athet_all(j,i,ichir1,ichir2,iparm) + bthet(j,i,ichir1,ichir2)=bthet_all(j,i,ichir1,ichir2,iparm) + enddo + enddo + enddo do j=0,3 polthet(j,i)=polthet_all(j,i,iparm) enddo @@ -325,39 +355,56 @@ c Restore bond angle parameters do i=1,ntyp1 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 - do i=1,ntyp - nlob(i)=nlob_all(i,iparm) - do j=1,nlob(i) - bsc(j,i)=bsc_all(j,i,iparm) + do i=-ntyp,ntyp + if (i.eq.0) cycle + iii=iabs(i) + nlob(iii)=nlob_all(iii,iparm) + do j=1,nlob(iii) + bsc(j,iii)=bsc_all(j,iii,iparm) do k=1,3 censc(k,j,i)=censc_all(k,j,i,iparm) enddo @@ -376,44 +423,48 @@ c Restore the sidechain rotamer parameters enddo #endif c Restore the torsional parameters - do i=1,ntortyp - do j=1,ntortyp - v0(i,j)=v0_all(i,j,iparm) - nterm(i,j)=nterm_all(i,j,iparm) - nlor(i,j)=nlor_all(i,j,iparm) - do k=1,nterm(i,j) - v1(k,i,j)=v1_all(k,i,j,iparm) - v2(i,i,j)=v2_all(k,i,j,iparm) - enddo - do k=1,nlor(i,j) - vlor1(k,i,j)=vlor1_all(k,i,j,iparm) - vlor2(k,i,j)=vlor2_all(k,i,j,iparm) - vlor3(k,i,j)=vlor3_all(k,i,j,iparm) - enddo - enddo - enddo + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + v0(i,j,iblock)=v0_all(i,j,iblock,iparm) + nterm(i,j,iblock)=nterm_all(i,j,iblock,iparm) + nlor(i,j,iblock)=nlor_all(i,j,iblock,iparm) + do k=1,nterm(i,j,iblock) + v1(k,i,j,iblock)=v1_all(k,i,j,iblock,iparm) + v2(k,i,j,iblock)=v2_all(k,i,j,iblock,iparm) + enddo + do k=1,nlor(i,j,iblock) + vlor1(k,i,j)=vlor1_all(k,i,j,iparm) + vlor2(k,i,j)=vlor2_all(k,i,j,iparm) + vlor3(k,i,j)=vlor3_all(k,i,j,iparm) + enddo + enddo + enddo + enddo c Restore the double torsional parameters - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - ntermd_1(i,j,k)=ntermd1_all(i,j,k,iparm) - ntermd_2(i,j,k)=ntermd2_all(i,j,k,iparm) - do l=1,ntermd_1(i,j,k) - v1c(1,l,i,j,k)=v1c_all(1,l,i,j,k,iparm) - v1c(2,l,i,j,k)=v1c_all(2,l,i,j,k,iparm) - v2c(1,l,i,j,k)=v2c_all(1,l,i,j,k,iparm) - v2c(2,l,i,j,k)=v2c_all(2,l,i,j,k,iparm) - enddo - do l=1,ntermd_2(i,j,k) - do m=1,ntermd_2(i,j,k) - v2s(l,m,i,j,k)=v2s_all(l,m,i,j,k,iparm) - enddo - enddo - enddo - enddo + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 + ntermd_1(i,j,k,iblock)=ntermd1_all(i,j,k,iblock,iparm) + ntermd_2(i,j,k,iblock)=ntermd2_all(i,j,k,iblock,iparm) + do l=1,ntermd_1(i,j,k,iblock) + v1c(1,l,i,j,k,iblock)=v1c_all(1,l,i,j,k,iblock,iparm) + v1c(2,l,i,j,k,iblock)=v1c_all(2,l,i,j,k,iblock,iparm) + v2c(1,l,i,j,k,iblock)=v2c_all(1,l,i,j,k,iblock,iparm) + v2c(2,l,i,j,k,iblock)=v2c_all(2,l,i,j,k,iblock,iparm) + enddo + do l=1,ntermd_2(i,j,k,iblock) + do m=1,ntermd_2(i,j,k,iblock) + v2s(l,m,i,j,k,iblock)=v2s_all(l,m,i,j,k,iblock,iparm) + enddo + enddo + enddo + enddo + enddo enddo c Restore parameters of the cumulants - do i=1,nloctyp + do i=-nloctyp,nloctyp do j=1,2 b1(j,i)=b1_all(j,i,iparm) b1tilde(j,i)=b1tilde_all(j,i,iparm)