call reada(weightcard,'SCALSCP',scalscp,1.0d0)
call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
+ call reada(weightcard,'WSCCOR',wsccor,1.0D0)
if (index(weightcard,'SOFT').gt.0) ipot=6
C 12/1/95 Added weight for the multi-body term WCORR
call reada(weightcard,'WCORRH',wcorr,1.0D0)
weights(18)=scal14
write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
& wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wturn3,
- & wturn4,wturn6
+ & wturn4,wturn6,wsccor
10 format (/'Energy-term weights (unscaled):'//
& 'WSCC= ',f10.6,' (SC-SC)'/
& 'WSCP= ',f10.6,' (SC-p)'/
& 'WCORR6= ',f10.6,' (multi-body 6th order)'/
& 'WTURN3= ',f10.6,' (turns, 3rd order)'/
& 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
+ & 'WTURN6= ',f10.6,' (turns, 6th order)'/
+ & 'WSCCOR= ',f10.6,' (SC-backbone torsinal correalations)')
if (wcorr4.gt.0.0d0) then
write (iout,'(/2a/)') 'Local-electrostatic type correlation ',
& 'between contact pairs of peptide groups'
do i=1,nres
#ifdef PROCOR
- if (itype(i).eq.21 .or. itype(i+1).eq.21) then
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then
#else
- if (itype(i).eq.21) then
+ if (itype(i).eq.ntyp1) then
#endif
itel(i)=0
#ifdef PROCOR
- else if (itype(i+1).ne.20) then
+ else if (iabs(itype(i+1)).ne.20) then
#else
- else if (itype(i).ne.20) then
+ else if (iabs(itype(i)).ne.20) then
#endif
itel(i)=1
else
nnt=1
nct=nres
print *,'NNT=',NNT,' NCT=',NCT
- if (itype(1).eq.21) nnt=2
- if (itype(nres).eq.21) nct=nct-1
+ if (itype(1).eq.ntyp1) nnt=2
+ if (itype(nres).eq.ntyp1) nct=nct-1
if (nstart.lt.nnt) nstart=nnt
if (nend.gt.nct .or. nend.eq.0) nend=nct
write (iout,*) "nstart",nstart," nend",nend
C Calculate electrostatic (H-bonding) energy of the main chain.
C
107 continue
+
+C BARTEK for dfa test!
+ if (wdfa_dist.gt.0) call edfad(edfadis)
+c print*, 'edfad is finished!', edfadis
+ if (wdfa_tor.gt.0) call edfat(edfator)
+c print*, 'edfat is finished!', edfator
+ if (wdfa_nei.gt.0) call edfan(edfanei)
+c print*, 'edfan is finished!', edfanei
+ if (wdfa_beta.gt.0) call edfab(edfabet)
+c print*, 'edfab is finished!', edfabet
+C stop
+C BARTEK
+
c print *,"Processor",myrank," computed USCSC"
#ifdef TIMING
#ifdef MPI
energia(21)=esccor
energia(22)=evdw_p
energia(23)=evdw_m
+ energia(24)=edfadis
+ energia(25)=edfator
+ energia(26)=edfanei
+ energia(27)=edfabet
c print *," Processor",myrank," calls SUM_ENERGY"
call sum_energy(energia,.true.)
c print *," Processor",myrank," left SUM_ENERGY"
estr=energia(17)
Uconst=energia(20)
esccor=energia(21)
+ edfadis=energia(24)
+ edfator=energia(25)
+ edfanei=energia(26)
+ edfabet=energia(27)
#ifdef SPLITELE
etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
& +wang*ebe+wtor*etors+wscloc*escloc
& +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
& +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
& +wbond*estr+Uconst+wsccor*esccor
+ & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
+ & +wdfa_beta*edfabet
#else
etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
& +wang*ebe+wtor*etors+wscloc*escloc
& +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
& +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
& +wbond*estr+Uconst+wsccor*esccor
+ & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
+ & +wdfa_beta*edfabet
+
#endif
energia(0)=etot
c detecting NaNQ
& wcorr5*gradcorr5_long(j,i)+
& wcorr6*gradcorr6_long(j,i)+
& wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
+ & wstrain*ghpbc(j,i)+
+ & wdfa_dist*gdfad(j,i)+
+ & wdfa_tor*gdfat(j,i)+
+ & wdfa_nei*gdfan(j,i)+
+ & wdfa_beta*gdfab(j,i)
+
enddo
enddo
#else
& wcorr5*gradcorr5_long(j,i)+
& wcorr6*gradcorr6_long(j,i)+
& wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
+ & wstrain*ghpbc(j,i)+
+ & wdfa_dist*gdfad(j,i)+
+ & wdfa_tor*gdfat(j,i)+
+ & wdfa_nei*gdfan(j,i)+
+ & wdfa_beta*gdfab(j,i)
+
enddo
enddo
#endif
& wcorr5*gradcorr5_long(j,i)+
& wcorr6*gradcorr6_long(j,i)+
& wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
+ & wstrain*ghpbc(j,i)+
+ & wdfa_dist*gdfad(j,i)+
+ & wdfa_tor*gdfat(j,i)+
+ & wdfa_nei*gdfan(j,i)+
+ & wdfa_beta*gdfab(j,i)
+
+
enddo
enddo
#endif
& +wturn3*gel_loc_turn3(i)
& +wturn6*gel_loc_turn6(i)
& +wel_loc*gel_loc_loc(i)
+ & +wsccor*gsccor_loc(i)
enddo
#ifdef DEBUG
write (iout,*) "gloc after adding corr"
estr=energia(17)
Uconst=energia(20)
esccor=energia(21)
+C Bartek
+ edfadis = energia(24)
+ edfator = energia(25)
+ edfanei = energia(26)
+ edfabet = energia(27)
+
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
& estr,wbond,ebe,wang,
& ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
& eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
& edihcnstr,ebr*nss,
- & Uconst,etot
+ & Uconst,edfadis,edfator,edfanei,edfabet,etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'UCONST= ',1pE16.6,' (Constraint energy)'/
+ & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
+ & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
+ & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
+ & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
& 'ETOT= ',1pE16.6,' (total)')
#else
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
& ecorr,wcorr,
& ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
& eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
- & ebr*nss,Uconst,etot
+ & ebr*nss,
+ & Uconst,edfadis,edfator,edfanei,edfabet,etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'UCONST=',1pE16.6,' (Constraint energy)'/
+ & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
+ & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
+ & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
+ & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
& 'ETOT= ',1pE16.6,' (total)')
#endif
return
c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
cd & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j))
+ itypj=itype(j)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j))
+ itypj=itype(j)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
c endif
ind=0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
+ itypj=iabs(itype(j))
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
c if (icall.eq.0) lprn=.false.
ind=0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=iabs(itype(j))
+ itypj=itype(j)
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
c if (icall.eq.0) lprn=.true.
ind=0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=iabs(itype(j))
+ itypj=itype(j)
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
cd & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j))
+ itypj=itype(j)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=iabs(itype(j))
+ itypj=itype(j)
C Uncomment following three lines for SC-p interactions
c xj=c(1,nres+j)-xi
c yj=c(2,nres+j)-yi
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=iabs(itype(j))
+ itypj=itype(j)
C Uncomment following three lines for SC-p interactions
c xj=c(1,nres+j)-xi
c yj=c(2,nres+j)-yi
c & dhpb(i),dhpb1(i),forcon(i)
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
- if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. iabs(itype(jjj
- &)).eq.1) then
+ if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
cd write (iout,*) "eij",eij
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=iabs(itype(i))
+ itypi=itype(i)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
dzi=dc_norm(3,nres+i)
c dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(nres+i)
- itypj=iabs(itype(j))
+ itypj=itype(j)
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
xj=c(1,nres+j)-xi
c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
c
do i=ibond_start,ibond_end
- iti=iabs(itype(i))
+ iti=itype(i)
if (iti.ne.10) then
nbi=nbondterm(iti)
if (nbi.eq.1) then
do i=ithet_start,ithet_end
C Zero the energy function and its derivative at 0 or pi.
call splinthet(theta(i),0.5d0*delta,ss,ssd)
- it=(itype(i-1))
- ichir1=isign(1,itype(i-2))
- ichir2=isign(1,itype(i))
- if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
- if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
- if (itype(i-1).eq.10) then
- itype1=isign(10,itype(i-2))
- ichir11=isign(1,itype(i-2))
- ichir12=isign(1,itype(i-2))
- itype2=isign(10,itype(i))
- ichir21=isign(1,itype(i))
- ichir22=isign(1,itype(i))
- endif
+ it=itype(i-1)
if (i.gt.3) then
#ifdef OSF
phii=phi(i)
C In following comments this theta will be referred to as t_c.
thet_pred_mean=0.0d0
do k=1,2
- athetk=athet(k,it,ichir1,ichir2)
- bthetk=bthet(k,it,ichir1,ichir2)
- if (it.eq.10) then
- athetk=athet(k,itype1,ichir11,ichir12)
- bthetk=bthet(k,itype2,ichir21,ichir22)
- endif
+ athetk=athet(k,it)
+ bthetk=bthet(k,it)
thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
enddo
dthett=thet_pred_mean*ssd
thet_pred_mean=thet_pred_mean*ss+a0thet(it)
C Derivatives of the "mean" values in gamma1 and gamma2.
- dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
- &+athet(2,it,ichir1,ichir2)*y(1))*ss
- dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
- & +bthet(2,it,ichir1,ichir2)*z(1))*ss
- if (it.eq.10) then
- dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
- &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
- dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
- & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
- endif
+ dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
+ dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
if (theta(i).gt.pi-delta) then
call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
& E_tc0)
dephii=0.0d0
dephii1=0.0d0
theti2=0.5d0*theta(i)
- ityp2=ithetyp(iabs(itype(i-1)))
+ ityp2=ithetyp(itype(i-1))
do k=1,nntheterm
coskt(k)=dcos(k*theti2)
sinkt(k)=dsin(k*theti2)
#else
phii=phi(i)
#endif
- ityp1=ithetyp(iabs(itype(i-2)))
+ ityp1=ithetyp(itype(i-2))
do k=1,nsingle
cosph1(k)=dcos(k*phii)
sinph1(k)=dsin(k*phii)
#else
phii1=phi(i+1)
#endif
- ityp3=ithetyp(iabs(itype(i)))
+ ityp3=ithetyp(itype(i))
do k=1,nsingle
cosph2(k)=dcos(k*phii1)
sinph2(k)=dsin(k*phii1)
do i=loc_start,loc_end
it=itype(i)
if (it.eq.10) goto 1
- nlobit=nlob(iabs(it))
+ nlobit=nlob(it)
c print *,'i=',i,' it=',it,' nlobit=',nlobit
c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
theti=theta(i+1)-pipol
do j=1,nlobit
#ifdef OSF
- adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
+ adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
if(adexp.ne.adexp) adexp=1.0
expfac=dexp(adexp)
#else
- expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
+ expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
#endif
cd print *,'j=',j,' expfac=',expfac
escloc_i=escloc_i+expfac
dersc12=0.0d0
do j=1,nlobit
- expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
+ expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
escloc_i=escloc_i+expfac
do k=1,2
dersc(k)=dersc(k)+Ax(k,j)*expfac
do j = 1,3
xx = xx + x_prime(j)*dc_norm(j,i+nres)
yy = yy + y_prime(j)*dc_norm(j,i+nres)
- zz = zz + z_prime(j)*dc_norm(j,i+nres)
+ zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
enddo
xxtab(i)=xx
C Compute the energy of the ith side cbain
C
c write (2,*) "xx",xx," yy",yy," zz",zz
- it=itype(i)
+ it=iabs(itype(i))
do j = 1,65
x(j) = sc_parmin(j,it)
enddo
Cc diagnostics - remove later
xx1 = dcos(alph(2))
yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsin(alph(2))*dsin(omeg(2))
+ zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
write(2,'(3f8.1,3f9.3,1x,3f9.3)')
& alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
& xx1,yy1,zz1
etors_ii=0.0D0
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
phii=phi(i)
gloci=0.0D0
C Regular cosine and sine terms
- do j=1,nterm(itori,itori1,iblock)
- v1ij=v1(j,itori,itori1,iblock)
- v2ij=v2(j,itori,itori1,iblock)
+ do j=1,nterm(itori,itori1)
+ v1ij=v1(j,itori,itori1)
+ v2ij=v2(j,itori,itori1)
cosphi=dcos(j*phii)
sinphi=dsin(j*phii)
etors=etors+v1ij*cosphi+v2ij*sinphi
C
cosphi=dcos(0.5d0*phii)
sinphi=dsin(0.5d0*phii)
- do j=1,nlor(itori,itori1,iblock)
+ do j=1,nlor(itori,itori1)
vl1ij=vlor1(j,itori,itori1)
vl2ij=vlor2(j,itori,itori1)
vl3ij=vlor3(j,itori,itori1)
gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
enddo
C Subtract the constant term
- etors=etors-v0(itori,itori1,iblock)
+ etors=etors-v0(itori,itori1)
if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'etor',i,etors_ii-v0(itori,itori1,iblock)
+ & 'etor',i,etors_ii-v0(itori,itori1)
if (lprn)
& write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
& restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
- & (v1(j,itori,itori1,iblock),j=1,6),
- & (v2(j,itori,itori1,iblock),j=1,6)
+ & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
itori2=itortyp(itype(i))
- iblock=1
- if (iabs(itype(i+1)).eq.20) iblock=2
phii=phi(i)
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
- do j=1,ntermd_1(itori,itori1,itori2,iblock)
- v1cij=v1c(1,j,itori,itori1,itori2,iblock)
- v1sij=v1s(1,j,itori,itori1,itori2,iblock)
- v2cij=v1c(2,j,itori,itori1,itori2,iblock)
- v2sij=v1s(2,j,itori,itori1,itori2,iblock)
+ do j=1,ntermd_1(itori,itori1,itori2)
+ v1cij=v1c(1,j,itori,itori1,itori2)
+ v1sij=v1s(1,j,itori,itori1,itori2)
+ v2cij=v1c(2,j,itori,itori1,itori2)
+ v2sij=v1s(2,j,itori,itori1,itori2)
cosphi1=dcos(j*phii)
sinphi1=dsin(j*phii)
cosphi2=dcos(j*phii1)
gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
enddo
- do k=2,ntermd_2(itori,itori1,itori2,iblock)
+ do k=2,ntermd_2(itori,itori1,itori2)
do l=1,k-1
- v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
- v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
- v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
- v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
+ v1cdij = v2c(k,l,itori,itori1,itori2)
+ v2cdij = v2c(l,k,itori,itori1,itori2)
+ v1sdij = v2s(k,l,itori,itori1,itori2)
+ v2sdij = v2s(l,k,itori,itori1,itori2)
cosphi1p2=dcos(l*phii+(k-l)*phii1)
cosphi1m2=dcos(l*phii-(k-l)*phii1)
sinphi1p2=dsin(l*phii+(k-l)*phii1)
esccor=0.0D0
do i=itau_start,itau_end
esccor_ii=0.0D0
+ if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
isccori=isccortyp(itype(i-2))
isccori1=isccortyp(itype(i-1))
phii=phi(i)
c 3 = SC...Ca...Ca...SCi
gloci=0.0D0
if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
- & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
- & (itype(i-1).eq.21)))
+ & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
+ & (itype(i-1).eq.ntyp1)))
& .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
- & .or.(itype(i-2).eq.21)))
+ & .or.(itype(i-2).eq.ntyp1)))
& .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
- & (itype(i-1).eq.21)))) cycle
- if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
- if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
+ & (itype(i-1).eq.ntyp1)))) cycle
+ if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
+ if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
& cycle
do j=1,nterm_sccor(isccori,isccori1)
v1ij=v1sccor(j,intertyp,isccori,isccori1)
include 'COMMON.SETUP'
character*1 t1,t2,t3
character*1 onelett(4) /"G","A","P","D"/
- character*1 toronelet(-2:2) /"p","a","G","A","P"/
logical lprint,LaTeX
dimension blower(3,3,maxlob)
dimension b(13)
C of the virtual-bond valence angles theta
C
do i=1,ntyp
- read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i,1,1),j=1,2),
- & (bthet(j,i,1,1),j=1,2)
+ read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2),
+ & (bthet(j,i),j=1,2)
read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3)
read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3)
read (ithep,*,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
close (ithep)
if (lprint) then
if (.not.LaTeX) then
& ' B1 ',' B2 '
do i=1,ntyp
write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,
- & a0thet(i),(athet(j,i,1,1),j=1,2),(bthet(j,i,1,1),j=1,2)
+ & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2)
enddo
write (iout,'(/a/9x,5a/79(1h-))')
& 'Parameters of the expression for sigma(theta_c):',
& ' b1*10^1 ',' b2*10^1 '
do i=1,ntyp
write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),
- & a0thet(i),(100*athet(j,i,1,1),j=1,2),
- & (10*bthet(j,i,1,1),j=1,2)
+ & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2)
enddo
write (iout,'(/a/9x,5a/79(1h-))')
& 'Parameters of the expression for sigma(theta_c):',
bsc(1,i)=0.0D0
read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3),
& ((blower(k,l,1),l=1,k),k=1,3)
- censc(1,1,-i)=censc(1,1,i)
- censc(2,1,-i)=censc(2,1,i)
- censc(3,1,-i)=-censc(3,1,i)
-
do j=2,nlob(i)
read (irotam,*,end=112,err=112) bsc(j,i)
read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3),
& ((blower(k,l,j),l=1,k),k=1,3)
- censc(1,j,-i)=censc(1,j,i)
- censc(2,j,-i)=censc(2,j,i)
- censc(3,j,-i)=-censc(3,j,i)
-C BSC is amplitude of Gaussian
enddo
do j=1,nlob(i)
do k=1,3
enddo
gaussc(k,l,j,i)=akl
gaussc(l,k,j,i)=akl
- if (((k.eq.3).and.(l.ne.3))
- & .or.((l.eq.3).and.(k.ne.3))) then
- gaussc(k,l,j,-i)=-akl
- gaussc(l,k,j,-i)=-akl
- else
- gaussc(k,l,j,-i)=akl
- gaussc(l,k,j,-i)=akl
- endif
enddo
enddo
enddo
C
read (itorp,*,end=113,err=113) ntortyp
read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp)
- do iblock=1,2
- do i=-ntyp,-1
- itortyp(i)=-itortyp(-i)
- enddo
c 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),
- & nlor(i,j,iblock)
- nterm(-i,-j,iblock)=nterm(i,j,iblock)
- nlor(-i,-j,iblock)=nlor(i,j,iblock)
+ do i=1,ntortyp
+ do j=1,ntortyp
+ read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j)
v0ij=0.0d0
si=-1.0d0
- do k=1,nterm(i,j,iblock)
- read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock),
- & v2(k,i,j,iblock)
- v1(k,-i,-j,iblock)=v1(k,i,j,iblock)
- v2(k,-i,-j,iblock)=-v2(k,i,j,iblock)
- v0ij=v0ij+si*v1(k,i,j,iblock)
+ do k=1,nterm(i,j)
+ read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j)
+ v0ij=v0ij+si*v1(k,i,j)
si=-si
-c write(iout,*) i,j,k,iblock,nterm(i,j,iblock)
-c write(iout,*) v1(k,-i,-j,iblock),v1(k,i,j,iblock),
-c &v2(k,-i,-j,iblock),v2(k,i,j,iblock)
enddo
- do k=1,nlor(i,j,iblock)
+ do k=1,nlor(i,j)
read (itorp,*,end=113,err=113) kk,vlor1(k,i,j),
& vlor2(k,i,j),vlor3(k,i,j)
v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2)
enddo
- v0(i,j,iblock)=v0ij
- v0(-i,-j,iblock)=v0ij
+ v0(i,j)=v0ij
enddo
enddo
- enddo
close (itorp)
if (lprint) then
write (iout,'(/a/)') 'Torsional constants:'
do j=1,ntortyp
write (iout,*) 'ityp',i,' jtyp',j
write (iout,*) 'Fourier constants'
- do k=1,nterm(i,j,iblock)
- write (iout,'(2(1pe15.5))') v1(k,i,j,iblock),
- & v2(k,i,j,iblock)
+ do k=1,nterm(i,j)
+ write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j)
enddo
write (iout,*) 'Lorenz constants'
- do k=1,nlor(i,j,iblock)
+ do k=1,nlor(i,j)
write (iout,'(3(1pe15.5))')
& vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
enddo
C
C 6/23/01 Read parameters for double torsionals
C
- do iblock=1,2
- do i=0,ntortyp-1
- do j=-ntortyp+1,ntortyp-1
- do k=-ntortyp+1,ntortyp-1
+ do i=1,ntortyp
+ do j=1,ntortyp
+ do k=1,ntortyp
read (itordp,'(3a1)',end=114,err=114) t1,t2,t3
- if (t1.ne.onelett(i) .or. t2.ne.onelett(j)
- & .or. t3.ne.onelett(k)) then
+ c write (iout,*) "OK onelett",
+ c & i,j,k,t1,t2,t3
+
+ if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j)
+ & .or. t3.ne.toronelet(k)) then
write (iout,*) "Error in double torsional parameter file",
& i,j,k,t1,t2,t3
#ifdef MPI
#endif
stop "Error in double torsional parameter file"
endif
- read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock),
- & ntermd_2(i,j,k,iblock)
- ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock)
- ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock)
- read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1,
- & ntermd_1(i,j,k,iblock))
- read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1,
- & ntermd_1(i,j,k,iblock))
- read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1,
- & ntermd_1(i,j,k,iblock))
- read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1,
- & ntermd_1(i,j,k,iblock))
-C Martix of D parameters for one dimesional foureir series
- do l=1,ntermd_1(i,j,k,iblock)
- v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock)
- v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock)
- v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock)
- v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock)
-c write(iout,*) "whcodze" ,
-c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock)
- enddo
- read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock),
- & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock),
- & v2s(m,l,i,j,k,iblock),
- & m=1,l-1),l=1,ntermd_2(i,j,k,iblock))
-C Martix of D parameters for two dimesional fourier series
- do l=1,ntermd_2(i,j,k,iblock)
- do m=1,l-1
- v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock)
- v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock)
- v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock)
- v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock)
- enddo!m
- enddo!l
- enddo!k
- enddo!j
- enddo!i
- enddo!iblock
+ read (itordp,*,end=114,err=114) ntermd_1(i,j,k),
+ & ntermd_2(i,j,k)
+ read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1,
+ & ntermd_1(i,j,k))
+ read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1,
+ & ntermd_1(i,j,k))
+ read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1,
+ & ntermd_1(i,j,k))
+ read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1,
+ & ntermd_1(i,j,k))
+ read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k),
+ & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k),
+ & m=1,l-1),l=1,ntermd_2(i,j,k))
+ enddo
+ enddo
+ enddo
if (lprint) then
write (iout,*)
write (iout,*) 'Constants for double torsionals'
- do iblock=1,2
do i=1,ntortyp
- do j=-ntortyp,ntortyp
- do k=-ntortyp,ntortyp
+ do j=1,ntortyp
+ do k=1,ntortyp
write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k,
- & ' nsingle',ntermd_1(i,j,k,iblock),
- & ' ndouble',ntermd_2(i,j,k,iblock)
+ & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k)
write (iout,*)
write (iout,*) 'Single angles:'
- do l=1,ntermd_1(i,j,k,iblock)
- write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l,
- & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock),
- & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock),
- & v1s(1,l,-i,-j,-k,iblock),v1s(2,l,-i,-j,-k,iblock)
+ do l=1,ntermd_1(i,j,k)
+ write (iout,'(i5,2f10.5,5x,2f10.5)') l,
+ & v1c(1,l,i,j,k),v1s(1,l,i,j,k),
+ & v1c(2,l,i,j,k),v1s(2,l,i,j,k)
enddo
write (iout,*)
write (iout,*) 'Pairs of angles:'
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
- do l=1,ntermd_2(i,j,k,iblock)
+ write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
+ do l=1,ntermd_2(i,j,k)
write (iout,'(i5,20f10.5)')
- & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock))
+ & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k))
enddo
write (iout,*)
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
- do l=1,ntermd_2(i,j,k,iblock)
+ write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
+ do l=1,ntermd_2(i,j,k)
write (iout,'(i5,20f10.5)')
- & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)),
- & (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock))
+ & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k))
enddo
write (iout,*)
enddo
enddo
enddo
- enddo
endif
#endif
C Read of Side-chain backbone correlation parameters
CCC
C
read (isccor,*,end=113,err=113) nsccortyp
-#ifdef SCCORPDB
read (isccor,*,end=113,err=113) (isccortyp(i),i=1,ntyp)
+ do i=-ntyp,-1
+ isccortyp(i)=-isccortyp(-i)
+ enddo
+ iscprol=isccortyp(20)
c write (iout,*) 'ntortyp',ntortyp
maxinter=3
cc maxinter is maximum interaction sites
do j=1,nsccortyp
read (isccor,*,end=113,err=113) 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)
+ nterm_sccor(i,-j)=nterm_sccor(i,j)
do k=1,nterm_sccor(i,j)
read (isccor,*,end=113,err=113) kk,v1sccor(k,l,i,j)
- & ,v2sccor(k,l,i,j)
+ & ,v2sccor(k,l,i,j)
+ if (j.eq.iscprol) then
+ if (i.eq.isccortyp(10)) then
+ v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
+ else
+ v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)*0.5d0
+ & +v2sccor(k,l,i,j)*dsqrt(0.75d0)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)*0.5d0
+ & +v1sccor(k,l,i,j)*dsqrt(0.75d0)
+ v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j)
+ v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j)
+ v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j)
+ endif
+ else
+ if (i.eq.isccortyp(10)) then
+ v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
+ else
+ if (j.eq.isccortyp(10)) then
+ v1sccor(k,l,-i,j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,-i,j)=-v2sccor(k,l,i,j)
+ else
+ v1sccor(k,l,i,-j)=-v1sccor(k,l,i,j)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
+ v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j)
+ v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j)
+ v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j)
+ endif
+ 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)
v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/
&(1+vlor3sccor(k,i,j)**2)
enddo
+ 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)
+ 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)
+ & 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)
+ & ,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),
+ & 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
enddo
enddo
enddo
close (isccor)
-
+
+ #endif
if (lprint) then
write (iout,'(/a/)') 'Torsional constants:'
do i=1,nsccortyp
write (iout,*) "Coefficients of the cumulants"
endif
read (ifourier,*) nloctyp
- do i=0,nloctyp-1
+ do i=1,nloctyp
read (ifourier,*,end=115,err=115)
read (ifourier,*,end=115,err=115) (b(ii),ii=1,13)
if (lprint) then
endif
B1(1,i) = b(3)
B1(2,i) = b(5)
c b1(1,i)=0.0d0
c b1(2,i)=0.0d0
B1tilde(1,i) = b(3)
- B1tilde(2,i) =-b(5)
+ B1tilde(2,i) =-b(5)
+ B1tilde(1,-i) =-b(3)
+ B1tilde(2,-i) =b(5)
c b1tilde(1,i)=0.0d0
c b1tilde(2,i)=0.0d0
B2(1,i) = b(2)
B2(2,i) = b(4)
- B2(1,-i) =b(2)
- B2(2,-i) =-b(4)
-
c b2(1,i)=0.0d0
c b2(2,i)=0.0d0
CC(1,1,i)= b(7)
CC(2,2,i)=-b(7)
CC(2,1,i)= b(9)
CC(1,2,i)= b(9)
- CC(1,1,-i)= b(7)
- CC(2,2,-i)=-b(7)
- CC(2,1,-i)=-b(9)
- CC(1,2,-i)=-b(9)
c CC(1,1,i)=0.0d0
c CC(2,2,i)=0.0d0
c CC(2,1,i)=0.0d0
Ctilde(1,2,i)=b(9)
Ctilde(2,1,i)=-b(9)
Ctilde(2,2,i)=b(7)
- Ctilde(1,1,-i)=b(7)
- Ctilde(1,2,-i)=-b(9)
- Ctilde(2,1,-i)=b(9)
- Ctilde(2,2,-i)=b(7)
-
c Ctilde(1,1,i)=0.0d0
c Ctilde(1,2,i)=0.0d0
c Ctilde(2,1,i)=0.0d0
DD(2,2,i)=-b(6)
DD(2,1,i)= b(8)
DD(1,2,i)= b(8)
- DD(1,1,-i)= b(6)
- DD(2,2,-i)=-b(6)
- DD(2,1,-i)=-b(8)
- DD(1,2,-i)=-b(8)
c DD(1,1,i)=0.0d0
c DD(2,2,i)=0.0d0
c DD(2,1,i)=0.0d0
Dtilde(1,2,i)=b(8)
Dtilde(2,1,i)=-b(8)
Dtilde(2,2,i)=b(6)
- Dtilde(1,1,-i)=b(6)
- Dtilde(1,2,-i)=-b(8)
- Dtilde(2,1,-i)=b(8)
- Dtilde(2,2,-i)=b(6)
-
c Dtilde(1,1,i)=0.0d0
c Dtilde(1,2,i)=0.0d0
c Dtilde(2,1,i)=0.0d0
EE(2,2,i)=-b(10)+b(11)
EE(2,1,i)= b(12)-b(13)
EE(1,2,i)= b(12)+b(13)
- EE(1,1,-i)= b(10)+b(11)
- EE(2,2,-i)=-b(10)+b(11)
- EE(2,1,-i)=-b(12)+b(13)
- EE(1,2,-i)=-b(12)-b(13)
-
c ee(1,1,i)=1.0d0
c ee(2,2,i)=1.0d0
c ee(2,1,i)=0.0d0
call reada(weightcard,'WTORD',wtor_d,1.0D0)
call reada(weightcard,'WANG',wang,1.0D0)
call reada(weightcard,'WSCLOC',wscloc,1.0D0)
+C Bartek
+ call reada(weightcard,'WDFAD',wdfa_dist,0.0d0)
+ call reada(weightcard,'WDFAT',wdfa_tor,0.0d0)
+ call reada(weightcard,'WDFAN',wdfa_nei,0.0d0)
+ call reada(weightcard,'WDFAB',wdfa_beta,0.0d0)
+C
call reada(weightcard,'SCAL14',scal14,0.4D0)
call reada(weightcard,'SCALSCP',scalscp,1.0d0)
call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
weights(18)=scal14
weights(21)=wsccor
endif
+C Bartek
+ weights(24)=wdfa_dist
+ weights(25)=wdfa_tor
+ weights(26)=wdfa_nei
+ weights(27)=wdfa_beta
if(me.eq.king.or..not.out1file)
& write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
& wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
- & wturn4,wturn6
+ & wturn4,wturn6,
+ & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta
+
10 format (/'Energy-term weights (unscaled):'//
& 'WSCC= ',f10.6,' (SC-SC)'/
& 'WSCP= ',f10.6,' (SC-p)'/
& 'WSCCOR= ',f10.6,' (back-scloc correlation)'/
& 'WTURN3= ',f10.6,' (turns, 3rd order)'/
& 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
+ & 'WTURN6= ',f10.6,' (turns, 6th order)'/
+ & 'WDFA_D= ',f10.6,' (DFA, distance)' /
+ & 'WDFA_T= ',f10.6,' (DFA, torsional)' /
+ & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)' /
+ & 'WDFA_B= ',f10.6,' (DFA, beta formation)')
+
if(me.eq.king.or..not.out1file)then
if (wcorr4.gt.0.0d0) then
write (iout,'(/2a/)') 'Local-electrostatic type correlation ',
if(me.eq.king.or..not.out1file)
& write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
& wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
- & wturn4,wturn6
+ & wturn4,wturn6,
+ & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta
+
22 format (/'Energy-term weights (scaled):'//
& 'WSCC= ',f10.6,' (SC-SC)'/
& 'WSCP= ',f10.6,' (SC-p)'/
& 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/
& 'WTURN3= ',f10.6,' (turns, 3rd order)'/
& 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
+ & 'WTURN6= ',f10.6,' (turns, 6th order)'/
+ & 'WDFA_D= ',f10.6,' (DFA, distance)' /
+ & 'WDFA_T= ',f10.6,' (DFA, torsional)' /
+ & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)' /
+ & 'WDFA_B= ',f10.6,' (DFA, beta formation)')
+
if(me.eq.king.or..not.out1file)
& write (iout,*) "Reference temperature for weights calculation:",
& temp0
vbld_inv(i)=vblinv
enddo
do i=2,nres-1
- vbld(i+nres)=dsc(iabs(itype(i)))
- vbld_inv(i+nres)=dsc_inv(iabs(itype(i)))
+ vbld(i+nres)=dsc(itype(i))
+ vbld_inv(i+nres)=dsc_inv(itype(i))
c write (iout,*) "i",i," itype",itype(i),
c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres)
enddo
c print '(20i4)',(itype(i),i=1,nres)
do i=1,nres
#ifdef PROCOR
- if (itype(i).eq.21 .or. itype(i+1).eq.21) then
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then
#else
- if (itype(i).eq.21) then
+ if (itype(i).eq.ntyp1) then
#endif
itel(i)=0
#ifdef PROCOR
- else if (iabs(itype(i+1)).ne.20) then
+ else if (itype(i+1).ne.20) then
#else
- else if (iabs(itype(i)).ne.20) then
+ else if (itype(i).ne.20) then
#endif
itel(i)=1
else
#endif
nct=nres
cd print *,'NNT=',NNT,' NCT=',NCT
- if (itype(1).eq.21) nnt=2
- if (itype(nres).eq.21) nct=nct-1
-
- C Juyong:READ init_vars
- C Initialize variables!
- C Juyong:READ read_info
- C READ fragment information!!
- C both routines should be in dfa.F file!!
-
- if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and.
- & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then
- call init_dfa_vars
- print*, 'init_dfa_vars finished!'
- call read_dfa_info
- print*, 'read_dfa_info finished!'
- endif
- C
- C
-
-
+ if (itype(1).eq.ntyp1) nnt=2
+ if (itype(nres).eq.ntyp1) nct=nct-1
if (pdbref) then
if(me.eq.king.or..not.out1file)
& write (iout,'(a,i3)') 'nsup=',nsup
enddo
do i=2,nres-1
omeg(i)=-120d0*deg2rad
- if (itype(i).le.0) omeg(i)=-omeg(i)
enddo
else
if(me.eq.king.or..not.out1file)
c Don't do glycine or ends
i=itype(res_pick)
- if (i.eq.10 .or. i.eq.21) return
+ if (i.eq.10 .or. i.eq.ntyp1) return
c Freeze everything (later will relax only selected side-chains)
mask_r=.true.
n_try=0
do while (n_try.lt.n_maxtry .and. orig_e-cur_e.lt.e_drop)
c Move the selected residue (don't worry if it fails)
- call gen_side(iabs(itype(res_pick)),theta(res_pick+1),
+ call gen_side(itype(res_pick),theta(res_pick+1),
+ alph(res_pick),omeg(res_pick),fail)
c Minimize the side-chains starting from the new arrangement
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do j=istart(i,iint),iend(i,iint)
IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
ind=ind+1
- itypj=iabs(itype(j))
+ itypj=itype(j)
dscj_inv=dsc_inv(itypj)
sig0ij=sigma(itypi,itypj)
chi1=chi(itypi,itypj)
evdw=0.0D0
evdw_t=0.0d0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
cd & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
+ itypj=iabs(itype(j))
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
evdw=0.0D0
evdw_t=0.0d0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
+ itypj=iabs(itype(j))
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
c endif
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
chi2=chi(itypj,itypi)
c if (icall.gt.0) lprn=.true.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
chi1=chi(itypi,itypj)
c if (icall.gt.0) lprn=.true.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
r0ij=r0(itypi,itypj)
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
+ itypj=iabs(itype(j))
C Uncomment following three lines for SC-p interactions
c xj=c(1,nres+j)-xi
c yj=c(2,nres+j)-yi
c & dhpb(i),dhpb1(i),forcon(i)
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
- if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
+ if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+ & iabs(itype(jjj)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
cd write (iout,*) "eij",eij
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=itype(i)
+ itypi=iabs(itype(i))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
dsci_inv=dsc_inv(itypi)
- itypj=itype(j)
+ itypj=iabs(itype(j))
dscj_inv=dsc_inv(itypj)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
c
do i=nnt,nct
- iti=itype(i)
+ iti=iabs(itype(i))
if (iti.ne.10) then
nbi=nbondterm(iti)
if (nbi.eq.1) then
C Zero the energy function and its derivative at 0 or pi.
call splinthet(theta(i),0.5d0*delta,ss,ssd)
it=itype(i-1)
+ ichir1=isign(1,itype(i-2))
+ ichir2=isign(1,itype(i))
+ if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
+ if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
+ if (itype(i-1).eq.10) then
+ itype1=isign(10,itype(i-2))
+ ichir11=isign(1,itype(i-2))
+ ichir12=isign(1,itype(i-2))
+ itype2=isign(10,itype(i))
+ ichir21=isign(1,itype(i))
+ ichir22=isign(1,itype(i))
+ endif
c if (i.gt.ithet_start .and.
c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
C In following comments this theta will be referred to as t_c.
thet_pred_mean=0.0d0
do k=1,2
- athetk=athet(k,it)
- bthetk=bthet(k,it)
+ athetk=athet(k,it,ichir1,ichir2)
+ bthetk=bthet(k,it,ichir1,ichir2)
+ if (it.eq.10) then
+ athetk=athet(k,itype1,ichir11,ichir12)
+ bthetk=bthet(k,itype2,ichir21,ichir22)
+ endif
thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
enddo
c write (iout,*) "thet_pred_mean",thet_pred_mean
thet_pred_mean=thet_pred_mean*ss+a0thet(it)
c write (iout,*) "thet_pred_mean",thet_pred_mean
C Derivatives of the "mean" values in gamma1 and gamma2.
- dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
- dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
+ dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
+ &+athet(2,it,ichir1,ichir2)*y(1))*ss
+ dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
+ & +bthet(2,it,ichir1,ichir2)*z(1))*ss
+ if (it.eq.10) then
+ dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
+ &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
+ dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
+ & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
+ endif
if (theta(i).gt.pi-delta) then
call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
& E_tc0)
dephii=0.0d0
dephii1=0.0d0
theti2=0.5d0*theta(i)
- ityp2=ithetyp(itype(i-1))
+ ityp2=ithetyp(iabs(itype(i-1)))
do k=1,nntheterm
coskt(k)=dcos(k*theti2)
sinkt(k)=dsin(k*theti2)
#else
phii=phi(i)
#endif
- ityp1=ithetyp(itype(i-2))
+ ityp1=ithetyp(iabs(itype(i-2)))
do k=1,nsingle
cosph1(k)=dcos(k*phii)
sinph1(k)=dsin(k*phii)
#else
phii1=phi(i+1)
#endif
- ityp3=ithetyp(itype(i))
+ ityp3=ithetyp(iabs(itype(i)))
do k=1,nsingle
cosph2(k)=dcos(k*phii1)
sinph2(k)=dsin(k*phii1)
do i=loc_start,loc_end
it=itype(i)
if (it.eq.10) goto 1
- nlobit=nlob(it)
+ nlobit=nlob(iabs(it))
c print *,'i=',i,' it=',it,' nlobit=',nlobit
c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
theti=theta(i+1)-pipol
do iii=-1,1
do j=1,nlobit
- expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
cd print *,'j=',j,' expfac=',expfac
escloc_i=escloc_i+expfac
do k=1,3
dersc12=0.0d0
do j=1,nlobit
- expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
escloc_i=escloc_i+expfac
do k=1,2
dersc(k)=dersc(k)+Ax(k,j)*expfac
cosfac=dsqrt(cosfac2)
sinfac2=0.5d0/(1.0d0-costtab(i+1))
sinfac=dsqrt(sinfac2)
- it=itype(i)
+ it=iabs(itype(i))
if (it.eq.10) goto 1
c
C Compute the axes of tghe local cartesian coordinates system; store in
do j = 1,3
xx = xx + x_prime(j)*dc_norm(j,i+nres)
yy = yy + y_prime(j)*dc_norm(j,i+nres)
- zz = zz + z_prime(j)*dc_norm(j,i+nres)
+ zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
enddo
xxtab(i)=xx
C Compute the energy of the ith side cbain
C
c write (2,*) "xx",xx," yy",yy," zz",zz
- it=itype(i)
+ it=iabs(itype(i))
do j = 1,65
x(j) = sc_parmin(j,it)
enddo
Cc diagnostics - remove later
xx1 = dcos(alph(2))
yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsin(alph(2))*dsin(omeg(2))
+ zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
write(2,'(3f8.1,3f9.3,1x,3f9.3)')
& alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
& xx1,yy1,zz1
etors=0.0D0
do i=iphi_start,iphi_end
if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
+ if (iabs(itype(i)).eq.20) then
+ iblock=2
+ else
+ iblock=1
+ endif
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
phii=phi(i)
gloci=0.0D0
C Regular cosine and sine terms
- do j=1,nterm(itori,itori1)
- v1ij=v1(j,itori,itori1)
- v2ij=v2(j,itori,itori1)
+ do j=1,nterm(itori,itori1,iblock)
+ v1ij=v1(j,itori,itori1,iblock)
+ v2ij=v2(j,itori,itori1,iblock)
cosphi=dcos(j*phii)
sinphi=dsin(j*phii)
etors=etors+v1ij*cosphi+v2ij*sinphi
C
cosphi=dcos(0.5d0*phii)
sinphi=dsin(0.5d0*phii)
- do j=1,nlor(itori,itori1)
+ do j=1,nlor(itori,itori1,iblock)
vl1ij=vlor1(j,itori,itori1)
vl2ij=vlor2(j,itori,itori1)
vl3ij=vlor3(j,itori,itori1)
gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
enddo
C Subtract the constant term
- etors=etors-v0(itori,itori1)
+ etors=etors-v0(itori,itori1,iblock)
if (lprn)
& write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
& restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
- & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
+ & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
1215 continue
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
itori2=itortyp(itype(i))
-c iblock=1
-c if (iabs(itype(i+1)).eq.20) iblock=2
phii=phi(i)
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
+ iblock=1
+ if (iabs(itype(i+1)).eq.20) iblock=2
C Regular cosine and sine terms
- do j=1,ntermd_1(itori,itori1,itori2)
- v1cij=v1c(1,j,itori,itori1,itori2)
- v1sij=v1s(1,j,itori,itori1,itori2)
- v2cij=v1c(2,j,itori,itori1,itori2)
- v2sij=v1s(2,j,itori,itori1,itori2)
-c c do j=1,ntermd_1(itori,itori1,itori2,iblock)
-c v1cij=v1c(1,j,itori,itori1,itori2,iblock)
-c v1sij=v1s(1,j,itori,itori1,itori2,iblock)
-c v2cij=v1c(2,j,itori,itori1,itori2,iblock)
-c v2sij=v1s(2,j,itori,itori1,itori2,iblock)
+ do j=1,ntermd_1(itori,itori1,itori2,iblock)
+ v1cij=v1c(1,j,itori,itori1,itori2,iblock)
+ v1sij=v1s(1,j,itori,itori1,itori2,iblock)
+ v2cij=v1c(2,j,itori,itori1,itori2,iblock)
+ v2sij=v1s(2,j,itori,itori1,itori2,iblock)
-
cosphi1=dcos(j*phii)
sinphi1=dsin(j*phii)
cosphi2=dcos(j*phii1)
gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
enddo
- do k=2,ntermd_2(itori,itori1,itori2)
+ do k=2,ntermd_2(itori,itori1,itori2,iblock)
do l=1,k-1
- v1cdij = v2c(k,l,itori,itori1,itori2)
- v2cdij = v2c(l,k,itori,itori1,itori2)
- v1sdij = v2s(k,l,itori,itori1,itori2)
- v2sdij = v2s(l,k,itori,itori1,itori2)
+ v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
+ v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
+ v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
+ v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
cosphi1p2=dcos(l*phii+(k-l)*phii1)
cosphi1m2=dcos(l*phii-(k-l)*phii1)
sinphi1p2=dsin(l*phii+(k-l)*phii1)
C Set lprn=.true. for debugging
lprn=.false.
c lprn=.true.
-c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
+c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
esccor=0.0D0
do i=itau_start,itau_end
esccor_ii=0.0D0
- isccori=isccortyp(itype(i-2))
- isccori1=isccortyp(itype(i-1))
+ isccori=isccortyp((itype(i-2)))
+ isccori1=isccortyp((itype(i-1)))
phii=phi(i)
cccc Added 9 May 2012
cc Tauangle is torsional engle depending on the value of first digit
c 3 = SC...Ca...Ca...SCi
gloci=0.0D0
if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
- & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
- & (itype(i-1).eq.21)))
+ & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
+ & (itype(i-1).eq.ntyp1)))
& .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
- & .or.(itype(i-2).eq.21)))
+ & .or.(itype(i-2).eq.ntyp1)))
& .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
- & (itype(i-1).eq.21)))) cycle
- if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
- if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
+ & (itype(i-1).eq.ntyp1)))) cycle
+ if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
+ if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
& cycle
do j=1,nterm_sccor(isccori,isccori1)
v1ij=v1sccor(j,intertyp,isccori,isccori1)
include 'COMMON.FREE'
character*1 t1,t2,t3
character*1 onelett(4) /"G","A","P","D"/
- character*1 toronelet(-2:2)/"p","a","G","A","P"/
logical lprint
dimension blower(3,3,maxlob)
character*800 controlcard
wtor=ww(13)
wtor_d=ww(14)
wvdwpp=ww(16)
+ wstrain=ww(15)
wbond=ww(18)
wsccor=ww(19)
C of the virtual-bond valence angles theta
C
do i=1,ntyp
- read (ithep,*) a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2)
+ read (ithep,*) a0thet(i),(athet(j,i,1,1),j=1,2),
+ & (bthet(j,i,1,1),j=1,2)
read (ithep,*) (polthet(j,i),j=0,3)
read (ithep,*) (gthet(j,i),j=1,3)
read (ithep,*) 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
close (ithep)
if (lprint) then
c write (iout,'(a)')
& ' b1*10^1 ',' b2*10^1 '
do i=1,ntyp
write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),
- & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2)
+ & a0thet(i),(100*athet(j,i,1,1),j=1,2),
+ & (10*bthet(j,i,1,1),j=1,2)
enddo
write (iout,'(/a/9x,5a/79(1h-))')
& 'Parameters of the expression for sigma(theta_c):',
enddo
bsc(1,i)=0.0D0
read(irotam,*)(censc(k,1,i),k=1,3),((blower(k,l,1),l=1,k),k=1,3)
+ censc(1,1,-i)=censc(1,1,i)
+ censc(2,1,-i)=censc(2,1,i)
+ censc(3,1,-i)=-censc(3,1,i)
do j=2,nlob(i)
read (irotam,*) bsc(j,i)
read (irotam,*) (censc(k,j,i),k=1,3),
& ((blower(k,l,j),l=1,k),k=1,3)
+ censc(1,j,-i)=censc(1,j,i)
+ censc(2,j,-i)=censc(2,j,i)
+ censc(3,j,-i)=-censc(3,j,i)
enddo
do j=1,nlob(i)
do k=1,3
enddo
gaussc(k,l,j,i)=akl
gaussc(l,k,j,i)=akl
+ if (((k.eq.3).and.(l.ne.3))
+ & .or.((l.eq.3).and.(k.ne.3))) then
+ gaussc(k,l,j,-i)=-akl
+ gaussc(l,k,j,-i)=-akl
+ else
+ gaussc(k,l,j,-i)=akl
+ gaussc(l,k,j,-i)=akl
+ endif
enddo
enddo
enddo
C
read (itorp,*) ntortyp
read (itorp,*) (itortyp(i),i=1,ntyp)
- write (iout,*) 'ntortyp',ntortyp
- do i=1,ntortyp
- do j=1,ntortyp
- read (itorp,*) nterm(i,j),nlor(i,j)
+ do iblock=1,2
+ do i=-ntyp,-1
+ itortyp(i)=-itortyp(-i)
+ enddo
+ c write (iout,*) 'ntortyp',ntortyp
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ read (itorp,*) nterm(i,j,iblock),
+ & nlor(i,j,iblock)
+ nterm(-i,-j,iblock)=nterm(i,j,iblock)
+ nlor(-i,-j,iblock)=nlor(i,j,iblock)
v0ij=0.0d0
si=-1.0d0
- do k=1,nterm(i,j)
- read (itorp,*) kk,v1(k,i,j),v2(k,i,j)
- v0ij=v0ij+si*v1(k,i,j)
+ do k=1,nterm(i,j,iblock)
+ read (itorp,*) kk,v1(k,i,j,iblock),v2(k,i,j,iblock)
+ v1(k,-i,-j,iblock)=v1(k,i,j,iblock)
+ v2(k,-i,-j,iblock)=-v2(k,i,j,iblock)
+ v0ij=v0ij+si*v1(k,i,j,iblock)
si=-si
enddo
- do k=1,nlor(i,j)
+ do k=1,nlor(i,j,iblock)
read (itorp,*) kk,vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2)
enddo
- v0(i,j)=v0ij
+ v0(i,j,iblock)=v0ij
+ v0(-i,-j,iblock)=v0ij
enddo
enddo
+ enddo
close (itorp)
if (lprint) then
write (iout,'(/a/)') 'Torsional constants:'
do j=1,ntortyp
write (iout,*) 'ityp',i,' jtyp',j
write (iout,*) 'Fourier constants'
- do k=1,nterm(i,j)
- write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j)
+ do k=1,nterm(i,j,iblock)
+ write (iout,'(2(1pe15.5))') v1(k,i,j,iblock),
+ & v2(k,i,j,iblock)
enddo
write (iout,*) 'Lorenz constants'
- do k=1,nlor(i,j)
+ do k=1,nlor(i,j,iblock)
write (iout,'(3(1pe15.5))')
& vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
enddo
C
C 6/23/01 Read parameters for double torsionals
C
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
+ do iblock=1,2
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
read (itordp,'(3a1)') t1,t2,t3
- if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j)
- & .or. t3.ne.toronelet(k)) then
+ if (t1.ne.onelett(i) .or. t2.ne.onelett(j)
+ & .or. t3.ne.onelett(k)) then
write (iout,*) "Error in double torsional parameter file",
& i,j,k,t1,t2,t3
stop "Error in double torsional parameter file"
endif
- read (itordp,*) ntermd_1(i,j,k),ntermd_2(i,j,k)
- read (itordp,*) (v1c(1,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1s(1,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1c(2,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) (v1s(2,l,i,j,k),l=1,ntermd_1(i,j,k))
- read (itordp,*) ((v2c(l,m,i,j,k),v2c(m,l,i,j,k),
- & v2s(l,m,i,j,k),v2s(m,l,i,j,k),m=1,l-1),l=1,ntermd_2(i,j,k))
- enddo
- enddo
- enddo
+ read (itordp,*) ntermd_1(i,j,k,iblock),
+ & ntermd_2(i,j,k,iblock)
+ ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock)
+ ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock)
+ read (itordp,*) (v1c(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (v1s(1,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (v1c(2,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ read (itordp,*) (v1s(2,l,i,j,k,iblock),l=1,
+ & ntermd_1(i,j,k,iblock))
+ C Martix of D parameters for one dimesional foureir series
+ do l=1,ntermd_1(i,j,k,iblock)
+ v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock)
+ v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock)
+ v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock)
+ v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock)
+ c write(iout,*) "whcodze" ,
+ c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock)
+ enddo
+ read (itordp,*) ((v2c(l,m,i,j,k,iblock),
+ & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock),
+ & v2s(m,l,i,j,k,iblock),
+ & m=1,l-1),l=1,ntermd_2(i,j,k,iblock))
+ C Martix of D parameters for two dimesional fourier series
+ do l=1,ntermd_2(i,j,k,iblock)
+ do m=1,l-1
+ v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock)
+ v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock)
+ v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock)
+ v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock)
+ enddo!m
+ enddo!l
+ enddo!k
+ enddo!j
+ enddo!i
+ enddo!iblock
if (lprint) then
write (iout,*)
write (iout,*) 'Constants for double torsionals'
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
+ do iblock=1,2
+ do i=0,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k,
- & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k)
+ & ' nsingle',ntermd_1(i,j,k,iblock),
+ & ' ndouble',ntermd_2(i,j,k,iblock)
write (iout,*)
write (iout,*) 'Single angles:'
- do l=1,ntermd_1(i,j,k)
+ do l=1,ntermd_1(i,j,k,iblock)
write (iout,'(i5,2f10.5,5x,2f10.5)') l,
- & v1c(1,l,i,j,k),v1s(1,l,i,j,k),
- & v1c(2,l,i,j,k),v1s(2,l,i,j,k)
+ & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock),
+ & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock)
enddo
write (iout,*)
write (iout,*) 'Pairs of angles:'
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
- do l=1,ntermd_2(i,j,k)
+ write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
+ do l=1,ntermd_2(i,j,k,iblock)
write (iout,'(i5,20f10.5)')
- & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k))
+ & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock))
enddo
write (iout,*)
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
- do l=1,ntermd_2(i,j,k)
+ write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
+ do l=1,ntermd_2(i,j,k,iblock)
write (iout,'(i5,20f10.5)')
- & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k))
+ & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock))
enddo
write (iout,*)
enddo
enddo
enddo
+ enddo
endif
#endif
C Read of Side-chain backbone correlation parameters
C
read (isccor,*) nsccortyp
read (isccor,*) (isccortyp(i),i=1,ntyp)
+ do i=-ntyp,-1
+ isccortyp(i)=-isccortyp(-i)
+ enddo
+ iscprol=isccortyp(20)
c write (iout,*) 'ntortyp',ntortyp
maxinter=3
cc maxinter is maximum interaction sites
do j=1,nsccortyp
read (isccor,*) 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)
+ nterm_sccor(i,-j)=nterm_sccor(i,j)
do k=1,nterm_sccor(i,j)
read (isccor,*) kk,v1sccor(k,l,i,j)
& ,v2sccor(k,l,i,j)
+ if (j.eq.iscprol) then
+ if (i.eq.isccortyp(10)) then
+ v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
+ else
+ v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)*0.5d0
+ & +v2sccor(k,l,i,j)*dsqrt(0.75d0)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)*0.5d0
+ & +v1sccor(k,l,i,j)*dsqrt(0.75d0)
+ v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j)
+ v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j)
+ v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j)
+ endif
+ else
+ if (i.eq.isccortyp(10)) then
+ v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
+ else
+ if (j.eq.isccortyp(10)) then
+ v1sccor(k,l,-i,j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,-i,j)=-v2sccor(k,l,i,j)
+ else
+ v1sccor(k,l,i,-j)=-v1sccor(k,l,i,j)
+ v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
+ v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j)
+ v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j)
+ v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j)
+ v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j)
+ endif
+ 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)
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
C interaction energy of the Gly, Ala, and Pro prototypes.
C
read (ifourier,*) nloctyp
- do i=1,nloctyp
+ do i=0,nloctyp-1
read (ifourier,*)
- read (ifourier,*) (b(ii,i),ii=1,13)
+ read (ifourier,*) (b(ii),ii=1,13)
if (lprint) then
write (iout,*) 'Type',i
- write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13)
+ write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13)
endif
- B1(1,i) = b(3,i)
- B1(2,i) = b(5,i)
- B1tilde(1,i) = b(3,i)
- B1tilde(2,i) =-b(5,i)
- B2(1,i) = b(2,i)
- B2(2,i) = b(4,i)
- CC(1,1,i)= b(7,i)
- CC(2,2,i)=-b(7,i)
- CC(2,1,i)= b(9,i)
- CC(1,2,i)= b(9,i)
- Ctilde(1,1,i)=b(7,i)
- Ctilde(1,2,i)=b(9,i)
- Ctilde(2,1,i)=-b(9,i)
- Ctilde(2,2,i)=b(7,i)
- DD(1,1,i)= b(6,i)
- DD(2,2,i)=-b(6,i)
- DD(2,1,i)= b(8,i)
- DD(1,2,i)= b(8,i)
- Dtilde(1,1,i)=b(6,i)
- Dtilde(1,2,i)=b(8,i)
- Dtilde(2,1,i)=-b(8,i)
- Dtilde(2,2,i)=b(6,i)
- EE(1,1,i)= b(10,i)+b(11,i)
- EE(2,2,i)=-b(10,i)+b(11,i)
- EE(2,1,i)= b(12,i)-b(13,i)
- EE(1,2,i)= b(12,i)+b(13,i)
+ B1(1,i) = b(3)
+ B1(2,i) = b(5)
+ B1(1,-i) = b(3)
+ B1(2,-i) = -b(5)
+ c b1(1,i)=0.0d0
+ c b1(2,i)=0.0d0
+ B1tilde(1,i) = b(3)
+ B1tilde(2,i) =-b(5)
+ B1tilde(1,-i) =-b(3)
+ B1tilde(2,-i) =b(5)
+ c b1tilde(1,i)=0.0d0
+ c b1tilde(2,i)=0.0d0
+ B2(1,i) = b(2)
+ B2(2,i) = b(4)
+ B2(1,-i) =b(2)
+ B2(2,-i) =-b(4)
+
+ c b2(1,i)=0.0d0
+ c b2(2,i)=0.0d0
+ CC(1,1,i)= b(7)
+ CC(2,2,i)=-b(7)
+ CC(2,1,i)= b(9)
+ CC(1,2,i)= b(9)
+ CC(1,1,-i)= b(7)
+ CC(2,2,-i)=-b(7)
+ CC(2,1,-i)=-b(9)
+ CC(1,2,-i)=-b(9)
+ c CC(1,1,i)=0.0d0
+ c CC(2,2,i)=0.0d0
+ c CC(2,1,i)=0.0d0
+ c CC(1,2,i)=0.0d0
+ Ctilde(1,1,i)=b(7)
+ Ctilde(1,2,i)=b(9)
+ Ctilde(2,1,i)=-b(9)
+ Ctilde(2,2,i)=b(7)
+ Ctilde(1,1,-i)=b(7)
+ Ctilde(1,2,-i)=-b(9)
+ Ctilde(2,1,-i)=b(9)
+ Ctilde(2,2,-i)=b(7)
+
+ c Ctilde(1,1,i)=0.0d0
+ c Ctilde(1,2,i)=0.0d0
+ c Ctilde(2,1,i)=0.0d0
+ c Ctilde(2,2,i)=0.0d0
+ DD(1,1,i)= b(6)
+ DD(2,2,i)=-b(6)
+ DD(2,1,i)= b(8)
+ DD(1,2,i)= b(8)
+ DD(1,1,-i)= b(6)
+ DD(2,2,-i)=-b(6)
+ DD(2,1,-i)=-b(8)
+ DD(1,2,-i)=-b(8)
+ c DD(1,1,i)=0.0d0
+ c DD(2,2,i)=0.0d0
+ c DD(2,1,i)=0.0d0
+ c DD(1,2,i)=0.0d0
+ Dtilde(1,1,i)=b(6)
+ Dtilde(1,2,i)=b(8)
+ Dtilde(2,1,i)=-b(8)
+ Dtilde(2,2,i)=b(6)
+ Dtilde(1,1,-i)=b(6)
+ Dtilde(1,2,-i)=-b(8)
+ Dtilde(2,1,-i)=b(8)
+ Dtilde(2,2,-i)=b(6)
+
+ c Dtilde(1,1,i)=0.0d0
+ c Dtilde(1,2,i)=0.0d0
+ c Dtilde(2,1,i)=0.0d0
+ c Dtilde(2,2,i)=0.0d0
+ EE(1,1,i)= b(10)+b(11)
+ EE(2,2,i)=-b(10)+b(11)
+ EE(2,1,i)= b(12)-b(13)
+ EE(1,2,i)= b(12)+b(13)
+ EE(1,1,-i)= b(10)+b(11)
+ EE(2,2,-i)=-b(10)+b(11)
+ EE(2,1,-i)=-b(12)+b(13)
+ EE(1,2,-i)=-b(12)-b(13)
+
+ c ee(1,1,i)=1.0d0
+ c ee(2,2,i)=1.0d0
+ c ee(2,1,i)=0.0d0
+ c ee(1,2,i)=0.0d0
+ c ee(2,1,i)=ee(1,2,i)
enddo
if (lprint) then
do i=1,nloctyp