X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fsrc-M%2Fstore_parm.F;h=01bac6d00aea0d9fc5738efb0d33a31f718e56bc;hb=34d3ad3987785642be58fb2f26557d3314215577;hp=0727c010443f3bd46daa60e4ce1f79a4c5b203a3;hpb=f690e8b70bab14132839afebf080d4a28363b226;p=unres.git diff --git a/source/wham/src-M/store_parm.F b/source/wham/src-M/store_parm.F index 0727c01..01bac6d 100644 --- a/source/wham/src-M/store_parm.F +++ b/source/wham/src-M/store_parm.F @@ -1,4 +1,4 @@ - subroutine store_parm(iparm) + subroutine store_parm(iparm) C C Store parameters of set IPARM C valence angles and the side chains and energy parameters. @@ -19,7 +19,7 @@ C include 'COMMON.SCROT' include 'COMMON.SCCOR' include 'COMMON.ALLPARM' - integer i,j,k,l,m,mm,iparm + integer i,ii,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii c Store weights ww_all(1,iparm)=wsc @@ -40,6 +40,7 @@ c Store weights ww_all(16,iparm)=wvdwpp ww_all(17,iparm)=wbond ww_all(19,iparm)=wsccor + ww_all(22,iparm)=wliptran c Store bond parameters vbldp0_all(iparm)=vbldp0 akp_all(iparm)=akp @@ -53,11 +54,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) @@ -77,42 +82,60 @@ 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 - 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) +cc write (iout,*) i,"storeparm1" + 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,59 +154,86 @@ 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) + 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) + 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) + 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) - do m=1,ntermd_2(i,j,k) - v2s_all(l,m,i,j,k,iparm)=v2s(l,m,i,j,k) + 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 +#ifdef NEWCORR + do i=-nloctyp+1,nloctyp-1 + do ii=1,3 + do j=1,2 + bnew1_all(ii,j,i,iparm)=bnew1(ii,j,i) + bnew2_all(ii,j,i,iparm)=bnew2(ii,j,i) + enddo + enddo do j=1,2 - b1_all(j,i,iparm)=b1(j,i) - b1tilde_all(j,i,iparm)=b1tilde(j,i) - b2_all(j,i,iparm)=b2(j,i) + do k=1,3 + ccnew_all(k,j,i,iparm)=ccnew(k,j,i) + ddnew_all(k,j,i,iparm)=ddnew(k,j,i) + enddo + enddo + do ii=1,2 + do j=1,2 + do k=1,2 + eenew_all(k,j,ii,i,iparm)=eenew(k,j,ii,i) + enddo + enddo + enddo + do ii=1,2 + e0new_all(ii,i,iparm)=e0new(ii,i) + enddo + enddo +#else + do i=-nloctyp,nloctyp + do j=1,5 + b_all(j,i,iparm)=b(j,i) enddo do j=1,2 do k=1,2 - cc_all(k,j,i,iparm)=cc(k,j,i) - ctilde_all(k,j,i,iparm)=ctilde(k,j,i) - dd_all(k,j,i,iparm)=dd(k,j,i) - dtilde_all(k,j,i,iparm)=dtilde(k,j,i) - ee_all(k,j,i,iparm)=ee(k,j,i) + ccold_all(k,j,i,iparm)=ccold(k,j,i) + ddold_all(k,j,i,iparm)=ddold(k,j,i) + eeold_all(k,j,i,iparm)=eeold(k,j,i) enddo enddo enddo +#endif c Store the parameters of electrostatic interactions do i=1,2 do j=1,2 @@ -196,13 +246,16 @@ c Store the parameters of electrostatic interactions c Store sidechain parameters do i=1,ntyp do j=1,ntyp - aa_all(j,i,iparm)=aa(j,i) - bb_all(j,i,iparm)=bb(j,i) + aa_aq_all(j,i,iparm)=aa_aq(j,i) + bb_aq_all(j,i,iparm)=bb_aq(j,i) + aa_lip_all(j,i,iparm)=aa_lip(j,i) + bb_lip_all(j,i,iparm)=bb_lip(j,i) r0_all(j,i,iparm)=r0(j,i) sigma_all(j,i,iparm)=sigma(j,i) chi_all(j,i,iparm)=chi(j,i) augm_all(j,i,iparm)=augm(j,i) eps_all(j,i,iparm)=eps(j,i) + epslip_all(j,i,iparm)=epslip(j,i) enddo enddo do i=1,ntyp @@ -226,12 +279,17 @@ c Store disulfide-bond parameters v2ss_all(iparm)=v2ss v3ss_all(iparm)=v3ss c Store SC-backbone correlation parameters - nterm_sccor_all(iparm)=nterm_sccor - do i=1,20 - do j=1,20 - do k=1,nterm_sccor - v1sccor_all(k,i,j,iparm)=v1sccor(k,i,j) - v2sccor_all(k,i,j,iparm)=v2sccor(k,i,j) + do i=-nsccortyp,nsccortyp + do j=-nsccortyp,nsccortyp + + nterm_sccor_all(j,i,iparm)=nterm_sccor(j,i) +c do i=1,20 +c do j=1,20 + do l=1,3 + do k=1,nterm_sccor(j,i) + v1sccor_all(k,l,j,i,iparm)=v1sccor(k,l,j,i) + v2sccor_all(k,l,j,i,iparm)=v2sccor(k,l,j,i) + enddo enddo enddo enddo @@ -259,7 +317,7 @@ C include 'COMMON.SCROT' include 'COMMON.SCCOR' include 'COMMON.ALLPARM' - integer i,j,k,l,m,mm,iparm + integer i,ii,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii c Restore weights wsc=ww_all(1,iparm) @@ -280,6 +338,7 @@ c Restore weights wvdwpp=ww_all(16,iparm) wbond=ww_all(17,iparm) wsccor=ww_all(19,iparm) + wliptran=ww_all(22,iparm) c Restore bond parameters vbldp0=vbldp0_all(iparm) akp=akp_all(iparm) @@ -293,11 +352,15 @@ 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) + 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) @@ -317,42 +380,59 @@ 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 - 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 @@ -371,59 +451,86 @@ 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) + 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) + 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) + 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) - do m=1,ntermd_2(i,j,k) - v2s(l,m,i,j,k)=v2s_all(l,m,i,j,k,iparm) + 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 +#ifdef NEWCORR + do i=-nloctyp+1,nloctyp-1 + do ii=1,3 + do j=1,2 + bnew1(ii,j,i)=bnew1_all(ii,j,i,iparm) + bnew2(ii,j,i)=bnew2_all(ii,j,i,iparm) + enddo + enddo do j=1,2 - b1(j,i)=b1_all(j,i,iparm) - b1tilde(j,i)=b1tilde_all(j,i,iparm) - b2(j,i)=b2_all(j,i,iparm) + do k=1,3 + ccnew(k,j,i)=ccnew_all(k,j,i,iparm) + ddnew(k,j,i)=ddnew_all(k,j,i,iparm) + enddo + enddo + do ii=1,2 + do j=1,2 + do k=1,2 + eenew(k,j,ii,i)=eenew_all(k,j,ii,i,iparm) + enddo + enddo + enddo + do ii=1,2 + e0new(ii,i)=e0new_all(ii,i,iparm) + enddo + enddo +#else + do i=-nloctyp,nloctyp + do j=1,5 + b(j,i)=b_all(j,i,iparm) enddo do j=1,2 do k=1,2 - cc(k,j,i)=cc_all(k,j,i,iparm) - ctilde(k,j,i)=ctilde_all(k,j,i,iparm) - dd(k,j,i)=dd_all(k,j,i,iparm) - dtilde(k,j,i)=dtilde_all(k,j,i,iparm) - ee(k,j,i)=ee_all(k,j,i,iparm) + ccold(k,j,i)=ccold_all(k,j,i,iparm) + ddold(k,j,i)=ddold_all(k,j,i,iparm) + eeold(k,j,i)=eeold_all(k,j,i,iparm) enddo enddo enddo +#endif c Restore the parameters of electrostatic interactions do i=1,2 do j=1,2 @@ -436,13 +543,16 @@ c Restore the parameters of electrostatic interactions c Restore sidechain parameters do i=1,ntyp do j=1,ntyp - aa(j,i)=aa_all(j,i,iparm) - bb(j,i)=bb_all(j,i,iparm) + aa_aq(j,i)=aa_aq_all(j,i,iparm) + bb_aq(j,i)=bb_aq_all(j,i,iparm) + aa_lip(j,i)=aa_lip_all(j,i,iparm) + bb_lip(j,i)=bb_lip_all(j,i,iparm) r0(j,i)=r0_all(j,i,iparm) sigma(j,i)=sigma_all(j,i,iparm) chi(j,i)=chi_all(j,i,iparm) augm(j,i)=augm_all(j,i,iparm) eps(j,i)=eps_all(j,i,iparm) + epslip(j,i)=epslip_all(j,i,iparm) enddo enddo do i=1,ntyp @@ -466,12 +576,15 @@ c Restore disulfide-bond parameters v2ss=v2ss_all(iparm) v3ss=v3ss_all(iparm) c Restore SC-backbone correlation parameters - nterm_sccor=nterm_sccor_all(iparm) - do i=1,20 - do j=1,20 - do k=1,nterm_sccor - v1sccor(k,i,j)=v1sccor_all(k,i,j,iparm) - v2sccor(k,i,j)=v2sccor_all(k,i,j,iparm) + do i=-nsccortyp,nsccortyp + do j=-nsccortyp,nsccortyp + + nterm_sccor(j,i)=nterm_sccor_all(j,i,iparm) + do l=1,3 + do k=1,nterm_sccor(j,i) + v1sccor(k,l,j,i)=v1sccor_all(k,l,j,i,iparm) + v2sccor(k,l,j,i)=v2sccor_all(k,l,j,i,iparm) + enddo enddo enddo enddo