if (wliptran.gt.0) then
call Eliptransfer(eliptran)
+ else
+ eliptran=0.0d0
endif
-
+#ifdef FOURBODY
C
C 12/1/95 Multi-body terms
C
c write (iout,*) "Calling multibody_hbond"
call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
endif
+#endif
c write (iout,*) "NSAXS",nsaxs
if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
call e_saxs(Esaxs_constr)
& +welec*fact(1)*ees
& +fact(1)*wvdwpp*evdw1
& +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
- & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
+ & +wstrain*ehpb
+ & +wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
+ & +wcorr6*fact(5)*ecorr6
+ & +wturn4*fact(3)*eello_turn4
& +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
& +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
& +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
#ifdef SPLITELE
write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
& estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
- & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
- & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),eel_loc,
+ & etors_d,wtor_d*fact(2),ehpb,wstrain,
+#ifdef FOURBODY
+ & ecorr,wcorr*fact(3),
+ & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
+#endif
+ & eel_loc,
& wel_loc*fact(2),eello_turn3,wturn3*fact(2),
- & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
+ & eello_turn4,wturn4*fact(3),
+#ifdef FOURBODY
+ & eello_turn6,wturn6*fact(5),
+#endif
& esccor,wsccor*fact(1),edihcnstr,
& ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
& etube,wtube,esaxs,wsaxs,ehomology_constr,
& 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
& 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
& ' (SS bridges & dist. cnstr.)'/
+#ifdef FOURBODY
& 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
+#endif
& 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
& 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
& 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
+#ifdef FOURBODY
& 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
+#endif
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
& 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
#else
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
& estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
- & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
+ & etors_d,wtor_d*fact(2),ehpb,
+#ifdef FOURBODY
+ & wstrain,ecorr,wcorr*fact(3),
& ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
+#endif
& eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
- & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
+ & eello_turn4,wturn4*fact(3),
+#ifdef FOURBODY
+ & eello_turn6,wturn6*fact(5),
+#endif
& esccor,wsccor*fact(1),edihcnstr,
& ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
& etube,wtube,esaxs,wsaxs,ehomology_constr,
& 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
& 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
& ' (SS bridges & dist. restr.)'/
+#ifdef FOURBODY
& 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
+#endif
& 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
& 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
& 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
+#ifdef FOURBODY
& 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
+#endif
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
& 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
dimension gg(3)
integer icant
external icant
C Change 12/1/95 to calculate four-body interactions
rij=xj*xj+yj*yj+zj*zj
rrij=1.0D0/rij
+ sqrij=dsqrt(rij)
+ sss1=sscale(sqrij)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(sqrij)
c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
+ evdw=evdw+sss1*evdwij
else
- evdw_t=evdw_t+evdwij
+ evdw_t=evdw_t+sss1*evdwij
endif
if (calc_grad) then
C
C Calculate the components of the gradient in DC and X
C
- fac=-rrij*(e1+evdwij)
+ fac=-rrij*(e1+evdwij)*sss1
+ & +evdwij*sssgrad1/sqrij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
enddo
enddo
endif
+#ifdef FOURBODY
C
C 12/1/95, revised on 5/20/97
C
cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
endif
endif
+#endif
enddo ! j
enddo ! iint
+#ifdef FOURBODY
C Change 12/1/95
num_cont(i)=num_conti
+#endif
enddo ! i
if (calc_grad) then
do i=1,nct
e_augm=augm(itypi,itypj)*fac_augm
r_inv_ij=dsqrt(rrij)
rij=1.0D0/r_inv_ij
+ sss1=sscale(rij)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(rij)
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
e1=fac*fac*aa
cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
+ evdw=evdw+evdwij*sss1
else
- evdw_t=evdw_t+evdwij
+ evdw_t=evdw_t+evdwij*sss1
endif
if (calc_grad) then
C
C Calculate the components of the gradient in DC and X
C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
+ fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
+ & +evdwij*sssgrad1*r_inv_ij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
c write (iout,*) i,j,xj,yj,zj
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
- sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
+ sss=sscale(1.0d0/rij))
+ sssgrad=sscagrad(1.0d0/rij)
if (sss.le.0.0) cycle
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
dzj=dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
+ sss=sscale(1.0d0/rij)
+ if (sss.eq.0.0d0) cycle
+ sssgrad=sscagrad(1.0d0/rij)
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
call sc_angular
e_augm=augm(itypi,itypj)*fac_augm
evdwij=evdwij*eps2rt*eps3rt
if (bb.gt.0.0d0) then
- evdw=evdw+evdwij+e_augm
+ evdw=evdw+(evdwij+e_augm)*sss
else
- evdw_t=evdw_t+evdwij+e_augm
+ evdw_t=evdw_t+(evdwij+e_augm)*sss
endif
ij=icant(itypi,itypj)
aux=eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac-2*expon*rrij*e_augm
+ fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
+ include 'COMMON.CORRMAT'
double precision auxvec(2),auxmat(2,2)
C
C Compute the virtual-bond-torsional-angle dependent quantities needed
c write(iout,*) "Macierz EUG",
c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
c & eug(2,2,i-2)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
& then
call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
endif
+#endif
else
do k=1,2
Ub2(k,i-2)=0.0d0
#endif
cd write (iout,*) 'mu1',mu1(:,i-2)
cd write (iout,*) 'mu2',mu2(:,i-2)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
& then
if (calc_grad) then
call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
endif
endif
+#endif
enddo
+#ifdef FOURBODY
C Matrices dependent on two consecutive virtual-bond dihedrals.
C The order of matrices is from left to right.
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
endif
+#endif
enddo
endif
return
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAP'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
eello_turn3=0.0d0
eello_turn4=0.0d0
ind=0
+#ifdef FOURBODY
do i=1,nres
num_cont_hb(i)=0
enddo
+#endif
cd print '(a)','Enter EELEC'
c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
c call flush(iout)
num_conti=0
call eelecij(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo
do i=iturn4_start,iturn4_end
if (i.lt.1) cycle
zmedi=mod(zmedi,boxzsize)
if (zmedi.lt.0) zmedi=zmedi+boxzsize
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
c write(iout,*) "JESTEM W PETLI"
call eelecij(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
& call eturn4(i,eello_turn4)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
C Loop over all neighbouring boxes
C do xshift=-1,1
c endif
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
C I TU KURWA
do j=ielstart(i),ielend(i)
C do j=16,17
&) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
enddo ! j
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
C enddo ! zshift
C enddo ! yshift
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAP'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
C zj=zj-zmedi
rij=xj*xj+yj*yj+zj*zj
- sss=sscale(sqrt(rij))
- sssgrad=sscagrad(sqrt(rij))
+ sss=sscale(sqrt(rij))
+ if (sss.eq.0.0d0) return
+ sssgrad=sscagrad(sqrt(rij))
c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
c & " rlamb",rlamb," sss",sss
c if (sss.gt.0.0d0) then
cgrad enddo
cgrad enddo
if (sss.gt.0.0) then
- ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
- ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
- ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
+ facvdw=facvdw+sssgrad*rmij*evdwij
+ ggg(1)=facvdw*xj
+ ggg(2)=facvdw*yj
+ ggg(3)=facvdw*zj
else
ggg(1)=0.0
ggg(2)=0.0
endif ! calc_grad
#else
C MARYSIA
- facvdw=(ev1+evdwij)*sss
+ facvdw=(ev1+evdwij)
facel=(el1+eesij)
fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
+ fac=-3*rrmij*(facvdw+facvdw+facel)*sss
+ & +(evdwij+eesij)*sssgrad*rrmij
erij(1)=xj*rmij
erij(2)=yj*rmij
erij(3)=zj*rmij
c & write (iout,'(a4,2i4,8f9.5)')'chuj',
c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
- eel_loc=eel_loc+eel_loc_ij
+ eel_loc=eel_loc+eel_loc_ij*sss
C Now derivative over eel_loc
if (calc_grad) then
if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
& +a23*gmuij1(2)
& +a32*gmuij1(3)
& +a33*gmuij1(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
c write(iout,*) "derivative over thatai"
c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
c & a33*gmuij1(4)
& +a33*gmuij2(4)
gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
& geel_loc_ij*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
c Derivative over j residue
geel_loc_ji=a22*gmuji1(1)
c & a33*gmuji2(4)
gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
& geel_loc_ji*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
#endif
cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
& +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
& *fac_shield(i)*fac_shield(j)
C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
+ aux=eel_loc_ij/sss*sssgrad*rmij
+ ggg(1)=aux*xj
+ ggg(2)=aux*yj
+ ggg(3)=aux*zj
do l=1,3
- ggg(l)=(agg(l,1)*muij(1)+
+ ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
& agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
cgrad ghalf=0.5d0*ggg(l)
C Change 12/26/95 to calculate four-body contributions to H-bonding energy
c if (j.gt.i+1 .and. num_conti.le.maxconts) then
+#ifdef FOURBODY
if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
& .and. num_conti.le.maxconts) then
c write (iout,*) i,j," entered corr"
gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
enddo
gggp(1)=gggp(1)+ees0pijp*xj
+ & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
gggp(2)=gggp(2)+ees0pijp*yj
+ & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
gggp(3)=gggp(3)+ees0pijp*zj
+ & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
gggm(1)=gggm(1)+ees0mijp*xj
+ & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
gggm(2)=gggm(2)+ees0mijp*yj
+ & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
gggm(3)=gggm(3)+ees0mijp*zj
+ & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
C Derivatives due to the contact function
gacont_hbr(1,num_conti,i)=fprimcont*xj
gacont_hbr(2,num_conti,i)=fprimcont*yj
gacontp_hb1(k,num_conti,i)=!ghalfp
& +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontp_hb2(k,num_conti,i)=!ghalfp
& +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontp_hb3(k,num_conti,i)=gggp(k)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb1(k,num_conti,i)=!ghalfm
& +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb2(k,num_conti,i)=!ghalfm
& +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb3(k,num_conti,i)=gggm(k)
& *fac_shield(i)*fac_shield(j)
-
+*sss
enddo
C Diagnostics. Comment out or remove after debugging!
cdiag do k=1,3
endif ! num_conti.le.maxconts
endif ! fcont.gt.0
endif ! j.gt.i+1
+#endif
if (calc_grad) then
if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
do k=1,4
enddo
return
end
+#ifdef FOURBODY
c------------------------------------------------------------------------------
subroutine multibody(ecorr)
C This subroutine calculates multi-body contributions to energy following
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision gx(3),gx1(3)
logical lprn
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision gx(3),gx1(3)
logical lprn
lprn=.false.
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision gx(3),gx1(3)
logical lprn,ldone
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.CHAIN'
include 'COMMON.CONTROL'
include 'COMMON.SHIELD'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.SHIELD'
include 'COMMON.CONTROL'
double precision gx(3),gx1(3)
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
cd write (2,*) 'eel_turn6',ekont*eel_turn6
return
end
-
+#endif
crc-------------------------------------------------
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
subroutine Eliptransfer(eliptran)
+++ /dev/null
- subroutine etotal(energia,fact)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
-
-#ifndef ISNAN
- external proc_proc
-#endif
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-
- include 'COMMON.IOUNITS'
- double precision energia(0:max_ene),energia1(0:max_ene+1)
-#ifdef MPL
- include 'COMMON.INFO'
- external d_vadd
- integer ready
-#endif
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.SHIELD'
- include 'COMMON.CONTROL'
- double precision fact(6)
-cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
-cd print *,'nnt=',nnt,' nct=',nct
-C
-C Compute the side-chain and electrostatic interaction energy
-C
- goto (101,102,103,104,105) ipot
-C Lennard-Jones potential.
- 101 call elj(evdw,evdw_t)
-cd print '(a)','Exit ELJ'
- goto 106
-C Lennard-Jones-Kihara potential (shifted).
- 102 call eljk(evdw,evdw_t)
- goto 106
-C Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp(evdw,evdw_t)
- goto 106
-C Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb(evdw,evdw_t)
- goto 106
-C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv(evdw,evdw_t)
-C
-C Calculate electrostatic (H-bonding) energy of the main chain.
-C
- 106 continue
-C write(iout,*) "shield_mode",shield_mode,ethetacnstr
- if (shield_mode.eq.1) then
- call set_shield_fac
- else if (shield_mode.eq.2) then
- call set_shield_fac2
- endif
- call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C
-C Calculate excluded-volume interaction energy between peptide groups
-C and side chains.
-C
- call escp(evdw2,evdw2_14)
-c
-c Calculate the bond-stretching energy
-c
- call ebond(estr)
-c write (iout,*) "estr",estr
-C
-C Calculate the disulfide-bridge and other energy and the contributions
-C from other distance constraints.
-cd print *,'Calling EHPB'
- call edis(ehpb)
-cd print *,'EHPB exitted succesfully.'
-C
-C Calculate the virtual-bond-angle energy.
-C
- call ebend(ebe,ethetacnstr)
-cd print *,'Bend energy finished.'
-C
-C Calculate the SC local energy.
-C
- call esc(escloc)
-cd print *,'SCLOC energy finished.'
-C
-C Calculate the virtual-bond torsional energy.
-C
-cd print *,'nterm=',nterm
- call etor(etors,edihcnstr,fact(1))
-C
-C 6/23/01 Calculate double-torsional energy
-C
- call etor_d(etors_d,fact(2))
-C
-C 21/5/07 Calculate local sicdechain correlation energy
-C
- call eback_sc_corr(esccor)
-
- if (wliptran.gt.0) then
- call Eliptransfer(eliptran)
- endif
-
-C
-C 12/1/95 Multi-body terms
-C
- n_corr=0
- n_corr1=0
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
- & .or. wturn6.gt.0.0d0) then
-c print *,"calling multibody_eello"
- call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
-c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
-c print *,ecorr,ecorr5,ecorr6,eturn6
- else
- ecorr=0.0d0
- ecorr5=0.0d0
- ecorr6=0.0d0
- eturn6=0.0d0
- endif
- if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
- call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
- endif
- write (iout,*) "ft(6)",fact(6),wliptran,eliptran
-#ifdef SPLITELE
- if (shield_mode.gt.0) then
- etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
- & +welec*fact(1)*ees
- & +fact(1)*wvdwpp*evdw1
- & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
- & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
- & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
- & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
- & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
- & +wliptran*eliptran
- else
- etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
- & +wvdwpp*evdw1
- & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
- & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
- & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
- & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
- & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
- & +wliptran*eliptran
- endif
-#else
- if (shield_mode.gt.0) then
- etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
- & +welec*fact(1)*(ees+evdw1)
- & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
- & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
- & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
- & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
- & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
- & +wliptran*eliptran
- else
- etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
- & +welec*fact(1)*(ees+evdw1)
- & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
- & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
- & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
- & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
- & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
- & +wliptran*eliptran
- endif
-#endif
-
- energia(0)=etot
- energia(1)=evdw
-#ifdef SCP14
- energia(2)=evdw2-evdw2_14
- energia(17)=evdw2_14
-#else
- energia(2)=evdw2
- energia(17)=0.0d0
-#endif
-#ifdef SPLITELE
- energia(3)=ees
- energia(16)=evdw1
-#else
- energia(3)=ees+evdw1
- energia(16)=0.0d0
-#endif
- energia(4)=ecorr
- energia(5)=ecorr5
- energia(6)=ecorr6
- energia(7)=eel_loc
- energia(8)=eello_turn3
- energia(9)=eello_turn4
- energia(10)=eturn6
- energia(11)=ebe
- energia(12)=escloc
- energia(13)=etors
- energia(14)=etors_d
- energia(15)=ehpb
- energia(18)=estr
- energia(19)=esccor
- energia(20)=edihcnstr
- energia(21)=evdw_t
- energia(24)=ethetacnstr
- energia(22)=eliptran
-c detecting NaNQ
-#ifdef ISNAN
-#ifdef AIX
- if (isnan(etot).ne.0) energia(0)=1.0d+99
-#else
- if (isnan(etot)) energia(0)=1.0d+99
-#endif
-#else
- i=0
-#ifdef WINPGI
- idumm=proc_proc(etot,i)
-#else
- call proc_proc(etot,i)
-#endif
- if(i.eq.1)energia(0)=1.0d+99
-#endif
-#ifdef MPL
-c endif
-#endif
- if (calc_grad) then
-C
-C Sum up the components of the Cartesian gradient.
-C
-#ifdef SPLITELE
- do i=1,nct
- do j=1,3
- if (shield_mode.eq.0) then
- gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
- & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
- & wbond*gradb(j,i)+
- & wstrain*ghpbc(j,i)+
- & wcorr*fact(3)*gradcorr(j,i)+
- & wel_loc*fact(2)*gel_loc(j,i)+
- & wturn3*fact(2)*gcorr3_turn(j,i)+
- & wturn4*fact(3)*gcorr4_turn(j,i)+
- & wcorr5*fact(4)*gradcorr5(j,i)+
- & wcorr6*fact(5)*gradcorr6(j,i)+
- & wturn6*fact(5)*gcorr6_turn(j,i)+
- & wsccor*fact(2)*gsccorc(j,i)
- & +wliptran*gliptranc(j,i)
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*fact(2)*gsccorx(j,i)
- & +wliptran*gliptranx(j,i)
- else
- gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
- & +fact(1)*wscp*gvdwc_scp(j,i)+
- & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
- & wbond*gradb(j,i)+
- & wstrain*ghpbc(j,i)+
- & wcorr*fact(3)*gradcorr(j,i)+
- & wel_loc*fact(2)*gel_loc(j,i)+
- & wturn3*fact(2)*gcorr3_turn(j,i)+
- & wturn4*fact(3)*gcorr4_turn(j,i)+
- & wcorr5*fact(4)*gradcorr5(j,i)+
- & wcorr6*fact(5)*gradcorr6(j,i)+
- & wturn6*fact(5)*gcorr6_turn(j,i)+
- & wsccor*fact(2)*gsccorc(j,i)
- & +wliptran*gliptranc(j,i)
- & +welec*gshieldc(j,i)
- & +welec*gshieldc_loc(j,i)
- & +wcorr*gshieldc_ec(j,i)
- & +wcorr*gshieldc_loc_ec(j,i)
- & +wturn3*gshieldc_t3(j,i)
- & +wturn3*gshieldc_loc_t3(j,i)
- & +wturn4*gshieldc_t4(j,i)
- & +wturn4*gshieldc_loc_t4(j,i)
- & +wel_loc*gshieldc_ll(j,i)
- & +wel_loc*gshieldc_loc_ll(j,i)
-
- gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
- & +fact(1)*wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*fact(2)*gsccorx(j,i)
- & +wliptran*gliptranx(j,i)
- & +welec*gshieldx(j,i)
- & +wcorr*gshieldx_ec(j,i)
- & +wturn3*gshieldx_t3(j,i)
- & +wturn4*gshieldx_t4(j,i)
- & +wel_loc*gshieldx_ll(j,i)
-
-
- endif
- enddo
-#else
- do i=1,nct
- do j=1,3
- if (shield_mode.eq.0) then
- gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
- & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
- & wbond*gradb(j,i)+
- & wcorr*fact(3)*gradcorr(j,i)+
- & wel_loc*fact(2)*gel_loc(j,i)+
- & wturn3*fact(2)*gcorr3_turn(j,i)+
- & wturn4*fact(3)*gcorr4_turn(j,i)+
- & wcorr5*fact(4)*gradcorr5(j,i)+
- & wcorr6*fact(5)*gradcorr6(j,i)+
- & wturn6*fact(5)*gcorr6_turn(j,i)+
- & wsccor*fact(2)*gsccorc(j,i)
- & +wliptran*gliptranc(j,i)
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*fact(1)*gsccorx(j,i)
- & +wliptran*gliptranx(j,i)
- else
- gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
- & fact(1)*wscp*gvdwc_scp(j,i)+
- & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
- & wbond*gradb(j,i)+
- & wcorr*fact(3)*gradcorr(j,i)+
- & wel_loc*fact(2)*gel_loc(j,i)+
- & wturn3*fact(2)*gcorr3_turn(j,i)+
- & wturn4*fact(3)*gcorr4_turn(j,i)+
- & wcorr5*fact(4)*gradcorr5(j,i)+
- & wcorr6*fact(5)*gradcorr6(j,i)+
- & wturn6*fact(5)*gcorr6_turn(j,i)+
- & wsccor*fact(2)*gsccorc(j,i)
- & +wliptran*gliptranc(j,i)
- gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
- & fact(1)*wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*fact(1)*gsccorx(j,i)
- & +wliptran*gliptranx(j,i)
- endif
- enddo
-#endif
- enddo
-
-
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
- & +wcorr5*fact(4)*g_corr5_loc(i)
- & +wcorr6*fact(5)*g_corr6_loc(i)
- & +wturn4*fact(3)*gel_loc_turn4(i)
- & +wturn3*fact(2)*gel_loc_turn3(i)
- & +wturn6*fact(5)*gel_loc_turn6(i)
- & +wel_loc*fact(2)*gel_loc_loc(i)
-c & +wsccor*fact(1)*gsccor_loc(i)
-c ROZNICA Z WHAMem
- enddo
- endif
- if (dyn_ss) call dyn_set_nss
- return
- end
-C------------------------------------------------------------------------
- subroutine enerprint(energia,fact)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- double precision energia(0:max_ene),fact(6)
- etot=energia(0)
- evdw=energia(1)+fact(6)*energia(21)
-#ifdef SCP14
- evdw2=energia(2)+energia(17)
-#else
- evdw2=energia(2)
-#endif
- ees=energia(3)
-#ifdef SPLITELE
- evdw1=energia(16)
-#endif
- ecorr=energia(4)
- ecorr5=energia(5)
- ecorr6=energia(6)
- eel_loc=energia(7)
- eello_turn3=energia(8)
- eello_turn4=energia(9)
- eello_turn6=energia(10)
- ebe=energia(11)
- escloc=energia(12)
- etors=energia(13)
- etors_d=energia(14)
- ehpb=energia(15)
- esccor=energia(19)
- edihcnstr=energia(20)
- estr=energia(18)
- ethetacnstr=energia(24)
-#ifdef SPLITELE
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
- & wvdwpp,
- & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
- & etors_d,wtor_d*fact(2),ehpb,wstrain,
- & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
- & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
- & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
- & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
- & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#else
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
- & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
- & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
- & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
- & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
- & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
- & edihcnstr,ethetacnstr,ebr*nss,etot
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#endif
- return
- end
-C-----------------------------------------------------------------------
- subroutine elj(evdw,evdw_t)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include "DIMENSIONS.COMPAR"
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
- integer icant
- external icant
-cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
-c ROZNICA DODANE Z WHAM
-c do i=1,210
-c do j=1,2
-c eneps_temp(j,i)=0.0d0
-c enddo
-c enddo
-cROZNICA
-
- evdw=0.0D0
- evdw_t=0.0d0
- do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C Change 12/1/95
- num_conti=0
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(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))
- if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
-C Change 12/1/95 to calculate four-body interactions
- rij=xj*xj+yj*yj+zj*zj
- rrij=1.0D0/rij
-c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa
- e2=fac*bb
- evdwij=e1+e2
- ij=icant(itypi,itypj)
-c ROZNICA z WHAM
-c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
-c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
-c
-
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
- else
- evdw_t=evdw_t+evdwij
- endif
- if (calc_grad) then
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- enddo
- do k=i,j-1
- do l=1,3
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
- enddo
- enddo
- endif
-C
-C 12/1/95, revised on 5/20/97
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-C
-C Uncomment next line, if the correlation interactions include EVDW explicitly.
-c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
-C Uncomment next line, if the correlation interactions are contact function only
- if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
- rij=dsqrt(rij)
- sigij=sigma(itypi,itypj)
- r0ij=rs0(itypi,itypj)
-C
-C Check whether the SC's are not too far to make a contact.
-C
- rcut=1.5d0*r0ij
- call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
-C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
-C
- if (fcont.gt.0.0D0) then
-C If the SC-SC distance if close to sigma, apply spline.
-cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
-cAdam & fcont1,fprimcont1)
-cAdam fcont1=1.0d0-fcont1
-cAdam if (fcont1.gt.0.0d0) then
-cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
-cAdam fcont=fcont*fcont1
-cAdam endif
-C Uncomment following 4 lines to have the geometric average of the epsilon0's
-cga eps0ij=1.0d0/dsqrt(eps0ij)
-cga do k=1,3
-cga gg(k)=gg(k)*eps0ij
-cga enddo
-cga eps0ij=-evdwij*eps0ij
-C Uncomment for AL's type of SC correlation interactions.
-cadam eps0ij=-evdwij
- num_conti=num_conti+1
- jcont(num_conti,i)=j
- facont(num_conti,i)=fcont*eps0ij
- fprimcont=eps0ij*fprimcont/rij
- fcont=expon*fcont
-cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
-cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
-cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
-C Uncomment following 3 lines for Skolnick's type of SC correlation.
- gacont(1,num_conti,i)=-fprimcont*xj
- gacont(2,num_conti,i)=-fprimcont*yj
- gacont(3,num_conti,i)=-fprimcont*zj
-cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
-cd write (iout,'(2i3,3f10.5)')
-cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
- endif
- endif
- enddo ! j
- enddo ! iint
-C Change 12/1/95
- num_cont(i)=num_conti
- enddo ! i
- if (calc_grad) then
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- endif
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eljk(evdw,evdw_t)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include "DIMENSIONS.COMPAR"
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
- integer icant
- external icant
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- evdw_t=0.0d0
- do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j))
- if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa
- e2=fac*bb
- evdwij=e_augm+e1+e2
- ij=icant(itypi,itypj)
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
- else
- evdw_t=evdw_t+evdwij
- endif
- if (calc_grad) then
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- enddo
- do k=i,j-1
- do l=1,3
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
- enddo
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- if (calc_grad) then
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- endif
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp(evdw,evdw_t)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include "DIMENSIONS.COMPAR"
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- integer icant
- external icant
- evdw=0.0D0
- evdw_t=0.0d0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=iabs(itype(j))
- if (itypj.eq.ntyp1) cycle
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-cd if (icall.eq.0) then
-cd rrsave(ind)=rrij
-cd else
-cd rrij=rrsave(ind)
-cd endif
- rij=dsqrt(rrij)
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa
- e2=fac*bb
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- ij=icant(itypi,itypj)
- aux=eps1*eps2rt**2*eps3rt**2
- if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
- else
- evdw_t=evdw_t+evdwij
- endif
- if (calc_grad) then
- if (lprn) then
- sigm=dabs(aa/bb)**(1.0D0/6.0D0)
- epsi=bb**2/aa
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
- call sc_grad
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb(evdw,evdw_t)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include "DIMENSIONS.COMPAR"
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.SBRIDGE'
- logical lprn
- common /srutu/icall
- integer icant
- external icant
- integer xshift,yshift,zshift
- logical energy_dec /.false./
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- evdw_t=0.0d0
- lprn=.false.
-c if (icall.gt.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot)
- &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
- if (zi.lt.buflipbot) then
-C what fraction I am in
- fracinbuf=1.0d0-
- & ((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
-
-c write(iout,*) "PRZED ZWYKLE", evdwij
- call dyn_ssbond_ene(i,j,evdwij)
-c write(iout,*) "PO ZWYKLE", evdwij
-
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
- & 'evdw',i,j,evdwij,' ss'
-C triple bond artifac removal
- do k=j+1,iend(i,iint)
-C search over all next residues
- if (dyn_ss_mask(k)) then
-C check if they are cysteins
-C write(iout,*) 'k=',k
-
-c write(iout,*) "PRZED TRI", evdwij
- evdwij_przed_tri=evdwij
- call triple_ssbond_ene(i,j,k,evdwij)
-c if(evdwij_przed_tri.ne.evdwij) then
-c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
-c endif
-
-c write(iout,*) "PO TRI", evdwij
-C call the energy function that removes the artifical triple disulfide
-C bond the soubroutine is located in ssMD.F
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
- & 'evdw',i,j,evdwij,'tss'
- endif!dyn_ss_mask(k)
- enddo! k
- ELSE
- ind=ind+1
- itypj=iabs(itype(j))
- if (itypj.eq.ntyp1) cycle
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)
- yj=c(2,nres+j)
- zj=c(3,nres+j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot)
- &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
- if (zj.lt.buflipbot) then
-C what fraction I am in
- fracinbuf=1.0d0-
- & ((zj-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-C write(iout,*) "czy jest 0", bb-bb_lip(itypi,itypj),
-C & bb-bb_aq(itypi,itypj)
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
-c write (iout,*) i,j,xj,yj,zj
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
- sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
- if (sss.le.0.0d0) cycle
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa
- e2=fac*bb
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- if (bb.gt.0) then
- evdw=evdw+evdwij*sss
- else
- evdw_t=evdw_t+evdwij*sss
- endif
- ij=icant(itypi,itypj)
- aux=eps1*eps2rt**2*eps3rt**2
-c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
-c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
-c & aux*e2/eps(itypi,itypj)
-c if (lprn) then
- sigm=dabs(aa/bb)**(1.0D0/6.0D0)
- epsi=bb**2/aa
-C#define DEBUG
-#ifdef DEBUG
-C write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-C & restyp(itypi),i,restyp(itypj),j,
-C & epsi,sigm,chi1,chi2,chip1,chip2,
-C & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-C & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-C & evdwij
- write (iout,*) "pratial sum", evdw,evdw_t,e1,e2,fac,aa
-#endif
-C#undef DEBUG
-c endif
- if (calc_grad) then
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
- fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
- gg_lipi(3)=eps1*(eps2rt*eps2rt)
- &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
- & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
- &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
- gg_lipj(3)=ssgradlipj*gg_lipi(3)
- gg_lipi(3)=gg_lipi(3)*ssgradlipi
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad
- endif
- ENDIF ! dyn_ss
- enddo ! j
- enddo ! iint
- enddo ! i
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egbv(evdw,evdw_t)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include "DIMENSIONS.COMPAR"
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- integer icant
- external icant
- evdw=0.0D0
- evdw_t=0.0d0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.gt.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=vbld_inv(i+nres)
-C returning the ith atom to box
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot)
- &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
- if (zi.lt.buflipbot) then
-C what fraction I am in
- fracinbuf=1.0d0-
- & ((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=iabs(itype(j))
- if (itypj.eq.ntyp1) cycle
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)
- yj=c(2,nres+j)
- zj=c(3,nres+j)
-C returning jth atom to box
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot)
- &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
- if (zj.lt.buflipbot) then
-C what fraction I am in
- fracinbuf=1.0d0-
- & ((zj-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
-C checking the distance
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-C finding the closest
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa
- e2=fac*bb
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- if (bb.gt.0.0d0) then
- evdw=evdw+evdwij+e_augm
- else
- evdw_t=evdw_t+evdwij+e_augm
- endif
- ij=icant(itypi,itypj)
- aux=eps1*eps2rt**2*eps3rt**2
-c if (lprn) then
-c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c & restyp(itypi),i,restyp(itypj),j,
-c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
-c & chi1,chi2,chip1,chip2,
-c & eps1,eps2rt**2,eps3rt**2,
-c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c & evdwij+e_augm
-c endif
- if (calc_grad) then
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- return
- end
-C-----------------------------------------------------------------------------
- subroutine sc_angular
-C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
-C om12. Called by ebp, egb, and egbv.
- implicit none
- include 'COMMON.CALC'
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- chiom12=chi12*om12
-C Calculate eps1(om12) and its derivative in om12
- faceps1=1.0D0-om12*chiom12
- faceps1_inv=1.0D0/faceps1
- eps1=dsqrt(faceps1_inv)
-C Following variable is eps1*deps1/dom12
- eps1_om12=faceps1_inv*chiom12
-C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
-C and om12.
- om1om2=om1*om2
- chiom1=chi1*om1
- chiom2=chi2*om2
- facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
- sigsq=1.0D0-facsig*faceps1_inv
- sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
- sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
- sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
-C Calculate eps2 and its derivatives in om1, om2, and om12.
- chipom1=chip1*om1
- chipom2=chip2*om2
- chipom12=chip12*om12
- facp=1.0D0-om12*chipom12
- facp_inv=1.0D0/facp
- facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
-C Following variable is the square root of eps2
- eps2rt=1.0D0-facp1*facp_inv
-C Following three variables are the derivatives of the square root of eps
-C in om1, om2, and om12.
- eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
- eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
- eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
-C Evaluate the "asymmetric" factor in the VDW constant, eps3
- eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- return
- end
-C----------------------------------------------------------------------------
- subroutine sc_grad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- double precision dcosom1(3),dcosom2(3)
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- do k=1,3
- gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipi(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
- do k=i,j-1
- do l=1,3
- gvdwc(l,k)=gvdwc(l,k)+gg(l)+gg_lipi(l)
- enddo
- enddo
- do l=1,3
- gvdwc(l,j)=gvdwc(l,j)+gg_lipj(l)
- enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine vec_and_deriv
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
-C Compute the local reference systems. For reference system (i), the
-C X-axis points from CA(i) to CA(i+1), the Y axis is in the
-C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
- do i=1,nres-1
-c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
- if (i.eq.nres-1) then
-C Case of the last full residue
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
- costh=dcos(pi-theta(nres))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
- if (calc_grad) then
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i-1)
- uzder(3,1,1)= dc_norm(2,i-1)
- uzder(1,2,1)= dc_norm(3,i-1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i-1)
- uzder(1,3,1)=-dc_norm(2,i-1)
- uzder(2,3,1)= dc_norm(1,i-1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
- endif
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
- enddo
- if (calc_grad) then
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i-1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- endif
- else
-C Other residues
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
- costh=dcos(pi-theta(i+2))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
- if (calc_grad) then
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i+1)
- uzder(3,1,1)= dc_norm(2,i+1)
- uzder(1,2,1)= dc_norm(3,i+1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i+1)
- uzder(1,3,1)=-dc_norm(2,i+1)
- uzder(2,3,1)= dc_norm(1,i+1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
- endif
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
- enddo
- if (calc_grad) then
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i+1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- endif
- endif
- enddo
- if (calc_grad) then
- do i=1,nres-1
- vbld_inv_temp(1)=vbld_inv(i+1)
- if (i.lt.nres-1) then
- vbld_inv_temp(2)=vbld_inv(i+2)
- else
- vbld_inv_temp(2)=vbld_inv(i)
- endif
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
- uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
- endif
- return
- end
-C-----------------------------------------------------------------------------
- subroutine vec_and_deriv_test
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- dimension uyder(3,3,2),uzder(3,3,2)
-C Compute the local reference systems. For reference system (i), the
-C X-axis points from CA(i) to CA(i+1), the Y axis is in the
-C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
- do i=1,nres-1
- if (i.eq.nres-1) then
-C Case of the last full residue
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
- costh=dcos(pi-theta(nres))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
-c write (iout,*) 'fac',fac,
-c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
- fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i-1)
- uzder(3,1,1)= dc_norm(2,i-1)
- uzder(1,2,1)= dc_norm(3,i-1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i-1)
- uzder(1,3,1)=-dc_norm(2,i-1)
- uzder(2,3,1)= dc_norm(1,i-1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- do k=1,3
- uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
- enddo
- facy=fac
- facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
- & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
- & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
- do k=1,3
-c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
- uy(k,i)=
-c & facy*(
- & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
- & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
-c & )
- enddo
-c write (iout,*) 'facy',facy,
-c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
- facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
- do k=1,3
- uy(k,i)=facy*uy(k,i)
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i-1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
-c uyder(j,j,1)=uyder(j,j,1)-costh
-c uyder(j,j,2)=1.0d0+uyder(j,j,2)
- uyder(j,j,1)=uyder(j,j,1)
- & -scalar(dc_norm(1,i),dc_norm(1,i-1))
- uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
- & +uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- else
-C Other residues
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
- costh=dcos(pi-theta(i+2))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i+1)
- uzder(3,1,1)= dc_norm(2,i+1)
- uzder(1,2,1)= dc_norm(3,i+1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i+1)
- uzder(1,3,1)=-dc_norm(2,i+1)
- uzder(2,3,1)= dc_norm(1,i+1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- facy=fac
- facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
- & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
- & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
- do k=1,3
-c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
- uy(k,i)=
-c & facy*(
- & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
- & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
-c & )
- enddo
-c write (iout,*) 'facy',facy,
-c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
- facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
- do k=1,3
- uy(k,i)=facy*uy(k,i)
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i+1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
-c uyder(j,j,1)=uyder(j,j,1)-costh
-c uyder(j,j,2)=1.0d0+uyder(j,j,2)
- uyder(j,j,1)=uyder(j,j,1)
- & -scalar(dc_norm(1,i),dc_norm(1,i+1))
- uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
- & +uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- endif
- enddo
- do i=1,nres-1
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
- uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine check_vecgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
- dimension uyt(3,maxres),uzt(3,maxres)
- dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
- double precision delta /1.0d-7/
- call vec_and_deriv
-cd do i=1,nres
-crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
-cd & (dc_norm(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
-cd write(iout,'(a)')
-cd enddo
- do i=1,nres
- do j=1,2
- do k=1,3
- do l=1,3
- uygradt(l,k,j,i)=uygrad(l,k,j,i)
- uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
- call vec_and_deriv
- do i=1,nres
- do j=1,3
- uyt(j,i)=uy(j,i)
- uzt(j,i)=uz(j,i)
- enddo
- enddo
- do i=1,nres
-cd write (iout,*) 'i=',i
- do k=1,3
- erij(k)=dc_norm(k,i)
- enddo
- do j=1,3
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
- dc_norm(j,i)=dc_norm(j,i)+delta
-c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
-c do k=1,3
-c dc_norm(k,i)=dc_norm(k,i)/fac
-c enddo
-c write (iout,*) (dc_norm(k,i),k=1,3)
-c write (iout,*) (erij(k),k=1,3)
- call vec_and_deriv
- do k=1,3
- uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
- uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
- uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
- uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
- enddo
-c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
-c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
- enddo
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
-cd do k=1,3
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
-cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
-cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
-cd write (iout,'(a)')
-cd enddo
- enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine set_matrices
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- double precision auxvec(2),auxmat(2,2)
-C
-C Compute the virtual-bond-torsional-angle dependent quantities needed
-C to calculate the el-loc multibody terms of various order.
-C
- do i=3,nres+1
- if (i .lt. nres+1) then
- sin1=dsin(phi(i))
- cos1=dcos(phi(i))
- sintab(i-2)=sin1
- costab(i-2)=cos1
- obrot(1,i-2)=cos1
- obrot(2,i-2)=sin1
- sin2=dsin(2*phi(i))
- cos2=dcos(2*phi(i))
- sintab2(i-2)=sin2
- costab2(i-2)=cos2
- obrot2(1,i-2)=cos2
- obrot2(2,i-2)=sin2
- Ug(1,1,i-2)=-cos1
- Ug(1,2,i-2)=-sin1
- Ug(2,1,i-2)=-sin1
- Ug(2,2,i-2)= cos1
- Ug2(1,1,i-2)=-cos2
- Ug2(1,2,i-2)=-sin2
- Ug2(2,1,i-2)=-sin2
- Ug2(2,2,i-2)= cos2
- else
- costab(i-2)=1.0d0
- sintab(i-2)=0.0d0
- obrot(1,i-2)=1.0d0
- obrot(2,i-2)=0.0d0
- obrot2(1,i-2)=0.0d0
- obrot2(2,i-2)=0.0d0
- Ug(1,1,i-2)=1.0d0
- Ug(1,2,i-2)=0.0d0
- Ug(2,1,i-2)=0.0d0
- Ug(2,2,i-2)=1.0d0
- Ug2(1,1,i-2)=0.0d0
- Ug2(1,2,i-2)=0.0d0
- Ug2(2,1,i-2)=0.0d0
- Ug2(2,2,i-2)=0.0d0
- endif
- if (i .gt. 3 .and. i .lt. nres+1) then
- obrot_der(1,i-2)=-sin1
- obrot_der(2,i-2)= cos1
- Ugder(1,1,i-2)= sin1
- Ugder(1,2,i-2)=-cos1
- Ugder(2,1,i-2)=-cos1
- Ugder(2,2,i-2)=-sin1
- dwacos2=cos2+cos2
- dwasin2=sin2+sin2
- obrot2_der(1,i-2)=-dwasin2
- obrot2_der(2,i-2)= dwacos2
- Ug2der(1,1,i-2)= dwasin2
- Ug2der(1,2,i-2)=-dwacos2
- Ug2der(2,1,i-2)=-dwacos2
- Ug2der(2,2,i-2)=-dwasin2
- else
- obrot_der(1,i-2)=0.0d0
- obrot_der(2,i-2)=0.0d0
- Ugder(1,1,i-2)=0.0d0
- Ugder(1,2,i-2)=0.0d0
- Ugder(2,1,i-2)=0.0d0
- Ugder(2,2,i-2)=0.0d0
- obrot2_der(1,i-2)=0.0d0
- obrot2_der(2,i-2)=0.0d0
- Ug2der(1,1,i-2)=0.0d0
- Ug2der(1,2,i-2)=0.0d0
- Ug2der(2,1,i-2)=0.0d0
- Ug2der(2,2,i-2)=0.0d0
- endif
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
- if (itype(i-2).le.ntyp) then
- iti = itortyp(itype(i-2))
- else
- iti=ntortyp+1
- endif
- else
- iti=ntortyp+1
- endif
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- if (itype(i-1).le.ntyp) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
- else
- iti1=ntortyp+1
- endif
-cd write (iout,*) '*******i',i,' iti1',iti
-cd write (iout,*) 'b1',b1(:,iti)
-cd write (iout,*) 'b2',b2(:,iti)
-cd write (iout,*) 'Ug',Ug(:,:,i-2)
-c print *,"itilde1 i iti iti1",i,iti,iti1
- if (i .gt. iatel_s+2) then
- call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
- call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
- call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
- call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
- else
- do k=1,2
- Ub2(k,i-2)=0.0d0
- Ctobr(k,i-2)=0.0d0
- Dtobr2(k,i-2)=0.0d0
- do l=1,2
- EUg(l,k,i-2)=0.0d0
- CUg(l,k,i-2)=0.0d0
- DUg(l,k,i-2)=0.0d0
- DtUg2(l,k,i-2)=0.0d0
- enddo
- enddo
- endif
-c print *,"itilde2 i iti iti1",i,iti,iti1
- call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
- call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
- call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
- call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
-c print *,"itilde3 i iti iti1",i,iti,iti1
- do k=1,2
- muder(k,i-2)=Ub2der(k,i-2)
- enddo
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- if (itype(i-1).le.ntyp) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
- else
- iti1=ntortyp+1
- endif
- do k=1,2
- mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
- enddo
-C Vectors and matrices dependent on a single virtual-bond dihedral.
- call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
- call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
- call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
- call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
- call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
-cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
-cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
- enddo
-C Matrices dependent on two consecutive virtual-bond dihedrals.
-C The order of matrices is from left to right.
- do i=2,nres-1
- call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
- call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
- call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
- call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
- call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
- call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
- enddo
-cd do i=1,nres
-cd iti = itortyp(itype(i))
-cd write (iout,*) i
-cd do j=1,2
-cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
-cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
-cd enddo
-cd enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C
-C This subroutine calculates the average interaction energy and its gradient
-C in the virtual-bond vectors between non-adjacent peptide groups, based on
-C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
-C The potential depends both on the distance of peptide-group centers and on
-C the orientation of the CA-CA virtual bonds.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.SHIELD'
-
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
- double precision scal_el /0.5d0/
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-cd write(iout,*) 'In EELEC'
-cd do i=1,nloctyp
-cd write(iout,*) 'Type',i
-cd write(iout,*) 'B1',B1(:,i)
-cd write(iout,*) 'B2',B2(:,i)
-cd write(iout,*) 'CC',CC(:,:,i)
-cd write(iout,*) 'DD',DD(:,:,i)
-cd write(iout,*) 'EE',EE(:,:,i)
-cd enddo
-cd call check_vecgrad
-cd stop
- if (icheckgrad.eq.1) then
- do i=1,nres-1
- fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
- do k=1,3
- dc_norm(k,i)=dc(k,i)*fac
- enddo
-c write (iout,*) 'i',i,' fac',fac
- enddo
- endif
- if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
- & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
-cd if (wel_loc.gt.0.0d0) then
- if (icheckgrad.eq.1) then
- call vec_and_deriv_test
- else
- call vec_and_deriv
- endif
- call set_matrices
- endif
-cd do i=1,nres-1
-cd write (iout,*) 'i=',i
-cd do k=1,3
-cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
-cd enddo
-cd do k=1,3
-cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
-cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
-cd enddo
-cd enddo
- num_conti_hb=0
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=1,nres
- num_cont_hb(i)=0
- enddo
-cd print '(a)','Enter EELEC'
-cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- enddo
- do i=iatel_s,iatel_e
-C if (i.eq.1) then
- if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
-C & .or. itype(i+2).eq.ntyp1) cycle
-C else
-C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
-C & .or. itype(i+2).eq.ntyp1
-C & .or. itype(i-1).eq.ntyp1
- &) cycle
-C endif
- if (itel(i).eq.0) goto 1215
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- xmedi=mod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=mod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=mod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
- num_conti=0
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- do j=ielstart(i),ielend(i)
-C if (j.le.1) cycle
-C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
-C & .or.itype(j+2).eq.ntyp1
-C &) cycle
-C else
- if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
-C & .or.itype(j+2).eq.ntyp1
-C & .or.itype(j-1).eq.ntyp1
- &) cycle
-C endif
- if (itel(j).eq.0) goto 1216
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
-C Diagnostics only!!!
-c aaa=0.0D0
-c bbb=0.0D0
-c ael6i=0.0D0
-c ael3i=0.0D0
-C End diagnostics
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj
- yj=c(2,j)+0.5D0*dyj
- zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- isubchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
-
- rij=xj*xj+yj*yj+zj*zj
- sss=sscale(sqrt(rij))
- sssgrad=sscagrad(sqrt(rij))
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- rmij=1.0D0/rij
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
-c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
-C 12/26/95 - for the evaluation of multi-body H-bonding interactions
- ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- if (shield_mode.gt.0) then
-C fac_shield(i)=0.4
-C fac_shield(j)=0.6
-C#define DEBUG
-#ifdef DEBUG
- write(iout,*) "ees_compon",i,j,el1,el2,
- & fac_shield(i),fac_shield(j)
-#endif
-C#undef DEBUG
- el1=el1*fac_shield(i)**2*fac_shield(j)**2
- el2=el2*fac_shield(i)**2*fac_shield(j)**2
- eesij=(el1+el2)
- ees=ees+eesij
- else
- fac_shield(i)=1.0
- fac_shield(j)=1.0
- eesij=(el1+el2)
- ees=ees+eesij
- endif
-C ees=ees+eesij
- evdw1=evdw1+evdwij*sss
-cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
-cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
-cd & xmedi,ymedi,zmedi,xj,yj,zj
-C
-C Calculate contributions to the Cartesian gradient.
-C
-#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)*sss
- facel=-3*rrmij*(el1+eesij)
- fac1=fac
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
- if (calc_grad) then
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
-
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
- & (shield_mode.gt.0)) then
-C print *,i,j
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
- & *2.0
- gshieldx(k,iresshield)=gshieldx(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
- gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
-C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
-C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
-C if (iresshield.gt.i) then
-C do ishi=i+1,iresshield-1
-C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
-C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
-C
-C enddo
-C else
-C do ishi=iresshield,i
-C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
-C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
-C
-C enddo
-C endif
-C enddo
-C enddo
- enddo
- enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
- & *2.0
- gshieldx(k,iresshield)=gshieldx(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
- gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
- enddo
- enddo
-
- do k=1,3
- gshieldc(k,i)=gshieldc(k,i)+
- & grad_shield(k,i)*eesij/fac_shield(i)*2.0
- gshieldc(k,j)=gshieldc(k,j)+
- & grad_shield(k,j)*eesij/fac_shield(j)*2.0
- gshieldc(k,i-1)=gshieldc(k,i-1)+
- & grad_shield(k,i)*eesij/fac_shield(i)*2.0
- gshieldc(k,j-1)=gshieldc(k,j-1)+
- & grad_shield(k,j)*eesij/fac_shield(j)*2.0
-
- enddo
- endif
-
- do k=1,3
- ghalf=0.5D0*ggg(k)
- gelc(k,i)=gelc(k,i)+ghalf
- gelc(k,j)=gelc(k,j)+ghalf
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
- do k=i+1,j-1
- do l=1,3
- gelc(l,k)=gelc(l,k)+ggg(l)
- enddo
- enddo
-C ggg(1)=facvdw*xj
-C ggg(2)=facvdw*yj
-C ggg(3)=facvdw*zj
- if (sss.gt.0.0) then
- ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
- ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
- ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
- else
- ggg(1)=0.0
- ggg(2)=0.0
- ggg(3)=0.0
- endif
- do k=1,3
- ghalf=0.5D0*ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)+ghalf
- gvdwpp(k,j)=gvdwpp(k,j)+ghalf
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
- do k=i+1,j-1
- do l=1,3
- gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
- enddo
- enddo
-#else
- facvdw=(ev1+evdwij)*sss
- facel=el1+eesij
- fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
- if (calc_grad) then
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
- do k=1,3
- ghalf=0.5D0*ggg(k)
- gelc(k,i)=gelc(k,i)+ghalf
- gelc(k,j)=gelc(k,j)+ghalf
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
- do k=i+1,j-1
- do l=1,3
- gelc(l,k)=gelc(l,k)+ggg(l)
- enddo
- enddo
-#endif
-*
-* Angular part
-*
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
-cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
-cd & (dcosg(k),k=1,3)
- do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
- & *fac_shield(i)**2*fac_shield(j)**2
- enddo
- do k=1,3
- ghalf=0.5D0*ggg(k)
- gelc(k,i)=gelc(k,i)+ghalf
- & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)**2*fac_shield(j)**2
-
- gelc(k,j)=gelc(k,j)+ghalf
- & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)**2*fac_shield(j)**2
- enddo
- do k=i+1,j-1
- do l=1,3
- gelc(l,k)=gelc(l,k)+ggg(l)
- enddo
- enddo
- endif
-
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
- & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C
-C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
-C energy of a peptide unit is assumed in the form of a second-order
-C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
-C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
-C are computed for EVERY pair of non-contiguous peptide groups.
-C
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
- enddo
- enddo
-cd write (iout,*) 'EELEC: i',i,' j',j
-cd write (iout,*) 'j',j,' j1',j1,' j2',j2
-cd write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
-C For diagnostics only
-cd a22=1.0d0
-cd a23=1.0d0
-cd a32=1.0d0
-cd a33=1.0d0
- fac=dsqrt(-ael6i)*r3ij
-cd write (2,*) 'fac=',fac
-C For diagnostics only
-cd fac=1.0d0
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
-cd write (iout,'(4i5,4f10.5)')
-cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
-cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
-cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
-cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
-cd write (iout,'(4f10.5)')
-cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
-cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
-cd write (iout,'(4f10.5)') ury,urz,vry,vrz
-cd write (iout,'(2i3,9f10.5/)') i,j,
-cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
- if (calc_grad) then
-C Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
-cd do k=1,3
-cd do l=1,3
-cd erder(k,l)=0.0d0
-cd enddo
-cd enddo
- do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
- enddo
-cd do k=1,3
-cd do l=1,3
-cd uryg(k,l)=0.0d0
-cd urzg(k,l)=0.0d0
-cd vryg(k,l)=0.0d0
-cd vrzg(k,l)=0.0d0
-cd enddo
-cd enddo
-C Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
-cd a22der=0.0d0
-cd a23der=0.0d0
-cd a32der=0.0d0
-cd a33der=0.0d0
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
-C Add the contributions coming from er
- fac3=-3.0d0*fac
- do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
- do k=1,3
-C Derivatives in DC(i)
- ghalf1=0.5d0*agg(k,1)
- ghalf2=0.5d0*agg(k,2)
- ghalf3=0.5d0*agg(k,3)
- ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
- & -3.0d0*uryg(k,2)*vry)+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
- & -3.0d0*uryg(k,2)*vrz)+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
- & -3.0d0*urzg(k,2)*vry)+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
- & -3.0d0*urzg(k,2)*vrz)+ghalf4
-C Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
- & -3.0d0*uryg(k,3)*vry)+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
- & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
- & -3.0d0*urzg(k,3)*vry)+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
- & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
-C Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
- & -3.0d0*vryg(k,2)*ury)+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
- & -3.0d0*vrzg(k,2)*ury)+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
- & -3.0d0*vryg(k,2)*urz)+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
- & -3.0d0*vrzg(k,2)*urz)+ghalf4
-C Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
- & -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
- & -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
- & -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
- & -3.0d0*vrzg(k,3)*urz)
-cd aggi(k,1)=ghalf1
-cd aggi(k,2)=ghalf2
-cd aggi(k,3)=ghalf3
-cd aggi(k,4)=ghalf4
-C Derivatives in DC(i+1)
-cd aggi1(k,1)=agg(k,1)
-cd aggi1(k,2)=agg(k,2)
-cd aggi1(k,3)=agg(k,3)
-cd aggi1(k,4)=agg(k,4)
-C Derivatives in DC(j)
-cd aggj(k,1)=ghalf1
-cd aggj(k,2)=ghalf2
-cd aggj(k,3)=ghalf3
-cd aggj(k,4)=ghalf4
-C Derivatives in DC(j+1)
-cd aggj1(k,1)=0.0d0
-cd aggj1(k,2)=0.0d0
-cd aggj1(k,3)=0.0d0
-cd aggj1(k,4)=0.0d0
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do l=1,4
- aggj1(k,l)=aggj1(k,l)+agg(k,l)
-cd aggj1(k,l)=agg(k,l)
- enddo
- endif
- enddo
- endif
-c goto 11111
-C Check the loc-el terms by numerical integration
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
- a22=-a22
- a23=-a23
- do l=1,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
-11111 continue
- IF (wel_loc.gt.0.0d0) THEN
-C Contribution to the local-electrostatic energy coming from the i-j pair
- eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
- & +a33*muij(4)
-cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
- if (shield_mode.eq.0) then
- fac_shield(i)=1.0
- fac_shield(j)=1.0
-C else
-C fac_shield(i)=0.4
-C fac_shield(j)=0.6
- endif
- eel_loc_ij=eel_loc_ij
- & *fac_shield(i)*fac_shield(j)
- eel_loc=eel_loc+eel_loc_ij
-C Partial derivatives in virtual-bond dihedral angles gamma
- if (calc_grad) then
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
- & (shield_mode.gt.0)) then
-C print *,i,j
-
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
- & /fac_shield(i)
-C & *2.0
- gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
- gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
- & +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
- & /fac_shield(j)
-C & *2.0
- gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
- gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
- & +rlocshield
-
- enddo
- enddo
- do k=1,3
- gshieldc_ll(k,i)=gshieldc_ll(k,i)+
- & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
- gshieldc_ll(k,j)=gshieldc_ll(k,j)+
- & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
- gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
- & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
- gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
- & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
- enddo
- endif
- if (i.gt.1)
- & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
- & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
- & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
- & *fac_shield(i)*fac_shield(j)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+
- & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
- & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
- & *fac_shield(i)*fac_shield(j)
-
-cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
-cd write(iout,*) 'agg ',agg
-cd write(iout,*) 'aggi ',aggi
-cd write(iout,*) 'aggi1',aggi1
-cd write(iout,*) 'aggj ',aggj
-cd write(iout,*) 'aggj1',aggj1
-
-C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
- do l=1,3
- ggg(l)=agg(l,1)*muij(1)+
- & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
- & *fac_shield(i)*fac_shield(j)
-
- enddo
- do k=i+2,j2
- do l=1,3
- gel_loc(l,k)=gel_loc(l,k)+ggg(l)
- enddo
- enddo
-C Remaining derivatives of eello
- do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
- & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
- & *fac_shield(i)*fac_shield(j)
-
- gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
- & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
- & *fac_shield(i)*fac_shield(j)
-
- gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
- & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
- & *fac_shield(i)*fac_shield(j)
-
- gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
- & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
- & *fac_shield(i)*fac_shield(j)
-
- enddo
- endif
- ENDIF
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
-C Contributions from turns
- a_temp(1,1)=a22
- a_temp(1,2)=a23
- a_temp(2,1)=a32
- a_temp(2,2)=a33
- call eturn34(i,j,eello_turn3,eello_turn4)
- endif
-C Change 12/26/95 to calculate four-body contributions to H-bonding energy
- if (j.gt.i+1 .and. num_conti.le.maxconts) then
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-c r0ij=1.02D0*rpp(iteli,itelj)
-c r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-c r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',
- & ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
- & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
-C terms.
- d_cont(num_conti,i)=rij
-cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
-C --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
-C --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
-c if (i.eq.1) then
-c a_chuj(1,1,num_conti,i)=-0.61d0
-c a_chuj(1,2,num_conti,i)= 0.4d0
-c a_chuj(2,1,num_conti,i)= 0.65d0
-c a_chuj(2,2,num_conti,i)= 0.50d0
-c else if (i.eq.2) then
-c a_chuj(1,1,num_conti,i)= 0.0d0
-c a_chuj(1,2,num_conti,i)= 0.0d0
-c a_chuj(2,1,num_conti,i)= 0.0d0
-c a_chuj(2,2,num_conti,i)= 0.0d0
-c endif
-C --- and its gradients
-cd write (iout,*) 'i',i,' j',j
-cd do kkk=1,3
-cd write (iout,*) 'iii 1 kkk',kkk
-cd write (iout,*) agg(kkk,:)
-cd enddo
-cd do kkk=1,3
-cd write (iout,*) 'iii 2 kkk',kkk
-cd write (iout,*) aggi(kkk,:)
-cd enddo
-cd do kkk=1,3
-cd write (iout,*) 'iii 3 kkk',kkk
-cd write (iout,*) aggi1(kkk,:)
-cd enddo
-cd do kkk=1,3
-cd write (iout,*) 'iii 4 kkk',kkk
-cd write (iout,*) aggj(kkk,:)
-cd enddo
-cd do kkk=1,3
-cd write (iout,*) 'iii 5 kkk',kkk
-cd write (iout,*) aggj1(kkk,:)
-cd enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
-c do mm=1,5
-c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
-c enddo
- enddo
- enddo
- enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
-C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-c fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
- ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- if (shield_mode.eq.0) then
- fac_shield(i)=1.0d0
- fac_shield(j)=1.0d0
- else
- ees0plist(num_conti,i)=j
-C fac_shield(i)=0.4d0
-C fac_shield(j)=0.6d0
- endif
-c ees0mij=0.0D0
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- & *fac_shield(i)*fac_shield(j)
-
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
- & *fac_shield(i)*fac_shield(j)
-
-C Diagnostics. Comment out or remove after debugging!
-c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
-c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
-c ees0m(num_conti,i)=0.0D0
-C End diagnostics.
-c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
-c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
- facont_hb(num_conti,i)=fcont
- if (calc_grad) then
-C Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-c ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
-C Diagnostics
-c ecosap=ecosa1
-c ecosbp=ecosb1
-c ecosgp=ecosg1
-c ecosam=0.0D0
-c ecosbm=0.0D0
-c ecosgm=0.0D0
-C End diagnostics
- fprimcont=fprimcont/rij
-cd facont_hb(num_conti,i)=1.0D0
-C Following line is for diagnostics.
-cd fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
-C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
- ghalfp=0.5D0*gggp(k)
- ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)=ghalfp
- & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
-
- gacontp_hb2(k,num_conti,i)=ghalfp
- & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
-
- gacontp_hb3(k,num_conti,i)=gggp(k)
- & *fac_shield(i)*fac_shield(j)
-
- gacontm_hb1(k,num_conti,i)=ghalfm
- & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
-
- gacontm_hb2(k,num_conti,i)=ghalfm
- & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
-
- gacontm_hb3(k,num_conti,i)=gggm(k)
- & *fac_shield(i)*fac_shield(j)
-
- enddo
- endif
-C Diagnostics. Comment out or remove after debugging!
-cdiag do k=1,3
-cdiag gacontp_hb1(k,num_conti,i)=0.0D0
-cdiag gacontp_hb2(k,num_conti,i)=0.0D0
-cdiag gacontp_hb3(k,num_conti,i)=0.0D0
-cdiag gacontm_hb1(k,num_conti,i)=0.0D0
-cdiag gacontm_hb2(k,num_conti,i)=0.0D0
-cdiag gacontm_hb3(k,num_conti,i)=0.0D0
-cdiag enddo
- ENDIF ! wcorr
- endif ! num_conti.le.maxconts
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- 1216 continue
- enddo ! j
- num_cont_hb(i)=num_conti
- 1215 continue
- enddo ! i
-cd do i=1,nres
-cd write (iout,'(i3,3f10.5,5x,3f10.5)')
-cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
-cd enddo
-c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
-ccc eel_loc=eel_loc+eello_turn3
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eturn34(i,j,eello_turn3,eello_turn4)
-C Third- and fourth-order contributions from turns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.SHIELD'
- include 'COMMON.CONTROL'
-
- dimension ggg(3)
- double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
- & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
- & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
- double precision agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
- if (j.eq.i+2) then
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
-C changes suggested by Ana to avoid out of bounds
-C & .or.((i+5).gt.nres)
-C & .or.((i-1).le.0)
-C end of changes suggested by Ana
- & .or. itype(i+2).eq.ntyp1
- & .or. itype(i+3).eq.ntyp1
-C & .or. itype(i+5).eq.ntyp1
-C & .or. itype(i).eq.ntyp1
-C & .or. itype(i-1).eq.ntyp1
- & ) goto 179
-
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Third-order contributions
-C
-C (i+2)o----(i+3)
-C | |
-C | |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn3(i,a_temp,eello_turn3_num)
- call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
- call transpose2(auxmat(1,1),auxmat1(1,1))
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- if (shield_mode.eq.0) then
- fac_shield(i)=1.0
- fac_shield(j)=1.0
-C else
-C fac_shield(i)=0.4
-C fac_shield(j)=0.6
- endif
- eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
- eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
-
-cd write (2,*) 'i,',i,' j',j,'eello_turn3',
-cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
-cd & ' eello_turn3_num',4*eello_turn3_num
- if (calc_grad) then
-C Derivatives in shield mode
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
- & (shield_mode.gt.0)) then
-C print *,i,j
-
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
-C & *2.0
- gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
- gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
- & +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
-C & *2.0
- gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
- gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
- & +rlocshield
-
- enddo
- enddo
-
- do k=1,3
- gshieldc_t3(k,i)=gshieldc_t3(k,i)+
- & grad_shield(k,i)*eello_t3/fac_shield(i)
- gshieldc_t3(k,j)=gshieldc_t3(k,j)+
- & grad_shield(k,j)*eello_t3/fac_shield(j)
- gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
- & grad_shield(k,i)*eello_t3/fac_shield(i)
- gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
- & grad_shield(k,j)*eello_t3/fac_shield(j)
- enddo
- endif
-
-C Derivatives in gamma(i)
- call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),pizda(1,1))
- call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
- gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
-
-C Derivatives in gamma(i+1)
- call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),pizda(1,1))
- call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
- gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
-
-C Cartesian derivatives
- do l=1,3
- a_temp(1,1)=aggi(l,1)
- a_temp(1,2)=aggi(l,2)
- a_temp(2,1)=aggi(l,3)
- a_temp(2,2)=aggi(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i)=gcorr3_turn(l,i)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
-
- a_temp(1,1)=aggi1(l,1)
- a_temp(1,2)=aggi1(l,2)
- a_temp(2,1)=aggi1(l,3)
- a_temp(2,2)=aggi1(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
-
- a_temp(1,1)=aggj(l,1)
- a_temp(1,2)=aggj(l,2)
- a_temp(2,1)=aggj(l,3)
- a_temp(2,2)=aggj(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j)=gcorr3_turn(l,j)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
-
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- & *fac_shield(i)*fac_shield(j)
-
- enddo
- endif
- 179 continue
- else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
-C changes suggested by Ana to avoid out of bounds
-C & .or.((i+5).gt.nres)
-C & .or.((i-1).le.0)
-C end of changes suggested by Ana
- & .or. itype(i+3).eq.ntyp1
- & .or. itype(i+4).eq.ntyp1
-C & .or. itype(i+5).eq.ntyp1
- & .or. itype(i).eq.ntyp1
-C & .or. itype(i-1).eq.ntyp1
- & ) goto 178
-
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Fourth-order contributions
-C
-C (i+3)o----(i+4)
-C / |
-C (i+2)o |
-C \ |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn4(i,a_temp,eello_turn4_num)
- iti1=itortyp(itype(i+1))
- iti2=itortyp(itype(i+2))
- iti3=itortyp(itype(i+3))
- call transpose2(EUg(1,1,i+1),e1t(1,1))
- call transpose2(Eug(1,1,i+2),e2t(1,1))
- call transpose2(Eug(1,1,i+3),e3t(1,1))
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- if (shield_mode.eq.0) then
- fac_shield(i)=1.0
- fac_shield(j)=1.0
-C else
-C fac_shield(i)=0.4
-C fac_shield(j)=0.6
- endif
- eello_turn4=eello_turn4-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
- eello_t4=-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
-cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
-cd & ' eello_turn4_num',8*eello_turn4_num
-C Derivatives in gamma(i)
- if (calc_grad) then
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
- & (shield_mode.gt.0)) then
-C print *,i,j
-
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
-C & *2.0
- gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
- gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
- & +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
-C & *2.0
- gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
- gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
- & +rlocshield
-
- enddo
- enddo
-
- do k=1,3
- gshieldc_t4(k,i)=gshieldc_t4(k,i)+
- & grad_shield(k,i)*eello_t4/fac_shield(i)
- gshieldc_t4(k,j)=gshieldc_t4(k,j)+
- & grad_shield(k,j)*eello_t4/fac_shield(j)
- gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
- & grad_shield(k,i)*eello_t4/fac_shield(i)
- gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
- & grad_shield(k,j)*eello_t4/fac_shield(j)
- enddo
- endif
-
- call transpose2(EUgder(1,1,i+1),e1tder(1,1))
- call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
- & *fac_shield(i)*fac_shield(j)
-
-C Derivatives in gamma(i+1)
- call transpose2(EUgder(1,1,i+2),e2tder(1,1))
- call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
- call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
-C Derivatives in gamma(i+2)
- call transpose2(EUgder(1,1,i+3),e3tder(1,1))
- call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
- call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
-C Cartesian derivatives
-C Derivatives of this turn contributions in DC(i+2)
- if (j.lt.nres-1) then
- do l=1,3
- a_temp(1,1)=agg(l,1)
- a_temp(1,2)=agg(l,2)
- a_temp(2,1)=agg(l,3)
- a_temp(2,2)=agg(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- ggg(l)=-(s1+s2+s3)
- gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
- enddo
- endif
-C Remaining derivatives of this turn contribution
- do l=1,3
- a_temp(1,1)=aggi(l,1)
- a_temp(1,2)=aggi(l,2)
- a_temp(2,1)=aggi(l,3)
- a_temp(2,2)=aggi(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
- a_temp(1,1)=aggi1(l,1)
- a_temp(1,2)=aggi1(l,2)
- a_temp(2,1)=aggi1(l,3)
- a_temp(2,2)=aggi1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
- a_temp(1,1)=aggj(l,1)
- a_temp(1,2)=aggj(l,2)
- a_temp(2,1)=aggj(l,3)
- a_temp(2,2)=aggj(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
- & *fac_shield(i)*fac_shield(j)
-
- enddo
- endif
- 178 continue
- endif
- return
- end
-C-----------------------------------------------------------------------------
- subroutine vecpr(u,v,w)
- implicit real*8(a-h,o-z)
- dimension u(3),v(3),w(3)
- w(1)=u(2)*v(3)-u(3)*v(2)
- w(2)=-u(1)*v(3)+u(3)*v(1)
- w(3)=u(1)*v(2)-u(2)*v(1)
- return
- end
-C-----------------------------------------------------------------------------
- subroutine unormderiv(u,ugrad,unorm,ungrad)
-C This subroutine computes the derivatives of a normalized vector u, given
-C the derivatives computed without normalization conditions, ugrad. Returns
-C ungrad.
- implicit none
- double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
- double precision vec(3)
- double precision scalar
- integer i,j
-c write (2,*) 'ugrad',ugrad
-c write (2,*) 'u',u
- do i=1,3
- vec(i)=scalar(ugrad(1,i),u(1))
- enddo
-c write (2,*) 'vec',vec
- do i=1,3
- do j=1,3
- ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
- enddo
- enddo
-c write (2,*) 'ungrad',ungrad
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp(evdw2,evdw2_14)
-C
-C This subroutine calculates the excluded-volume interaction energy between
-C peptide-group centers and side chains and its gradient in virtual-bond and
-C side-chain vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- dimension ggg(3)
- evdw2=0.0D0
- evdw2_14=0.0d0
-cd print '(a)','Enter ESCP'
-c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
-c & ' scal14',scal14
- do i=iatscp_s,iatscp_e
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
- iteli=itel(i)
-c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
-c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
- if (iteli.eq.0) goto 1225
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
-C Returning the ith atom to box
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- do iint=1,nscp_gr(i)
-
- do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=iabs(itype(j))
- if (itypj.eq.ntyp1) cycle
-C Uncomment following three lines for SC-p interactions
-c xj=c(1,nres+j)-xi
-c yj=c(2,nres+j)-yi
-c zj=c(3,nres+j)-zi
-C Uncomment following three lines for Ca-p interactions
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
-C returning the jth atom to box
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-C Finding the closest jth atom
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-C sss is scaling function for smoothing the cutoff gradient otherwise
-C the gradient would not be continuouse
- sss=sscale(1.0d0/(dsqrt(rrij)))
- if (sss.le.0.0d0) cycle
- sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
- fac=rrij**expon2
- e1=fac*fac*aad(itypj,iteli)
- e2=fac*bad(itypj,iteli)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- evdw2_14=evdw2_14+(e1+e2)*sss
- endif
- evdwij=e1+e2
-c write (iout,*) i,j,evdwij
- evdw2=evdw2+evdwij*sss
- if (calc_grad) then
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- fac=-(evdwij+e1)*rrij*sss
- fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
- if (j.lt.i) then
-cd write (iout,*) 'j<i'
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
- else
-cd write (iout,*) 'j>i'
- do k=1,3
- ggg(k)=-ggg(k)
-C Uncomment following line for SC-p interactions
-c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
- enddo
- endif
- do k=1,3
- gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
- enddo
- kstart=min0(i+1,j)
- kend=max0(i-1,j-1)
-cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
-cd write (iout,*) ggg(1),ggg(2),ggg(3)
- do k=kstart,kend
- do l=1,3
- gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
- enddo
- enddo
- endif
- enddo
- enddo ! iint
- 1225 continue
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
- gradx_scp(j,i)=expon*gradx_scp(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time the factor EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C--------------------------------------------------------------------------
- subroutine edis(ehpb)
-C
-C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- ehpb=0.0D0
-cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
-cd print *,'link_start=',link_start,' link_end=',link_end
- if (link_end.eq.0) return
- do i=link_start,link_end
-C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
-C CA-CA distance used in regularization of structure.
- ii=ihpb(i)
- jj=jhpb(i)
-C iii and jjj point to the residues for which the distance is assigned.
- if (ii.gt.nres) then
- iii=ii-nres
- jjj=jj-nres
- else
- iii=ii
- jjj=jj
- endif
-C 24/11/03 AL: SS bridges handled separately because of introducing a specific
-C distance and angle dependent SS bond potential.
-C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
-C & iabs(itype(jjj)).eq.1) then
-C call ssbond_ene(iii,jjj,eij)
-C ehpb=ehpb+2*eij
-C else
- if (.not.dyn_ss .and. i.le.nss) 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
- endif !ii.gt.neres
- else if (ii.gt.nres .and. jj.gt.nres) then
-c Restraints from contact prediction
- dd=dist(ii,jj)
- if (constr_dist.eq.11) then
-C ehpb=ehpb+fordepth(i)**4.0d0
-C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
- ehpb=ehpb+fordepth(i)**4.0d0
- & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
- fac=fordepth(i)**4.0d0
- & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
-C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
-C & ehpb,fordepth(i),dd
-C print *,"TUTU"
-C write(iout,*) ehpb,"atu?"
-C ehpb,"tu?"
-C fac=fordepth(i)**4.0d0
-C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
- else !constr_dist.eq.11
- if (dhpb1(i).gt.0.0d0) then
- ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
-c write (iout,*) "beta nmr",
-c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- else !dhpb(i).gt.0.00
-
-C Calculate the distance between the two points and its difference from the
-C target distance.
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
-C Get the force constant corresponding to this distance.
- waga=forcon(i)
-C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-C
-C Evaluate gradient.
-C
- fac=waga*rdis/dd
- endif !dhpb(i).gt.0
- endif
-cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
-cd & ' waga=',waga,' fac=',fac
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
-cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
-C If this is a SC-SC distance, we need to calculate the contributions to the
-C Cartesian gradient in the SC vectors (ghpbx).
- if (iii.lt.ii) then
- do j=1,3
- ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
- ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
- enddo
- endif
- else !ii.gt.nres
-C write(iout,*) "before"
- dd=dist(ii,jj)
-C write(iout,*) "after",dd
- if (constr_dist.eq.11) then
- ehpb=ehpb+fordepth(i)**4.0d0
- & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
- fac=fordepth(i)**4.0d0
- & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
-C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
-C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
-C print *,ehpb,"tu?"
-C write(iout,*) ehpb,"btu?",
-C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
-C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
-C & ehpb,fordepth(i),dd
- else
- if (dhpb1(i).gt.0.0d0) then
- ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
-c write (iout,*) "alph nmr",
-c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- else
- rdis=dd-dhpb(i)
-C Get the force constant corresponding to this distance.
- waga=forcon(i)
-C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-c write (iout,*) "alpha reg",dd,waga*rdis*rdis
-C
-C Evaluate gradient.
-C
- fac=waga*rdis/dd
- endif
- endif
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
-cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
-C If this is a SC-SC distance, we need to calculate the contributions to the
-C Cartesian gradient in the SC vectors (ghpbx).
- if (iii.lt.ii) then
- do j=1,3
- ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
- ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
- enddo
- endif
- do j=iii,jjj-1
- do k=1,3
- ghpbc(k,j)=ghpbc(k,j)+ggg(k)
- enddo
- enddo
- endif
- enddo
- if (constr_dist.ne.11) ehpb=0.5D0*ehpb
- return
- end
-C--------------------------------------------------------------------------
- subroutine ssbond_ene(i,j,eij)
-C
-C Calculate the distance and angle dependent SS-bond potential energy
-C using a free-energy function derived based on RHF/6-31G** ab initio
-C calculations of diethyl disulfide.
-C
-C A. Liwo and U. Kozlowska, 11/24/03
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=iabs(itype(i))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=dsc_inv(itypi)
- itypj=iabs(itype(j))
- dscj_inv=dsc_inv(itypj)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- rij=1.0d0/rij
- deltad=rij-d0cm
- deltat1=1.0d0-om1
- deltat2=1.0d0+om2
- deltat12=om2-om1+2.0d0
- cosphi=om12-om1*om2
- eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
- & +akct*deltad*deltat12
- & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
-c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
-c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
-c & " deltat12",deltat12," eij",eij
- ed=2*akcm*deltad+akct*deltat12
- pom1=akct*deltad
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
- do k=1,3
- gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
- do k=1,3
- ghpbx(k,i)=ghpbx(k,i)-gg(k)
- & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
- ghpbx(k,j)=ghpbx(k,j)+gg(k)
- & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
- do k=i,j-1
- do l=1,3
- ghpbc(l,k)=ghpbc(l,k)+gg(l)
- enddo
- enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine ebond(estr)
-c
-c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- logical energy_dec /.false./
- double precision u(3),ud(3)
- estr=0.0d0
- estr1=0.0d0
- do i=nnt+1,nct
- if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
-C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
-C do j=1,3
-C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
-C & *dc(j,i-1)/vbld(i)
-C enddo
-C if (energy_dec) write(iout,*)
-C & "estr1",i,vbld(i),distchainmax,
-C & gnmr1(vbld(i),-1.0d0,distchainmax)
-C else
- if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
- diff = vbld(i)-vbldpDUM
- else
- diff = vbld(i)-vbldp0
-c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
- endif
- estr=estr+diff*diff
- do j=1,3
- gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
- enddo
-C endif
-C write (iout,'(a7,i5,4f7.3)')
-C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
- enddo
- estr=0.5d0*AKP*estr+estr1
-c
-c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
-c
- do i=nnt,nct
- iti=iabs(itype(i))
- if (iti.ne.10 .and. iti.ne.ntyp1) then
- nbi=nbondterm(iti)
- if (nbi.eq.1) then
- diff=vbld(i+nres)-vbldsc0(1,iti)
-c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
-c & AKSC(1,iti),AKSC(1,iti)*diff*diff
- estr=estr+0.5d0*AKSC(1,iti)*diff*diff
- do j=1,3
- gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
- enddo
- else
- do j=1,nbi
- diff=vbld(i+nres)-vbldsc0(j,iti)
- ud(j)=aksc(j,iti)*diff
- u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
- enddo
- uprod=u(1)
- do j=2,nbi
- uprod=uprod*u(j)
- enddo
- usum=0.0d0
- usumsqder=0.0d0
- do j=1,nbi
- uprod1=1.0d0
- uprod2=1.0d0
- do k=1,nbi
- if (k.ne.j) then
- uprod1=uprod1*u(k)
- uprod2=uprod2*u(k)*u(k)
- endif
- enddo
- usum=usum+uprod1
- usumsqder=usumsqder+ud(j)*uprod2
- enddo
-c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
-c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
- estr=estr+uprod/usum
- do j=1,3
- gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
- enddo
- endif
- endif
- enddo
- return
- end
-#ifdef CRYST_THETA
-C--------------------------------------------------------------------------
- subroutine ebend(etheta,ethetacnstr)
-C
-C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
-C angles gamma and its derivatives in consecutive thetas and gammas.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
- double precision y(2),z(2)
- delta=0.02d0*pi
-c time11=dexp(-2*time)
-c time12=1.0d0
- etheta=0.0D0
-c write (iout,*) "nres",nres
-c write (*,'(a,i2)') 'EBEND ICG=',icg
-c write (iout,*) ithet_start,ithet_end
- do i=ithet_start,ithet_end
- if (i.le.2) cycle
- if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
- & .or.itype(i).eq.ntyp1) cycle
-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
- if (i.eq.3) then
- y(1)=0.0D0
- y(2)=0.0D0
- else
- if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
-#ifdef OSF
- phii=phi(i)
-c icrc=0
-c call proc_proc(phii,icrc)
- if (icrc.eq.1) phii=150.0
-#else
- phii=phi(i)
-#endif
- y(1)=dcos(phii)
- y(2)=dsin(phii)
- else
- y(1)=0.0D0
- y(2)=0.0D0
- endif
- endif
- if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
-#ifdef OSF
- phii1=phi(i+1)
-c icrc=0
-c call proc_proc(phii1,icrc)
- if (icrc.eq.1) phii1=150.0
- phii1=pinorm(phii1)
- z(1)=cos(phii1)
-#else
- phii1=phi(i+1)
- z(1)=dcos(phii1)
-#endif
- z(2)=dsin(phii1)
- else
- z(1)=0.0D0
- z(2)=0.0D0
- endif
-C Calculate the "mean" value of theta from the part of the distribution
-C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
-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
- thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
- enddo
-c write (iout,*) "thet_pred_mean",thet_pred_mean
- dthett=thet_pred_mean*ssd
- 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,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)
- call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
- call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
- call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
- & E_theta)
- call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
- & E_tc)
- else if (theta(i).lt.delta) then
- call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
- call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
- call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
- & E_theta)
- call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
- call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
- & E_tc)
- else
- call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
- & E_theta,E_tc)
- endif
- etheta=etheta+ethetai
-c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
-c & rad2deg*phii,rad2deg*phii1,ethetai
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
- gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
-c 1215 continue
- enddo
-C Ufff.... We've done all this!!!
-C now constrains
- ethetacnstr=0.0d0
-C print *,ithetaconstr_start,ithetaconstr_end,"TU"
- do i=1,ntheta_constr
- itheta=itheta_constr(i)
- thetiii=theta(itheta)
- difi=pinorm(thetiii-theta_constr0(i))
- if (difi.gt.theta_drange(i)) then
- difi=difi-theta_drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
- & +for_thet_constr(i)*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
- & +for_thet_constr(i)*difi**3
- else
- difi=0.0
- endif
-C if (energy_dec) then
-C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
-C & i,itheta,rad2deg*thetiii,
-C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
-C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
-C & gloc(itheta+nphi-2,icg)
-C endif
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
- & E_tc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
-C Calculate the contributions to both Gaussian lobes.
-C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
-C The "polynomial part" of the "standard deviation" of this part of
-C the distribution.
- sig=polthet(3,it)
- do j=2,0,-1
- sig=sig*thet_pred_mean+polthet(j,it)
- enddo
-C Derivative of the "interior part" of the "standard deviation of the"
-C gamma-dependent Gaussian lobe in t_c.
- sigtc=3*polthet(3,it)
- do j=2,1,-1
- sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
- enddo
- sigtc=sig*sigtc
-C Set the parameters of both Gaussian lobes of the distribution.
-C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
- fac=sig*sig+sigc0(it)
- sigcsq=fac+fac
- sigc=1.0D0/sigcsq
-C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
- sigsqtc=-4.0D0*sigcsq*sigtc
-c print *,i,sig,sigtc,sigsqtc
-C Following variable (sigtc) is d[sigma(t_c)]/dt_c
- sigtc=-sigtc/(fac*fac)
-C Following variable is sigma(t_c)**(-2)
- sigcsq=sigcsq*sigcsq
- sig0i=sig0(it)
- sig0inv=1.0D0/sig0i**2
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
- term1=-0.5D0*sigcsq*delthec*delthec
- term2=-0.5D0*sig0inv*delthe0*delthe0
-C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
-C NaNs in taking the logarithm. We extract the largest exponent which is added
-C to the energy (this being the log of the distribution) at the end of energy
-C term evaluation for this virtual-bond angle.
- if (term1.gt.term2) then
- termm=term1
- term2=dexp(term2-termm)
- term1=1.0d0
- else
- termm=term2
- term1=dexp(term1-termm)
- term2=1.0d0
- endif
-C The ratio between the gamma-independent and gamma-dependent lobes of
-C the distribution is a Gaussian function of thet_pred_mean too.
- diffak=gthet(2,it)-thet_pred_mean
- ratak=diffak/gthet(3,it)**2
- ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
-C Let's differentiate it in thet_pred_mean NOW.
- aktc=ak*ratak
-C Now put together the distribution terms to make complete distribution.
- termexp=term1+ak*term2
- termpre=sigc+ak*sig0i
-C Contribution of the bending energy from this theta is just the -log of
-C the sum of the contributions from the two lobes and the pre-exponential
-C factor. Simple enough, isn't it?
- ethetai=(-dlog(termexp)-termm+dlog(termpre))
-C NOW the derivatives!!!
-C 6/6/97 Take into account the deformation.
- E_theta=(delthec*sigcsq*term1
- & +ak*delthe0*sig0inv*term2)/termexp
- E_tc=((sigtc+aktc*sig0i)/termpre
- & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
- & aktc*term2)/termexp)
- return
- end
-c-----------------------------------------------------------------------------
- subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
-C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
- t3 = thetai-thet_pred_mean
- t6 = t3**2
- t9 = term1
- t12 = t3*sigcsq
- t14 = t12+t6*sigsqtc
- t16 = 1.0d0
- t21 = thetai-theta0i
- t23 = t21**2
- t26 = term2
- t27 = t21*t26
- t32 = termexp
- t40 = t32**2
- E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
- & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
- & *(-t12*t9-ak*sig0inv*t27)
- return
- end
-#else
-C--------------------------------------------------------------------------
- subroutine ebend(etheta,ethetacnstr)
-C
-C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
-C angles gamma and its derivatives in consecutive thetas and gammas.
-C ab initio-derived potentials from
-c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- include 'COMMON.TORCNSTR'
- double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
- & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
- & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
- & sinph1ph2(maxdouble,maxdouble)
- logical lprn /.false./, lprn1 /.false./
- etheta=0.0D0
-c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
- do i=ithet_start,ithet_end
- if (i.le.2) cycle
- if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
- & .or.itype(i).eq.ntyp1) cycle
-c if (itype(i-1).eq.ntyp1) cycle
- if (iabs(itype(i+1)).eq.20) iblock=2
- if (iabs(itype(i+1)).ne.20) iblock=1
- dethetai=0.0d0
- dephii=0.0d0
- dephii1=0.0d0
- theti2=0.5d0*theta(i)
- ityp2=ithetyp((itype(i-1)))
- do k=1,nntheterm
- coskt(k)=dcos(k*theti2)
- sinkt(k)=dsin(k*theti2)
- enddo
- if (i.eq.3) then
- phii=0.0d0
- ityp1=nthetyp+1
- do k=1,nsingle
- cosph1(k)=0.0d0
- sinph1(k)=0.0d0
- enddo
- else
- if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
-#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
-#else
- phii=phi(i)
-#endif
- ityp1=ithetyp((itype(i-2)))
- do k=1,nsingle
- cosph1(k)=dcos(k*phii)
- sinph1(k)=dsin(k*phii)
- enddo
- else
- phii=0.0d0
-c ityp1=nthetyp+1
- do k=1,nsingle
- ityp1=ithetyp((itype(i-2)))
- cosph1(k)=0.0d0
- sinph1(k)=0.0d0
- enddo
- endif
- endif
- if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
-#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
-#else
- phii1=phi(i+1)
-#endif
- ityp3=ithetyp((itype(i)))
- do k=1,nsingle
- cosph2(k)=dcos(k*phii1)
- sinph2(k)=dsin(k*phii1)
- enddo
- else
- phii1=0.0d0
-c ityp3=nthetyp+1
- ityp3=ithetyp((itype(i)))
- do k=1,nsingle
- cosph2(k)=0.0d0
- sinph2(k)=0.0d0
- enddo
- endif
-c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
-c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
-c call flush(iout)
- ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
- do k=1,ndouble
- do l=1,k-1
- ccl=cosph1(l)*cosph2(k-l)
- ssl=sinph1(l)*sinph2(k-l)
- scl=sinph1(l)*cosph2(k-l)
- csl=cosph1(l)*sinph2(k-l)
- cosph1ph2(l,k)=ccl-ssl
- cosph1ph2(k,l)=ccl+ssl
- sinph1ph2(l,k)=scl+csl
- sinph1ph2(k,l)=scl-csl
- enddo
- enddo
- if (lprn) then
- write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
- & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
- write (iout,*) "coskt and sinkt"
- do k=1,nntheterm
- write (iout,*) k,coskt(k),sinkt(k)
- enddo
- endif
- do k=1,ntheterm
- ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
- dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
- & *coskt(k)
- if (lprn)
- & write (iout,*) "k",k," aathet",
- & aathet(k,ityp1,ityp2,ityp3,iblock),
- & " ethetai",ethetai
- enddo
- if (lprn) then
- write (iout,*) "cosph and sinph"
- do k=1,nsingle
- write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
- enddo
- write (iout,*) "cosph1ph2 and sinph2ph2"
- do k=2,ndouble
- do l=1,k-1
- write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
- & sinph1ph2(l,k),sinph1ph2(k,l)
- enddo
- enddo
- write(iout,*) "ethetai",ethetai
- endif
- do m=1,ntheterm2
- do k=1,nsingle
- aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
- & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
- & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
- & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*aux*coskt(m)
- dephii=dephii+k*sinkt(m)*(
- & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
- & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
- dephii1=dephii1+k*sinkt(m)*(
- & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
- & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
- if (lprn)
- & write (iout,*) "m",m," k",k," bbthet",
- & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
- & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
- & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
- & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
- enddo
- enddo
- if (lprn)
- & write(iout,*) "ethetai",ethetai
- do m=1,ntheterm3
- do k=2,ndouble
- do l=1,k-1
- aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*coskt(m)*aux
- dephii=dephii+l*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
- & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
- dephii1=dephii1+(k-l)*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
- & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
- if (lprn) then
- write (iout,*) "m",m," k",k," l",l," ffthet",
- & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
- & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
- & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
- & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
- & " ethetai",ethetai
- write (iout,*) cosph1ph2(l,k)*sinkt(m),
- & cosph1ph2(k,l)*sinkt(m),
- & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
- endif
- enddo
- enddo
- enddo
-10 continue
- if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
- & i,theta(i)*rad2deg,phii*rad2deg,
- & phii1*rad2deg,ethetai
- etheta=etheta+ethetai
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
-c gloc(nphi+i-2,icg)=wang*dethetai
- gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
- enddo
-C now constrains
- ethetacnstr=0.0d0
-C print *,ithetaconstr_start,ithetaconstr_end,"TU"
- do i=1,ntheta_constr
- itheta=itheta_constr(i)
- thetiii=theta(itheta)
- difi=pinorm(thetiii-theta_constr0(i))
- if (difi.gt.theta_drange(i)) then
- difi=difi-theta_drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
- & +for_thet_constr(i)*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
- & +for_thet_constr(i)*difi**3
- else
- difi=0.0
- endif
-C if (energy_dec) then
-C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
-C & i,itheta,rad2deg*thetiii,
-C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
-C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
-C & gloc(itheta+nphi-2,icg)
-C endif
- enddo
- return
- end
-#endif
-#ifdef CRYST_SC
-c-----------------------------------------------------------------------------
- subroutine esc(escloc)
-C Calculate the local energy of a side chain and its derivatives in the
-C corresponding virtual-bond valence angles THETA and the spherical angles
-C ALPHA and OMEGA.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
- & ddersc0(3),ddummy(3),xtemp(3),temp(3)
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- delta=0.02d0*pi
- escloc=0.0D0
-c write (iout,'(a)') 'ESC'
- do i=loc_start,loc_end
- it=itype(i)
- if (it.eq.ntyp1) cycle
- if (it.eq.10) goto 1
- 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
- x(1)=dtan(theti)
- x(2)=alph(i)
- x(3)=omeg(i)
-c write (iout,*) "i",i," x",x(1),x(2),x(3)
-
- if (x(2).gt.pi-delta) then
- xtemp(1)=x(1)
- xtemp(2)=pi-delta
- xtemp(3)=x(3)
- call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
- xtemp(2)=pi
- call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
- call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
- & escloci,dersc(2))
- call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
- & ddersc0(1),dersc(1))
- call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
- & ddersc0(3),dersc(3))
- xtemp(2)=pi-delta
- call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
- xtemp(2)=pi
- call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
- call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
- & dersc0(2),esclocbi,dersc02)
- call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
- & dersc12,dersc01)
- call splinthet(x(2),0.5d0*delta,ss,ssd)
- dersc0(1)=dersc01
- dersc0(2)=dersc02
- dersc0(3)=0.0d0
- do k=1,3
- dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
- enddo
- dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
- escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c escloci=esclocbi
-c write (iout,*) escloci
- else if (x(2).lt.delta) then
- xtemp(1)=x(1)
- xtemp(2)=delta
- xtemp(3)=x(3)
- call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
- xtemp(2)=0.0d0
- call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
- call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
- & escloci,dersc(2))
- call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
- & ddersc0(1),dersc(1))
- call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
- & ddersc0(3),dersc(3))
- xtemp(2)=delta
- call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
- xtemp(2)=0.0d0
- call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
- call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
- & dersc0(2),esclocbi,dersc02)
- call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
- & dersc12,dersc01)
- dersc0(1)=dersc01
- dersc0(2)=dersc02
- dersc0(3)=0.0d0
- call splinthet(x(2),0.5d0*delta,ss,ssd)
- do k=1,3
- dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
- enddo
- dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
- escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c write (iout,*) escloci
- else
- call enesc(x,escloci,dersc,ddummy,.false.)
- endif
-
- escloc=escloc+escloci
-c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
-
- gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
- & wscloc*dersc(1)
- gloc(ialph(i,1),icg)=wscloc*dersc(2)
- gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
- 1 continue
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine enesc(x,escloci,dersc,ddersc,mixed)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
- double precision contr(maxlob,-1:1)
- logical mixed
-c write (iout,*) 'it=',it,' nlobit=',nlobit
- escloc_i=0.0D0
- do j=1,3
- dersc(j)=0.0D0
- if (mixed) ddersc(j)=0.0d0
- enddo
- x3=x(3)
-
-C Because of periodicity of the dependence of the SC energy in omega we have
-C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
-C To avoid underflows, first compute & store the exponents.
-
- do iii=-1,1
-
- x(3)=x3+iii*dwapi
-
- do j=1,nlobit
- do k=1,3
- z(k)=x(k)-censc(k,j,it)
- enddo
- do k=1,3
- Axk=0.0D0
- do l=1,3
- Axk=Axk+gaussc(l,k,j,it)*z(l)
- enddo
- Ax(k,j,iii)=Axk
- enddo
- expfac=0.0D0
- do k=1,3
- expfac=expfac+Ax(k,j,iii)*z(k)
- enddo
- contr(j,iii)=expfac
- enddo ! j
-
- enddo ! iii
-
- x(3)=x3
-C As in the case of ebend, we want to avoid underflows in exponentiation and
-C subsequent NaNs and INFs in energy calculation.
-C Find the largest exponent
- emin=contr(1,-1)
- do iii=-1,1
- do j=1,nlobit
- if (emin.gt.contr(j,iii)) emin=contr(j,iii)
- enddo
- enddo
- emin=0.5D0*emin
-cd print *,'it=',it,' emin=',emin
-
-C Compute the contribution to SC energy and derivatives
- do iii=-1,1
-
- do j=1,nlobit
- 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
- dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
- enddo
- if (mixed) then
- do k=1,3,2
- ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
- & +gaussc(k,2,j,it))*expfac
- enddo
- endif
- enddo
-
- enddo ! iii
-
- dersc(1)=dersc(1)/cos(theti)**2
- ddersc(1)=ddersc(1)/cos(theti)**2
- ddersc(3)=ddersc(3)
-
- escloci=-(dlog(escloc_i)-emin)
- do j=1,3
- dersc(j)=dersc(j)/escloc_i
- enddo
- if (mixed) then
- do j=1,3,2
- ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
- enddo
- endif
- return
- end
-C------------------------------------------------------------------------------
- subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- double precision x(3),z(3),Ax(3,maxlob),dersc(3)
- double precision contr(maxlob)
- logical mixed
-
- escloc_i=0.0D0
-
- do j=1,3
- dersc(j)=0.0D0
- enddo
-
- do j=1,nlobit
- do k=1,2
- z(k)=x(k)-censc(k,j,it)
- enddo
- z(3)=dwapi
- do k=1,3
- Axk=0.0D0
- do l=1,3
- Axk=Axk+gaussc(l,k,j,it)*z(l)
- enddo
- Ax(k,j)=Axk
- enddo
- expfac=0.0D0
- do k=1,3
- expfac=expfac+Ax(k,j)*z(k)
- enddo
- contr(j)=expfac
- enddo ! j
-
-C As in the case of ebend, we want to avoid underflows in exponentiation and
-C subsequent NaNs and INFs in energy calculation.
-C Find the largest exponent
- emin=contr(1)
- do j=1,nlobit
- if (emin.gt.contr(j)) emin=contr(j)
- enddo
- emin=0.5D0*emin
-
-C Compute the contribution to SC energy and derivatives
-
- dersc12=0.0d0
- do j=1,nlobit
- 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
- enddo
- if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
- & +gaussc(1,2,j,it))*expfac
- dersc(3)=0.0d0
- enddo
-
- dersc(1)=dersc(1)/cos(theti)**2
- dersc12=dersc12/cos(theti)**2
- escloci=-(dlog(escloc_i)-emin)
- do j=1,2
- dersc(j)=dersc(j)/escloc_i
- enddo
- if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
- return
- end
-#else
-c----------------------------------------------------------------------------------
- subroutine esc(escloc)
-C Calculate the local energy of a side chain and its derivatives in the
-C corresponding virtual-bond valence angles THETA and the spherical angles
-C ALPHA and OMEGA derived from AM1 all-atom calculations.
-C added by Urszula Kozlowska. 07/11/2007
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.SCROT'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- include 'COMMON.VECTORS'
- double precision x_prime(3),y_prime(3),z_prime(3)
- & , sumene,dsc_i,dp2_i,x(65),
- & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
- & de_dxx,de_dyy,de_dzz,de_dt
- double precision s1_t,s1_6_t,s2_t,s2_6_t
- double precision
- & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
- & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
- & dt_dCi(3),dt_dCi1(3)
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- delta=0.02d0*pi
- escloc=0.0D0
- do i=loc_start,loc_end
- if (itype(i).eq.ntyp1) cycle
- costtab(i+1) =dcos(theta(i+1))
- sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
- cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
- sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
- cosfac2=0.5d0/(1.0d0+costtab(i+1))
- cosfac=dsqrt(cosfac2)
- sinfac2=0.5d0/(1.0d0-costtab(i+1))
- sinfac=dsqrt(sinfac2)
- it=iabs(itype(i))
- if (it.eq.10) goto 1
-c
-C Compute the axes of tghe local cartesian coordinates system; store in
-c x_prime, y_prime and z_prime
-c
- do j=1,3
- x_prime(j) = 0.00
- y_prime(j) = 0.00
- z_prime(j) = 0.00
- enddo
-C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
-C & dc_norm(3,i+nres)
- do j = 1,3
- x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
- y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
- enddo
- do j = 1,3
- z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
- enddo
-c write (2,*) "i",i
-c write (2,*) "x_prime",(x_prime(j),j=1,3)
-c write (2,*) "y_prime",(y_prime(j),j=1,3)
-c write (2,*) "z_prime",(z_prime(j),j=1,3)
-c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
-c & " xy",scalar(x_prime(1),y_prime(1)),
-c & " xz",scalar(x_prime(1),z_prime(1)),
-c & " yy",scalar(y_prime(1),y_prime(1)),
-c & " yz",scalar(y_prime(1),z_prime(1)),
-c & " zz",scalar(z_prime(1),z_prime(1))
-c
-C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
-C to local coordinate system. Store in xx, yy, zz.
-c
- xx=0.0d0
- yy=0.0d0
- zz=0.0d0
- 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)
- enddo
-
- xxtab(i)=xx
- yytab(i)=yy
- zztab(i)=zz
-C
-C Compute the energy of the ith side cbain
-C
-c write (2,*) "xx",xx," yy",yy," zz",zz
- it=iabs(itype(i))
- do j = 1,65
- x(j) = sc_parmin(j,it)
- enddo
-#ifdef CHECK_COORD
-Cc diagnostics - remove later
- xx1 = dcos(alph(2))
- yy1 = dsin(alph(2))*dcos(omeg(2))
-c zz1 = -dsin(alph(2))*dsin(omeg(2))
- zz1 = -dsign(1.0d0,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
-C," --- ", xx_w,yy_w,zz_w
-c end diagnostics
-#endif
- sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
- & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
- & + x(10)*yy*zz
- sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
- & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
- & + x(20)*yy*zz
- sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
- & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
- & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
- & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
- & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
- & +x(40)*xx*yy*zz
- sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
- & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
- & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
- & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
- & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
- & +x(60)*xx*yy*zz
- dsc_i = 0.743d0+x(61)
- dp2_i = 1.9d0+x(62)
- dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
- dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
- s1=(1+x(63))/(0.1d0 + dscp1)
- s1_6=(1+x(64))/(0.1d0 + dscp1**6)
- s2=(1+x(65))/(0.1d0 + dscp2)
- s2_6=(1+x(65))/(0.1d0 + dscp2**6)
- sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
- & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
-c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
-c & sumene4,
-c & dscp1,dscp2,sumene
-c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- escloc = escloc + sumene
-c write (2,*) "escloc",escloc
- if (.not. calc_grad) goto 1
-#ifdef DEBUG
-C
-C This section to check the numerical derivatives of the energy of ith side
-C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
-C #define DEBUG in the code to turn it on.
-C
- write (2,*) "sumene =",sumene
- aincr=1.0d-7
- xxsave=xx
- xx=xx+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dxx_num=(sumenep-sumene)/aincr
- xx=xxsave
- write (2,*) "xx+ sumene from enesc=",sumenep
- yysave=yy
- yy=yy+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dyy_num=(sumenep-sumene)/aincr
- yy=yysave
- write (2,*) "yy+ sumene from enesc=",sumenep
- zzsave=zz
- zz=zz+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dzz_num=(sumenep-sumene)/aincr
- zz=zzsave
- write (2,*) "zz+ sumene from enesc=",sumenep
- costsave=cost2tab(i+1)
- sintsave=sint2tab(i+1)
- cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
- sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dt_num=(sumenep-sumene)/aincr
- write (2,*) " t+ sumene from enesc=",sumenep
- cost2tab(i+1)=costsave
- sint2tab(i+1)=sintsave
-C End of diagnostics section.
-#endif
-C
-C Compute the gradient of esc
-C
- pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
- pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
- pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
- pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
- pom_dx=dsc_i*dp2_i*cost2tab(i+1)
- pom_dy=dsc_i*dp2_i*sint2tab(i+1)
- pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
- pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
- pom1=(sumene3*sint2tab(i+1)+sumene1)
- & *(pom_s1/dscp1+pom_s16*dscp1**4)
- pom2=(sumene4*cost2tab(i+1)+sumene2)
- & *(pom_s2/dscp2+pom_s26*dscp2**4)
- sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
- sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
- & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
- & +x(40)*yy*zz
- sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
- sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
- & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
- & +x(60)*yy*zz
- de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
- & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
- & +(pom1+pom2)*pom_dx
-#ifdef DEBUG
- write(2,*), "de_dxx = ", de_dxx,de_dxx_num
-#endif
-C
- sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
- sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
- & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
- & +x(40)*xx*zz
- sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
- sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
- & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
- & +x(59)*zz**2 +x(60)*xx*zz
- de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
- & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
- & +(pom1-pom2)*pom_dy
-#ifdef DEBUG
- write(2,*), "de_dyy = ", de_dyy,de_dyy_num
-#endif
-C
- de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
- & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
- & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
- & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
- & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
- & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
- & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
- & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
-#ifdef DEBUG
- write(2,*), "de_dzz = ", de_dzz,de_dzz_num
-#endif
-C
- de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
- & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
- & +pom1*pom_dt1+pom2*pom_dt2
-#ifdef DEBUG
- write(2,*), "de_dt = ", de_dt,de_dt_num
-#endif
-c
-C
- cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
- cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
- cosfac2xx=cosfac2*xx
- sinfac2yy=sinfac2*yy
- do k = 1,3
- dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
- & vbld_inv(i+1)
- dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
- & vbld_inv(i)
- pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
- pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
-c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
-c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
-c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
-c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
- dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
- dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
- dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
- dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
- dZZ_Ci1(k)=0.0d0
- dZZ_Ci(k)=0.0d0
- do j=1,3
- dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
- & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
- dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
- & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
- enddo
-
- dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
- dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
- dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
-c
- dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
- dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
- enddo
-
- do k=1,3
- dXX_Ctab(k,i)=dXX_Ci(k)
- dXX_C1tab(k,i)=dXX_Ci1(k)
- dYY_Ctab(k,i)=dYY_Ci(k)
- dYY_C1tab(k,i)=dYY_Ci1(k)
- dZZ_Ctab(k,i)=dZZ_Ci(k)
- dZZ_C1tab(k,i)=dZZ_Ci1(k)
- dXX_XYZtab(k,i)=dXX_XYZ(k)
- dYY_XYZtab(k,i)=dYY_XYZ(k)
- dZZ_XYZtab(k,i)=dZZ_XYZ(k)
- enddo
-
- do k = 1,3
-c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
-c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
-c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
-c & dyy_ci(k)," dzz_ci",dzz_ci(k)
-c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
-c & dt_dci(k)
-c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
-c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
- gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
- & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
- gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
- & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
- gsclocx(k,i)= de_dxx*dxx_XYZ(k)
- & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
- enddo
-c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
-c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
-
-C to check gradient call subroutine check_grad
-
- 1 continue
- enddo
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
-C
-C This procedure calculates two-body contact function g(rij) and its derivative:
-C
-C eps0ij ! x < -1
-C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
-C 0 ! x > 1
-C
-C where x=(rij-r0ij)/delta
-C
-C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
-C
- implicit none
- double precision rij,r0ij,eps0ij,fcont,fprimcont
- double precision x,x2,x4,delta
-c delta=0.02D0*r0ij
-c delta=0.2D0*r0ij
- x=(rij-r0ij)/delta
- if (x.lt.-1.0D0) then
- fcont=eps0ij
- fprimcont=0.0D0
- else if (x.le.1.0D0) then
- x2=x*x
- x4=x2*x2
- fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
- fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
- else
- fcont=0.0D0
- fprimcont=0.0D0
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine splinthet(theti,delta,ss,ssder)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- thetup=pi-delta
- thetlow=delta
- if (theti.gt.pipol) then
- call gcont(theti,thetup,1.0d0,delta,ss,ssder)
- else
- call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
- ssder=-ssder
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
- implicit none
- double precision x,x0,delta,f0,f1,fprim0,f,fprim
- double precision ksi,ksi2,ksi3,a1,a2,a3
- a1=fprim0*delta/(f1-f0)
- a2=3.0d0-2.0d0*a1
- a3=a1-2.0d0
- ksi=(x-x0)/delta
- ksi2=ksi*ksi
- ksi3=ksi2*ksi
- f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
- fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
- return
- end
-c------------------------------------------------------------------------------
- subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
- implicit none
- double precision x,x0,delta,f0x,f1x,fprim0x,fx
- double precision ksi,ksi2,ksi3,a1,a2,a3
- ksi=(x-x0)/delta
- ksi2=ksi*ksi
- ksi3=ksi2*ksi
- a1=fprim0x*delta
- a2=3*(f1x-f0x)-2*fprim0x*delta
- a3=fprim0x*delta-2*(f1x-f0x)
- fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
- return
- end
-C-----------------------------------------------------------------------------
-#ifdef CRYST_TOR
-C-----------------------------------------------------------------------------
- subroutine etor(etors,edihcnstr,fact)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors=0.0D0
- do i=iphi_start,iphi_end
- if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
- & .or. itype(i).eq.ntyp1) cycle
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- phii=phi(i)
- gloci=0.0D0
-C Proline-Proline pair is a special case...
- if (itori.eq.3 .and. itori1.eq.3) then
- if (phii.gt.-dwapi3) then
- cosphi=dcos(3*phii)
- fac=1.0D0/(1.0D0-cosphi)
- etorsi=v1(1,3,3)*fac
- etorsi=etorsi+etorsi
- etors=etors+etorsi-v1(1,3,3)
- gloci=gloci-3*fac*etorsi*dsin(3*phii)
- endif
- do j=1,3
- v1ij=v1(j+1,itori,itori1)
- v2ij=v2(j+1,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- else
- do j=1,nterm_old
- v1ij=v1(j,itori,itori1)
- v2ij=v2(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- endif
- 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)
- gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
-c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
- enddo
-! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
- do i=1,ndih_constr
- itori=idih_constr(i)
- phii=phi(itori)
- difi=phii-phi0(i)
- if (difi.gt.drange(i)) then
- difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
- endif
-! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
-! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
- enddo
-! write (iout,*) 'edihcnstr',edihcnstr
- return
- end
-c------------------------------------------------------------------------------
-#else
- subroutine etor(etors,edihcnstr,fact)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors=0.0D0
- do i=iphi_start,iphi_end
- if (i.le.2) cycle
- if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
- & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
- 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,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
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
-C Lorentz terms
-C v1
-C E = SUM ----------------------------------- - v1
-C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
-C
- cosphi=dcos(0.5d0*phii)
- sinphi=dsin(0.5d0*phii)
- do j=1,nlor(itori,itori1,iblock)
- vl1ij=vlor1(j,itori,itori1)
- vl2ij=vlor2(j,itori,itori1)
- vl3ij=vlor3(j,itori,itori1)
- pom=vl2ij*cosphi+vl3ij*sinphi
- pom1=1.0d0/(pom*pom+1.0d0)
- etors=etors+vl1ij*pom1
- pom=-pom*pom1*pom1
- gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
- enddo
-C Subtract the constant term
- 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,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
- enddo
-! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
- do i=1,ndih_constr
- itori=idih_constr(i)
- phii=phi(itori)
- difi=pinorm(phii-phi0(i))
- edihi=0.0d0
- if (difi.gt.drange(i)) then
- difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
- edihi=0.25d0*ftors(i)*difi**4
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
- edihi=0.25d0*ftors(i)*difi**4
- else
- difi=0.0d0
- endif
-c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
-c & drange(i),edihi
-! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
-! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
- enddo
-! write (iout,*) 'edihcnstr',edihcnstr
- return
- end
-c----------------------------------------------------------------------------
- subroutine etor_d(etors_d,fact2)
-C 6/23/01 Compute double torsional energy
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors_d=0.0D0
- do i=iphi_start,iphi_end-1
- if (i.le.3) cycle
- if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
- & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
- & (itype(i+1).eq.ntyp1)) cycle
- if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
- & goto 1215
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- itori2=itortyp(itype(i))
- 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,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)
- sinphi2=dsin(j*phii1)
- etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
- & v2cij*cosphi2+v2sij*sinphi2
- 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 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)
- cosphi1p2=dcos(l*phii+(k-l)*phii1)
- cosphi1m2=dcos(l*phii-(k-l)*phii1)
- sinphi1p2=dsin(l*phii+(k-l)*phii1)
- sinphi1m2=dsin(l*phii-(k-l)*phii1)
- etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
- & v1sdij*sinphi1p2+v2sdij*sinphi1m2
- gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
- & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
- gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
- & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
- enddo
- enddo
- gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
- gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
- 1215 continue
- enddo
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine eback_sc_corr(esccor)
-c 7/21/2007 Correlations between the backbone-local and side-chain-local
-c conformational states; temporarily implemented as differences
-c between UNRES torsional potentials (dependent on three types of
-c residues) and the torsional potentials dependent on all 20 types
-c of residues computed from AM1 energy surfaces of terminally-blocked
-c amino-acid residues.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.SCCOR'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
-c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
- esccor=0.0D0
- do i=itau_start,itau_end
- if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
- esccor_ii=0.0D0
- isccori=isccortyp(itype(i-2))
- isccori1=isccortyp(itype(i-1))
- phii=phi(i)
- do intertyp=1,3 !intertyp
-cc Added 09 May 2012 (Adasko)
-cc Intertyp means interaction type of backbone mainchain correlation:
-c 1 = SC...Ca...Ca...Ca
-c 2 = Ca...Ca...Ca...SC
-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.ntyp1).or.
- & (itype(i-1).eq.ntyp1)))
- & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
- & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
- & .or.(itype(i).eq.ntyp1)))
- & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
- & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
- & (itype(i-3).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)
- v2ij=v2sccor(j,intertyp,isccori,isccori1)
- cosphi=dcos(j*tauangle(intertyp,i))
- sinphi=dsin(j*tauangle(intertyp,i))
- esccor=esccor+v1ij*cosphi+v2ij*sinphi
-c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
-c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
-c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
- 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,
- & (v1sccor(j,1,itori,itori1),j=1,6),
- & (v2sccor(j,1,itori,itori1),j=1,6)
- gsccor_loc(i-3)=gloci
- enddo !intertyp
- enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine multibody(ecorr)
-C This subroutine calculates multi-body contributions to energy following
-C the idea of Skolnick et al. If side chains I and J make a contact and
-C at the same time side chains I+1 and J+1 make a contact, an extra
-C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
-
-C Set lprn=.true. for debugging
- lprn=.false.
-
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(i2,20(1x,i2,f10.5))')
- & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
- enddo
- endif
- ecorr=0.0D0
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
- do i=nnt,nct-2
-
- DO ISHIFT = 3,4
-
- i1=i+ishift
- num_conti=num_cont(i)
- num_conti1=num_cont(i1)
- do jj=1,num_conti
- j=jcont(jj,i)
- do kk=1,num_conti1
- j1=jcont(kk,i1)
- if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
-cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-cd & ' ishift=',ishift
-C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
-C The system gains extra energy.
- ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
- endif ! j1==j+-ishift
- enddo ! kk
- enddo ! jj
-
- ENDDO ! ISHIFT
-
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
- double precision function esccorr(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
- lprn=.false.
- eij=facont(jj,i)
- ekl=facont(kk,k)
-cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
-C Calculate the multi-body contribution to energy.
-C Calculate multi-body contributions to the gradient.
-cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
-cd & k,l,(gacont(m,kk,k),m=1,3)
- do m=1,3
- gx(m) =ekl*gacont(m,jj,i)
- gx1(m)=eij*gacont(m,kk,k)
- gradxorr(m,i)=gradxorr(m,i)-gx(m)
- gradxorr(m,j)=gradxorr(m,j)+gx(m)
- gradxorr(m,k)=gradxorr(m,k)-gx1(m)
- gradxorr(m,l)=gradxorr(m,l)+gx1(m)
- enddo
- do m=i,j-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
- enddo
- enddo
- do m=k,l-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
- enddo
- enddo
- esccorr=-eij*ekl
- return
- end
-c------------------------------------------------------------------------------
-#ifdef MPL
- subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- integer dimen1,dimen2,atom,indx
- double precision buffer(dimen1,dimen2)
- double precision zapas
- common /contacts_hb/ zapas(3,20,maxres,7),
- & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
- & num_cont_hb(maxres),jcont_hb(20,maxres)
- num_kont=num_cont_hb(atom)
- do i=1,num_kont
- do k=1,7
- do j=1,3
- buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
- enddo ! j
- enddo ! k
- buffer(i,indx+22)=facont_hb(i,atom)
- buffer(i,indx+23)=ees0p(i,atom)
- buffer(i,indx+24)=ees0m(i,atom)
- buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
- enddo ! i
- buffer(1,indx+26)=dfloat(num_kont)
- return
- end
-c------------------------------------------------------------------------------
- subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- integer dimen1,dimen2,atom,indx
- double precision buffer(dimen1,dimen2)
- double precision zapas
- common /contacts_hb/ zapas(3,ntyp,maxres,7),
- & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
- & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
- num_kont=buffer(1,indx+26)
- num_kont_old=num_cont_hb(atom)
- num_cont_hb(atom)=num_kont+num_kont_old
- do i=1,num_kont
- ii=i+num_kont_old
- do k=1,7
- do j=1,3
- zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
- enddo ! j
- enddo ! k
- facont_hb(ii,atom)=buffer(i,indx+22)
- ees0p(ii,atom)=buffer(i,indx+23)
- ees0m(ii,atom)=buffer(i,indx+24)
- jcont_hb(ii,atom)=buffer(i,indx+25)
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
-#endif
- subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
-C This subroutine calculates multi-body contributions to hydrogen-bonding
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
-#ifdef MPL
- include 'COMMON.INFO'
-#endif
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
-#ifdef MPL
- parameter (max_cont=maxconts)
- parameter (max_dim=2*(8*3+2))
- parameter (msglen1=max_cont*max_dim*4)
- parameter (msglen2=2*msglen1)
- integer source,CorrelType,CorrelID,Error
- double precision buffer(max_cont,max_dim)
-#endif
- double precision gx(3),gx1(3)
- logical lprn,ldone
-
-C Set lprn=.true. for debugging
- lprn=.false.
-#ifdef MPL
- n_corr=0
- n_corr1=0
- if (fgProcs.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
-C Caution! Following code assumes that electrostatic interactions concerning
-C a given atom are split among at most two processors!
- CorrelType=477
- CorrelID=MyID+1
- ldone=.false.
- do i=1,max_cont
- do j=1,max_dim
- buffer(i,j)=0.0D0
- enddo
- enddo
- mm=mod(MyRank,2)
-cd write (iout,*) 'MyRank',MyRank,' mm',mm
- if (mm) 20,20,10
- 10 continue
-cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
- if (MyRank.gt.0) then
-C Send correlation contributions to the preceding processor
- msglen=msglen1
- nn=num_cont_hb(iatel_s)
- call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
-cd write (iout,*) 'The BUFFER array:'
-cd do i=1,nn
-cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
-cd enddo
- if (ielstart(iatel_s).gt.iatel_s+ispp) then
- msglen=msglen2
- call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
-C Clear the contacts of the atom passed to the neighboring processor
- nn=num_cont_hb(iatel_s+1)
-cd do i=1,nn
-cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
-cd enddo
- num_cont_hb(iatel_s)=0
- endif
-cd write (iout,*) 'Processor ',MyID,MyRank,
-cd & ' is sending correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen
-cd write (*,*) 'Processor ',MyID,MyRank,
-cd & ' is sending correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen,' CorrelType=',CorrelType
- call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
-cd write (iout,*) 'Processor ',MyID,
-cd & ' has sent correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen,' CorrelID=',CorrelID
-cd write (*,*) 'Processor ',MyID,
-cd & ' has sent correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen,' CorrelID=',CorrelID
- msglen=msglen1
- endif ! (MyRank.gt.0)
- if (ldone) goto 30
- ldone=.true.
- 20 continue
-cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
- if (MyRank.lt.fgProcs-1) then
-C Receive correlation contributions from the next processor
- msglen=msglen1
- if (ielend(iatel_e).lt.nct-1) msglen=msglen2
-cd write (iout,*) 'Processor',MyID,
-cd & ' is receiving correlation contribution from processor',MyID+1,
-cd & ' msglen=',msglen,' CorrelType=',CorrelType
-cd write (*,*) 'Processor',MyID,
-cd & ' is receiving correlation contribution from processor',MyID+1,
-cd & ' msglen=',msglen,' CorrelType=',CorrelType
- nbytes=-1
- do while (nbytes.le.0)
- call mp_probe(MyID+1,CorrelType,nbytes)
- enddo
-cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
- call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
-cd write (iout,*) 'Processor',MyID,
-cd & ' has received correlation contribution from processor',MyID+1,
-cd & ' msglen=',msglen,' nbytes=',nbytes
-cd write (iout,*) 'The received BUFFER array:'
-cd do i=1,max_cont
-cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
-cd enddo
- if (msglen.eq.msglen1) then
- call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
- else if (msglen.eq.msglen2) then
- call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
- call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
- else
- write (iout,*)
- & 'ERROR!!!! message length changed while processing correlations.'
- write (*,*)
- & 'ERROR!!!! message length changed while processing correlations.'
- call mp_stopall(Error)
- endif ! msglen.eq.msglen1
- endif ! MyRank.lt.fgProcs-1
- if (ldone) goto 30
- ldone=.true.
- goto 10
- 30 continue
-#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- ecorr=0.0D0
-C Remove the loop below after debugging !!!
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
-C Calculate the local-electrostatic correlation terms
- do i=iatel_s,iatel_e+1
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1 .or. j1.eq.j-1) then
-C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
-C The system gains extra energy.
- ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
-C Contacts I-J and I-(J+1) occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
-C Contacts I-J and (I+1)-J occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
- subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
- & n_corr1)
-C This subroutine calculates multi-body contributions to hydrogen-bonding
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
-#ifdef MPL
- include 'COMMON.INFO'
-#endif
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
-#ifdef MPL
- parameter (max_cont=maxconts)
- parameter (max_dim=2*(8*3+2))
- parameter (msglen1=max_cont*max_dim*4)
- parameter (msglen2=2*msglen1)
- integer source,CorrelType,CorrelID,Error
- double precision buffer(max_cont,max_dim)
-#endif
- double precision gx(3),gx1(3)
- logical lprn,ldone
-
-C Set lprn=.true. for debugging
- lprn=.false.
- eturn6=0.0d0
-#ifdef MPL
- n_corr=0
- n_corr1=0
- if (fgProcs.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
-C Caution! Following code assumes that electrostatic interactions concerning
-C a given atom are split among at most two processors!
- CorrelType=477
- CorrelID=MyID+1
- ldone=.false.
- do i=1,max_cont
- do j=1,max_dim
- buffer(i,j)=0.0D0
- enddo
- enddo
- mm=mod(MyRank,2)
-cd write (iout,*) 'MyRank',MyRank,' mm',mm
- if (mm) 20,20,10
- 10 continue
-cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
- if (MyRank.gt.0) then
-C Send correlation contributions to the preceding processor
- msglen=msglen1
- nn=num_cont_hb(iatel_s)
- call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
-cd write (iout,*) 'The BUFFER array:'
-cd do i=1,nn
-cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
-cd enddo
- if (ielstart(iatel_s).gt.iatel_s+ispp) then
- msglen=msglen2
- call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
-C Clear the contacts of the atom passed to the neighboring processor
- nn=num_cont_hb(iatel_s+1)
-cd do i=1,nn
-cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
-cd enddo
- num_cont_hb(iatel_s)=0
- endif
-cd write (iout,*) 'Processor ',MyID,MyRank,
-cd & ' is sending correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen
-cd write (*,*) 'Processor ',MyID,MyRank,
-cd & ' is sending correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen,' CorrelType=',CorrelType
- call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
-cd write (iout,*) 'Processor ',MyID,
-cd & ' has sent correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen,' CorrelID=',CorrelID
-cd write (*,*) 'Processor ',MyID,
-cd & ' has sent correlation contribution to processor',MyID-1,
-cd & ' msglen=',msglen,' CorrelID=',CorrelID
- msglen=msglen1
- endif ! (MyRank.gt.0)
- if (ldone) goto 30
- ldone=.true.
- 20 continue
-cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
- if (MyRank.lt.fgProcs-1) then
-C Receive correlation contributions from the next processor
- msglen=msglen1
- if (ielend(iatel_e).lt.nct-1) msglen=msglen2
-cd write (iout,*) 'Processor',MyID,
-cd & ' is receiving correlation contribution from processor',MyID+1,
-cd & ' msglen=',msglen,' CorrelType=',CorrelType
-cd write (*,*) 'Processor',MyID,
-cd & ' is receiving correlation contribution from processor',MyID+1,
-cd & ' msglen=',msglen,' CorrelType=',CorrelType
- nbytes=-1
- do while (nbytes.le.0)
- call mp_probe(MyID+1,CorrelType,nbytes)
- enddo
-cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
- call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
-cd write (iout,*) 'Processor',MyID,
-cd & ' has received correlation contribution from processor',MyID+1,
-cd & ' msglen=',msglen,' nbytes=',nbytes
-cd write (iout,*) 'The received BUFFER array:'
-cd do i=1,max_cont
-cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
-cd enddo
- if (msglen.eq.msglen1) then
- call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
- else if (msglen.eq.msglen2) then
- call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
- call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
- else
- write (iout,*)
- & 'ERROR!!!! message length changed while processing correlations.'
- write (*,*)
- & 'ERROR!!!! message length changed while processing correlations.'
- call mp_stopall(Error)
- endif ! msglen.eq.msglen1
- endif ! MyRank.lt.fgProcs-1
- if (ldone) goto 30
- ldone=.true.
- goto 10
- 30 continue
-#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- ecorr=0.0D0
- ecorr5=0.0d0
- ecorr6=0.0d0
-C Remove the loop below after debugging !!!
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
-C Calculate the dipole-dipole interaction energies
- if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
- do i=iatel_s,iatel_e+1
- num_conti=num_cont_hb(i)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- call dipole(i,j,jj)
- enddo
- enddo
- endif
-C Calculate the local-electrostatic correlation terms
- do i=iatel_s,iatel_e+1
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
-c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1 .or. j1.eq.j-1) then
-C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
-C The system gains extra energy.
- n_corr=n_corr+1
- sqd1=dsqrt(d_cont(jj,i))
- sqd2=dsqrt(d_cont(kk,i1))
- sred_geom = sqd1*sqd2
- IF (sred_geom.lt.cutoff_corr) THEN
- call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
- & ekont,fprimcont)
-c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- fac_prim1=0.5d0*sqd2/sqd1*fprimcont
- fac_prim2=0.5d0*sqd1/sqd2*fprimcont
- do l=1,3
- g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
- g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
- enddo
- n_corr1=n_corr1+1
-cd write (iout,*) 'sred_geom=',sred_geom,
-cd & ' ekont=',ekont,' fprim=',fprimcont
- call calc_eello(i,j,i+1,j1,jj,kk)
- if (wcorr4.gt.0.0d0)
- & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
- if (wcorr5.gt.0.0d0)
- & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
-c print *,"wcorr5",ecorr5
-cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
-cd write(2,*)'ijkl',i,j,i+1,j1
- if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
- & .or. wturn6.eq.0.0d0))then
-cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
- ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
-cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
-cd & 'ecorr6=',ecorr6
-cd write (iout,'(4e15.5)') sred_geom,
-cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
-cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
-cd & dabs(eello6(i,j,i+1,j1,jj,kk))
- else if (wturn6.gt.0.0d0
- & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
-cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
- eturn6=eturn6+eello_turn6(i,jj,kk)
-cd write (2,*) 'multibody_eello:eturn6',eturn6
- endif
- ENDIF
-1111 continue
- else if (j1.eq.j) then
-C Contacts I-J and I-(J+1) occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
-C Contacts I-J and (I+1)-J occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
- double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.SHIELD'
-
- double precision gx(3),gx1(3)
- logical lprn
- lprn=.false.
- eij=facont_hb(jj,i)
- ekl=facont_hb(kk,k)
- ees0pij=ees0p(jj,i)
- ees0pkl=ees0p(kk,k)
- ees0mij=ees0m(jj,i)
- ees0mkl=ees0m(kk,k)
- ekont=eij*ekl
- ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
-cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
-C Following 4 lines for diagnostics.
-cd ees0pkl=0.0D0
-cd ees0pij=1.0D0
-cd ees0mkl=0.0D0
-cd ees0mij=1.0D0
-c write (iout,*)'Contacts have occurred for peptide groups',i,j,
-c & ' and',k,l
-c write (iout,*)'Contacts have occurred for peptide groups',
-c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
-c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
-C Calculate the multi-body contribution to energy.
- ecorr=ecorr+ekont*ees
- if (calc_grad) then
-C Calculate multi-body contributions to the gradient.
- do ll=1,3
- ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
- gradcorr(ll,i)=gradcorr(ll,i)+ghalf
- & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
- & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
- gradcorr(ll,j)=gradcorr(ll,j)+ghalf
- & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
- & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
- ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
- gradcorr(ll,k)=gradcorr(ll,k)+ghalf
- & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
- & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
- gradcorr(ll,l)=gradcorr(ll,l)+ghalf
- & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
- & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
- enddo
- do m=i+1,j-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+
- & ees*ekl*gacont_hbr(ll,jj,i)-
- & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
- & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
- enddo
- enddo
- do m=k+1,l-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+
- & ees*eij*gacont_hbr(ll,kk,k)-
- & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
- & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
- enddo
- enddo
- if (shield_mode.gt.0) then
- j=ees0plist(jj,i)
- l=ees0plist(kk,k)
-C print *,i,j,fac_shield(i),fac_shield(j),
-C &fac_shield(k),fac_shield(l)
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
- & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
-C & *2.0
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
- & rlocshield
- & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
- &+rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
-C & *2.0
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
- & rlocshield
- & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
- & +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(k)
- iresshield=shield_list(ilist,k)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
-C & *2.0
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
- & rlocshield
- & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
- & +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(l)
- iresshield=shield_list(ilist,l)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
-C & *2.0
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
- & rlocshield
- & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
- & +rlocshield
- enddo
- enddo
-C print *,gshieldx(m,iresshield)
- do m=1,3
- gshieldc_ec(m,i)=gshieldc_ec(m,i)+
- & grad_shield(m,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,j)=gshieldc_ec(m,j)+
- & grad_shield(m,j)*ehbcorr/fac_shield(j)
- gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
- & grad_shield(m,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
- & grad_shield(m,j)*ehbcorr/fac_shield(j)
-
- gshieldc_ec(m,k)=gshieldc_ec(m,k)+
- & grad_shield(m,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,l)=gshieldc_ec(m,l)+
- & grad_shield(m,l)*ehbcorr/fac_shield(l)
- gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
- & grad_shield(m,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
- & grad_shield(m,l)*ehbcorr/fac_shield(l)
-
- enddo
- endif
- endif
- endif
- ehbcorr=ekont*ees
- return
- end
-C---------------------------------------------------------------------------
- subroutine dipole(i,j,jj)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
- & auxmat(2,2)
- iti1 = itortyp(itype(i+1))
- if (j.lt.nres-1) then
- if (itype(j).le.ntyp) then
- itj1 = itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- else
- itj1=ntortyp+1
- endif
- do iii=1,2
- dipi(iii,1)=Ub2(iii,i)
- dipderi(iii)=Ub2der(iii,i)
- dipi(iii,2)=b1(iii,iti1)
- dipj(iii,1)=Ub2(iii,j)
- dipderj(iii)=Ub2der(iii,j)
- dipj(iii,2)=b1(iii,itj1)
- enddo
- kkk=0
- do iii=1,2
- call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
- do jjj=1,2
- kkk=kkk+1
- dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
- enddo
- if (.not.calc_grad) return
- do kkk=1,5
- do lll=1,3
- mmm=0
- do iii=1,2
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
- & auxvec(1))
- do jjj=1,2
- mmm=mmm+1
- dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
- enddo
- enddo
- enddo
- call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
- call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
- do iii=1,2
- dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
- enddo
- call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
- do iii=1,2
- dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine calc_eello(i,j,k,l,jj,kk)
-C
-C This subroutine computes matrices and vectors needed to calculate
-C the fourth-, fifth-, and sixth-order local-electrostatic terms.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
- & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
- logical lprn
- common /kutas/ lprn
-cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
-cd & ' jj=',jj,' kk=',kk
-cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
- do iii=1,2
- do jjj=1,2
- aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
- aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
- enddo
- enddo
- call transpose2(aa1(1,1),aa1t(1,1))
- call transpose2(aa2(1,1),aa2t(1,1))
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
- & aa1tder(1,1,lll,kkk))
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
- & aa2tder(1,1,lll,kkk))
- enddo
- enddo
- if (l.eq.j+1) then
-C parallel orientation of the two CA-CA-CA frames.
-c if (i.gt.1) then
- if (i.gt.1 .and. itype(i).le.ntyp) then
- iti=itortyp(itype(i))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1))
- itj=itortyp(itype(j))
-c if (l.lt.nres-1) then
- if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-C A1 kernel(j+1) A2T
-cd do iii=1,2
-cd write (iout,'(3f10.5,5x,3f10.5)')
-cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
-cd enddo
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
- & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
- & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
- & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
- & ADtEAderx(1,1,1,1,1,1))
- lprn=.false.
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
- & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
- & ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-C End 6-th order cumulants
-cd lprn=.false.
-cd if (lprn) then
-cd write (2,*) 'In calc_eello6'
-cd do iii=1,2
-cd write (2,*) 'iii=',iii
-cd do kkk=1,5
-cd write (2,*) 'kkk=',kkk
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
-cd enddo
-cd enddo
-cd enddo
-cd endif
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & EAEAderx(1,1,lll,kkk,iii,1))
- enddo
- enddo
- enddo
-C A1T kernel(i+1) A2
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
- & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
- & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
- & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
- & ADtEAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
- & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
- & ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
- enddo
-C AEAb1 and AEAb2
-C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-C They are needed only when the fifth- or the sixth-order cumulants are
-C indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
-C Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),
- & AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),
- & AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
- & AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),
- & AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),
- & AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
- & AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
- & AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-C End vectors
- else
-C Antiparallel orientation of the two CA-CA-CA frames.
-c if (i.gt.1) then
- if (i.gt.1 .and. itype(i).le.ntyp) then
- iti=itortyp(itype(i))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
-c if (j.lt.nres-1) then
- if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
-C A2 kernel(j-1)T A1T
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
- & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
- & j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
- & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
- & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
- & ADtEAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
- & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
- & ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & EAEAderx(1,1,lll,kkk,iii,1))
- enddo
- enddo
- enddo
-C A2T kernel(i+1)T A1
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
- & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
- & j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
- & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
- & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
- & ADtEAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
- & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
- & ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
- enddo
-C AEAb1 and AEAb2
-C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-C They are needed only when the fifth- or the sixth-order cumulants are
-C indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
- & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
-C Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),
- & AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),
- & AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
- & AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),
- & AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),
- & AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
- & AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
- & AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-C End vectors
- endif
- return
- end
-C---------------------------------------------------------------------------
- subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
- & KK,KKderg,AKA,AKAderg,AKAderx)
- implicit none
- integer nderg
- logical transp
- double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
- & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
- & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
- integer iii,kkk,lll
- integer jjj,mmm
- logical lprn
- common /kutas/ lprn
- call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
- do iii=1,nderg
- call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
- & AKAderg(1,1,iii))
- enddo
-cd if (lprn) write (2,*) 'In kernel'
- do kkk=1,5
-cd if (lprn) write (2,*) 'kkk=',kkk
- do lll=1,3
- call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
- & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
-cd if (lprn) then
-cd write (2,*) 'lll=',lll
-cd write (2,*) 'iii=1'
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
-cd enddo
-cd endif
- call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
- & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
-cd if (lprn) then
-cd write (2,*) 'lll=',lll
-cd write (2,*) 'iii=2'
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
-cd enddo
-cd endif
- enddo
- enddo
- return
- end
-C---------------------------------------------------------------------------
- double precision function eello4(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision pizda(2,2),ggg1(3),ggg2(3)
-cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
-cd eello4=0.0d0
-cd return
-cd endif
-cd print *,'eello4:',i,j,k,l,jj,kk
-cd write (2,*) 'i',i,' j',j,' k',k,' l',l
-cd call checkint4(i,j,k,l,jj,kk,eel4_num)
-cold eij=facont_hb(jj,i)
-cold ekl=facont_hb(kk,k)
-cold ekont=eij*ekl
- eel4=-EAEA(1,1,1)-EAEA(2,2,1)
- if (calc_grad) then
-cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
- gcorr_loc(k-1)=gcorr_loc(k-1)
- & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
- if (l.eq.j+1) then
- gcorr_loc(l-1)=gcorr_loc(l-1)
- & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- else
- gcorr_loc(j-1)=gcorr_loc(j-1)
- & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
- & -EAEAderx(2,2,lll,kkk,iii,1)
-cd derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd gcorr_loc(l-1)=0.0d0
-cd gcorr_loc(j-1)=0.0d0
-cd gcorr_loc(k-1)=0.0d0
-cd eel4=1.0d0
-cd write (iout,*)'Contacts have occurred for peptide groups',
-cd & i,j,' fcont:',eij,' eij',' and ',k,l,
-cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
- ggg1(ll)=eel4*g_contij(ll,1)
- ggg2(ll)=eel4*g_contij(ll,2)
- ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
- gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
- gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
-cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
- ghalf=0.5d0*ggg2(ll)
-cd ghalf=0.0d0
- gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
- gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
- gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
- enddo
-cd goto 1112
- do m=i+1,j-1
- do ll=1,3
-cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
- gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
- enddo
- enddo
- do m=k+1,l-1
- do ll=1,3
-cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
- gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
- enddo
- enddo
-1112 continue
- do m=i+2,j2
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
- enddo
- enddo
- do m=k+2,l2
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
- enddo
- enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,gcorr_loc(iii)
-cd enddo
- endif
- eello4=ekont*eel4
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello4',ekont*eel4
- return
- end
-C---------------------------------------------------------------------------
- double precision function eello5(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
- double precision ggg1(3),ggg2(3)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel chains C
-C C
-C o o o o C
-C /l\ / \ \ / \ / \ / C
-C / \ / \ \ / \ / \ / C
-C j| o |l1 | o | o| o | | o |o C
-C \ |/k\| |/ \| / |/ \| |/ \| C
-C \i/ \ / \ / / \ / \ C
-C o k1 o C
-C (I) (II) (III) (IV) C
-C C
-C eello5_1 eello5_2 eello5_3 eello5_4 C
-C C
-C Antiparallel chains C
-C C
-C o o o o C
-C /j\ / \ \ / \ / \ / C
-C / \ / \ \ / \ / \ / C
-C j1| o |l | o | o| o | | o |o C
-C \ |/k\| |/ \| / |/ \| |/ \| C
-C \i/ \ / \ / / \ / \ C
-C o k1 o C
-C (I) (II) (III) (IV) C
-C C
-C eello5_1 eello5_2 eello5_3 eello5_4 C
-C C
-C o denotes a local interaction, vertical lines an electrostatic interaction. C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
-cd eello5=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
- itk=itortyp(itype(k))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
- eello5_1=0.0d0
- eello5_2=0.0d0
- eello5_3=0.0d0
- eello5_4=0.0d0
-cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
-cd & eel5_3_num,eel5_4_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=facont_hb(jj,i)
-cd ekl=facont_hb(kk,k)
-cd ekont=eij*ekl
-cd write (iout,*)'Contacts have occurred for peptide groups',
-cd & i,j,' fcont:',eij,' eij',' and ',k,l
-cd goto 1111
-C Contribution from the graph I.
-cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
-cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
- if (calc_grad) then
-C Explicit gradient in virtual-dihedral angles.
- if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- if (l.eq.j+1) then
- if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- else
- if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- endif
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
- enddo
- enddo
- enddo
-c goto 1112
- endif
-c1111 continue
-C Contribution from graph II
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k))
- if (calc_grad) then
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- if (l.eq.j+1) then
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- else
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- endif
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k))
- enddo
- enddo
- enddo
-cd goto 1112
- endif
-cd1111 continue
- if (l.eq.j+1) then
-cd goto 1110
-C Parallel orientation
-C Contribution from graph III
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
- if (calc_grad) then
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
- call transpose2(EUgder(1,1,l),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
- enddo
- enddo
- enddo
-cd goto 1112
- endif
-C Contribution from graph IV
-cd1110 continue
- call transpose2(EE(1,1,itl),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l))
- if (calc_grad) then
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l))
- enddo
- enddo
- enddo
- endif
- else
-C Antiparallel orientation
-C Contribution from graph III
-c goto 1110
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
- if (calc_grad) then
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
- call transpose2(EUgder(1,1,j),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
- enddo
- enddo
- enddo
-cd goto 1112
- endif
-C Contribution from graph IV
-1110 continue
- call transpose2(EE(1,1,itj),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j))
- if (calc_grad) then
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j))
- enddo
- enddo
- enddo
- endif
- endif
-1112 continue
- eel5=eello5_1+eello5_2+eello5_3+eello5_4
-cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
-cd write (2,*) 'ijkl',i,j,k,l
-cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
-cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
-cd endif
-cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
-cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
-cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
-cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
- if (calc_grad) then
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
-cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
- do ll=1,3
- ggg1(ll)=eel5*g_contij(ll,1)
- ggg2(ll)=eel5*g_contij(ll,2)
-cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
- ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
- gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
- gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
-cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
- ghalf=0.5d0*ggg2(ll)
-cd ghalf=0.0d0
- gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
- gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
- gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
- enddo
-cd goto 1112
- do m=i+1,j-1
- do ll=1,3
-cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
- gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
- enddo
- enddo
- do m=k+1,l-1
- do ll=1,3
-cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
- gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
- enddo
- enddo
-c1112 continue
- do m=i+2,j2
- do ll=1,3
- gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
- enddo
- enddo
- do m=k+2,l2
- do ll=1,3
- gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
- enddo
- enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr5_loc(iii)
-cd enddo
- endif
- eello5=ekont*eel5
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello5',ekont*eel5
- return
- end
-c--------------------------------------------------------------------------
- double precision function eello6(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision ggg1(3),ggg2(3)
-cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-cd eello6=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
- eello6_1=0.0d0
- eello6_2=0.0d0
- eello6_3=0.0d0
- eello6_4=0.0d0
- eello6_5=0.0d0
- eello6_6=0.0d0
-cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
-cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=facont_hb(jj,i)
-cd ekl=facont_hb(kk,k)
-cd ekont=eij*ekl
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
- if (l.eq.j+1) then
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(j,i,l,k,2,.false.)
- eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
- eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
- else
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(l,k,j,i,2,.true.)
- eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
- else
- eello6_5=0.0d0
- endif
- eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
- endif
-C If turn contributions are considered, they will be handled separately.
- eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
-cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
-cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
-cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
-cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
-cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
-cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
-cd goto 1112
- if (calc_grad) then
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
- ggg1(ll)=eel6*g_contij(ll,1)
- ggg2(ll)=eel6*g_contij(ll,2)
-cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
- ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
- gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
- gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
- ghalf=0.5d0*ggg2(ll)
-cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
-cd ghalf=0.0d0
- gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
- gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
- gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
- enddo
-cd goto 1112
- do m=i+1,j-1
- do ll=1,3
-cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
- gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
- enddo
- enddo
- do m=k+1,l-1
- do ll=1,3
-cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
- gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
- enddo
- enddo
-1112 continue
- do m=i+2,j2
- do ll=1,3
- gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
- enddo
- enddo
- do m=k+2,l2
- do ll=1,3
- gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
- enddo
- enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr6_loc(iii)
-cd enddo
- endif
- eello6=ekont*eel6
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello6',ekont*eel6
- return
- end
-c--------------------------------------------------------------------------
- double precision function eello6_graph1(i,j,k,l,imat,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
- logical swap
- logical lprn
- common /kutas/ lprn
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ /j\ C
-C / \ / \ C
-C /| o | | o |\ C
-C \ j|/k\| / \ |/k\|l / C
-C \ / \ / \ / \ / C
-C o o o o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- itk=itortyp(itype(k))
- s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
- eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
- if (.not. calc_grad) return
- if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
- & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
- & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
- & +scalar2(vv(1),Dtobr2der(1,i)))
- call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
- if (l.eq.j+1) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)
- & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
- & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)
- & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
- & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- endif
- call transpose2(EUgCder(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
- & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
- & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
- do iii=1,2
- if (swap) then
- ind=3-iii
- else
- ind=iii
- endif
- do kkk=1,5
- do lll=1,3
- s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
- & pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
- & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
- vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
- & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
- derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- logical swap
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
- & auxvec1(2),auxvec2(2),auxmat1(2,2)
- logical lprn
- common /kutas/ lprn
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C \ /l\ /j\ / C
-C \ / \ / \ / C
-C o| o | | o |o C
-C \ j|/k\| \ |/k\|l C
-C \ / \ \ / \ C
-C o o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
-C AL 7/4/01 s1 would occur in the sixth-order moment,
-C but not in a cluster cumulant
-#ifdef MOMENT
- s1=dip(1,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph2=-(s1+s2+s3+s4)
-#else
- eello6_graph2=-(s2+s3+s4)
-#endif
-c eello6_graph2=-s3
- if (.not. calc_grad) return
-C Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- s1=dipderg(1,jj,i)*dip(1,kk,k)
-#endif
- s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
-c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
- endif
-C Derivatives in gamma(k-1)
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
-c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
-C Derivatives in gamma(j-1) or gamma(l-1)
- if (j.gt.1) then
-#ifdef MOMENT
- s1=dipderg(3,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
- call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
-c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
- endif
-C Derivatives in gamma(l-1) or gamma(j-1)
- if (l.gt.1) then
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(3,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- else
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
-c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
- endif
-C Cartesian derivatives.
- if (lprn) then
- write (2,*) 'In eello6_graph2'
- do iii=1,2
- write (2,*) 'iii=',iii
- do kkk=1,5
- write (2,*) 'kkk=',kkk
- do jjj=1,2
- write (2,'(3(2f10.5),5x)')
- & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
- enddo
- enddo
- enddo
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
- else
- s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
- endif
-#endif
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
- & auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
- & auxvec(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
- logical swap
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ / \ /j\ C
-C / \ / \ / \ C
-C /| o |o o| o |\ C
-C j|/k\| / |/k\|l / C
-C / \ / / \ / C
-C / o / o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C 4/7/01 AL Component s1 was removed, because it pertains to the respective
-C energy moment and not to the cluster cumulant.
- iti=itortyp(itype(i))
-c if (j.lt.nres-1) then
- if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
-c if (l.lt.nres-1) then
- if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-#ifdef MOMENT
- s1=dip(4,jj,i)*dip(4,kk,k)
-#endif
- call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph3=-(s1+s2+s3+s4)
-#else
- eello6_graph3=-(s2+s3+s4)
-#endif
-c eello6_graph3=-s4
- if (.not. calc_grad) return
-C Derivatives in gamma(k-1)
- call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
-C Derivatives in gamma(l-1)
- call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
-C Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
- else
- s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
- & auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
-c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
- & auxvec1(2),auxmat1(2,2)
- logical swap
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ / \ /j\ C
-C / \ / \ / \ C
-C /| o |o o| o |\ C
-C \ j|/k\| \ |/k\|l C
-C \ / \ \ / \ C
-C o \ o \ C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C 4/7/01 AL Component s1 was removed, because it pertains to the respective
-C energy moment and not to the cluster cumulant.
-cd write (2,*) 'eello_graph4: wturn6',wturn6
- iti=itortyp(itype(i))
- itj=itortyp(itype(j))
-c if (j.lt.nres-1) then
- if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k))
-c if (k.lt.nres-1) then
- if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
- itk1=itortyp(itype(k+1))
- else
- itk1=ntortyp+1
- endif
- itl=itortyp(itype(l))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
-cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
-cd & ' itl',itl,' itl1',itl1
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dip(3,kk,k)
- else
- s1=dip(2,jj,j)*dip(2,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph4=-(s1+s2+s3+s4)
-#else
- eello6_graph4=-(s2+s3+s4)
-#endif
- if (.not. calc_grad) return
-C Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dipderg(2,jj,i)*dip(3,kk,k)
- else
- s1=dipderg(4,jj,j)*dip(2,kk,l)
- endif
-#endif
- s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-cd write (2,*) 'turn6 derivatives'
-#ifdef MOMENT
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
-#endif
- else
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
- endif
- endif
-C Derivatives in gamma(k-1)
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderg(2,kk,k)
- else
- s1=dip(2,jj,j)*dipderg(4,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
-#endif
- else
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
- endif
-C Derivatives in gamma(j-1) or gamma(l-1)
- if (l.eq.j+1 .and. l.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
- else if (j.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
- gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
- endif
- endif
-C Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- if (imat.eq.1) then
- s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
- else
- s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
- endif
- else
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
- else
- s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
- endif
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
- & auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
- & b1(1,itj1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
- else
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
- & b1(1,itl1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
- endif
- call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (swap) then
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
- & -(s1+s2+s4)
-#else
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
- & -(s2+s4)
-#endif
- derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
- else
-#ifdef MOMENT
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
-#endif
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
- else
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (l.eq.j+1) then
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- endif
- endif
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello_turn6(i,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizesclu.dat'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
- & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
- & ggg1(3),ggg2(3)
- double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
- & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
-C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
-C the respective energy moment and not to the cluster cumulant.
- eello_turn6=0.0d0
- j=i+4
- k=i+1
- l=i+3
- iti=itortyp(itype(i))
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
-cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
-cd write (2,*) 'i',i,' k',k,' j',j,' l',l
-cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-cd eello6=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
-cd call checkint_turn6(i,jj,kk,eel_turn6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx_turn(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
-cd eello6_5=0.0d0
-cd write (2,*) 'eello6_5',eello6_5
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
- ss1=scalar2(Ub2(1,i+2),b1(1,itl))
- s1 = (auxmat(1,1)+auxmat(2,2))*ss1
-#else
- s1 = 0.0d0
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
- s2 = scalar2(b1(1,itk),vtemp1(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atemp(1,1))
- call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
- call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
- s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#else
- s8=0.0d0
-#endif
- call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
- s12 = scalar2(Ub2(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
- call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
- call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
- ss13 = scalar2(b1(1,itk),vtemp4(1))
- s13 = (gtemp(1,1)+gtemp(2,2))*ss13
-#else
- s13=0.0d0
-#endif
-c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
-c s1=0.0d0
-c s2=0.0d0
-c s8=0.0d0
-c s12=0.0d0
-c s13=0.0d0
- eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
- if (calc_grad) then
-C Derivatives in gamma(i+2)
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
- call transpose2(AEAderg(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#else
- s8d=0.0d0
-#endif
- call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
- gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
-C Derivatives in gamma(i+3)
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
-#else
- s1d=0.0d0
-#endif
- call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
- s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
-#endif
- s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#else
- s13d=0.0d0
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
- & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
- & -0.5d0*ekont*(s2d+s12d)
-#endif
-C Derivatives in gamma(i+4)
- call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#else
- s13d = 0.0d0
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-C s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
-#else
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
-#endif
-C Derivatives in gamma(i+5)
-#ifdef MOMENT
- call transpose2(AEAderg(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#else
- s1d = 0.0d0
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#else
- s8d = 0.0d0
-#endif
- call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
-#else
- s13d = 0.0d0
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
- & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
- & -0.5d0*ekont*(s2d+s12d)
-#endif
-C Cartesian derivatives
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#else
- s1d = 0.0d0
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
- & vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*
- & scalar2(cc(1,1,itl),vtemp2(1))
-#else
- s8d = 0.0d0
-#endif
- call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
- & auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
- & - 0.5d0*(s1d+s2d)
-#else
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
- & - 0.5d0*s2d
-#endif
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
- & - 0.5d0*(s8d+s12d)
-#else
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
- & - 0.5d0*s12d
-#endif
- enddo
- enddo
- enddo
-#ifdef MOMENT
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
- & achuj_tempd(1,1))
- call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d=(gtempd(1,1)+gtempd(2,2))*ss13
- derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
- & vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
- derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
- enddo
- enddo
-#endif
-cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
-cd & 16*eel_turn6_num
-cd goto 1112
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
- ggg1(ll)=eel_turn6*g_contij(ll,1)
- ggg2(ll)=eel_turn6*g_contij(ll,2)
- ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
- & +ekont*derx_turn(ll,2,1)
- gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
- gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
- & +ekont*derx_turn(ll,4,1)
- gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
- ghalf=0.5d0*ggg2(ll)
-cd ghalf=0.0d0
- gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
- & +ekont*derx_turn(ll,2,2)
- gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
- gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
- & +ekont*derx_turn(ll,4,2)
- gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
- enddo
-cd goto 1112
- do m=i+1,j-1
- do ll=1,3
- gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
- enddo
- enddo
- do m=k+1,l-1
- do ll=1,3
- gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
- enddo
- enddo
-1112 continue
- do m=i+2,j2
- do ll=1,3
- gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
- enddo
- enddo
- do m=k+2,l2
- do ll=1,3
- gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
- enddo
- enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr6_loc(iii)
-cd enddo
- endif
- eello_turn6=ekont*eel_turn6
-cd write (2,*) 'ekont',ekont
-cd write (2,*) 'eel_turn6',ekont*eel_turn6
- return
- end
-crc-------------------------------------------------
- SUBROUTINE MATVEC2(A1,V1,V2)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A1(2,2),V1(2),V2(2)
-c DO 1 I=1,2
-c VI=0.0
-c DO 3 K=1,2
-c 3 VI=VI+A1(I,K)*V1(K)
-c Vaux(I)=VI
-c 1 CONTINUE
-
- vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
- vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
-
- v2(1)=vaux1
- v2(2)=vaux2
- END
-C---------------------------------------
- SUBROUTINE MATMAT2(A1,A2,A3)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A1(2,2),A2(2,2),A3(2,2)
-c DIMENSION AI3(2,2)
-c DO J=1,2
-c A3IJ=0.0
-c DO K=1,2
-c A3IJ=A3IJ+A1(I,K)*A2(K,J)
-c enddo
-c A3(I,J)=A3IJ
-c enddo
-c enddo
-
- ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
- ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
- ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
- ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
-
- A3(1,1)=AI3_11
- A3(2,1)=AI3_21
- A3(1,2)=AI3_12
- A3(2,2)=AI3_22
- END
-
-c-------------------------------------------------------------------------
- double precision function scalar2(u,v)
- implicit none
- double precision u(2),v(2)
- double precision sc
- integer i
- scalar2=u(1)*v(1)+u(2)*v(2)
- return
- end
-
-C-----------------------------------------------------------------------------
-
- subroutine transpose2(a,at)
- implicit none
- double precision a(2,2),at(2,2)
- at(1,1)=a(1,1)
- at(1,2)=a(2,1)
- at(2,1)=a(1,2)
- at(2,2)=a(2,2)
- return
- end
-c--------------------------------------------------------------------------
- subroutine transpose(n,a,at)
- implicit none
- integer n,i,j
- double precision a(n,n),at(n,n)
- do i=1,n
- do j=1,n
- at(j,i)=a(i,j)
- enddo
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine prodmat3(a1,a2,kk,transp,prod)
- implicit none
- integer i,j
- double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
- logical transp
-crc double precision auxmat(2,2),prod_(2,2)
-
- if (transp) then
-crc call transpose2(kk(1,1),auxmat(1,1))
-crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
-crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
- & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
- & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
- & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
- & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
-
- else
-crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
-crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
- & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
- & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
- & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
- & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
-
- endif
-c call transpose2(a2(1,1),a2t(1,1))
-
-crc print *,transp
-crc print *,((prod_(i,j),i=1,2),j=1,2)
-crc print *,((prod(i,j),i=1,2),j=1,2)
-
- return
- end
-C-----------------------------------------------------------------------------
- double precision function scalar(u,v)
- implicit none
- double precision u(3),v(3)
- double precision sc
- integer i
- sc=0.0d0
- do i=1,3
- sc=sc+u(i)*v(i)
- enddo
- scalar=sc
- return
- end
-C-----------------------------------------------------------------------
- double precision function sscale(r)
- double precision r,gamm
- include "COMMON.SPLITELE"
- if(r.lt.r_cut-rlamb) then
- sscale=1.0d0
- else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
- gamm=(r-(r_cut-rlamb))/rlamb
- sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
- else
- sscale=0d0
- endif
- return
- end
-C-----------------------------------------------------------------------
-C-----------------------------------------------------------------------
- double precision function sscagrad(r)
- double precision r,gamm
- include "COMMON.SPLITELE"
- if(r.lt.r_cut-rlamb) then
- sscagrad=0.0d0
- else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
- gamm=(r-(r_cut-rlamb))/rlamb
- sscagrad=gamm*(6*gamm-6.0d0)/rlamb
- else
- sscagrad=0.0d0
- endif
- return
- end
-C-----------------------------------------------------------------------
-C first for shielding is setting of function of side-chains
- subroutine set_shield_fac2
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.SHIELD'
- include 'COMMON.INTERACT'
-C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
- double precision div77_81/0.974996043d0/,
- &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
-
-C the vector between center of side_chain and peptide group
- double precision pep_side(3),long,side_calf(3),
- &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
- &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
-C the line belowe needs to be changed for FGPROC>1
- do i=1,nres-1
- if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
- ishield_list(i)=0
-Cif there two consequtive dummy atoms there is no peptide group between them
-C the line below has to be changed for FGPROC>1
- VolumeTotal=0.0
- do k=1,nres
- if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
- dist_pep_side=0.0
- dist_side_calf=0.0
- do j=1,3
-C first lets set vector conecting the ithe side-chain with kth side-chain
- pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
-C pep_side(j)=2.0d0
-C and vector conecting the side-chain with its proper calfa
- side_calf(j)=c(j,k+nres)-c(j,k)
-C side_calf(j)=2.0d0
- pept_group(j)=c(j,i)-c(j,i+1)
-C lets have their lenght
- dist_pep_side=pep_side(j)**2+dist_pep_side
- dist_side_calf=dist_side_calf+side_calf(j)**2
- dist_pept_group=dist_pept_group+pept_group(j)**2
- enddo
- dist_pep_side=dsqrt(dist_pep_side)
- dist_pept_group=dsqrt(dist_pept_group)
- dist_side_calf=dsqrt(dist_side_calf)
- do j=1,3
- pep_side_norm(j)=pep_side(j)/dist_pep_side
- side_calf_norm(j)=dist_side_calf
- enddo
-C now sscale fraction
- sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
-C print *,buff_shield,"buff"
-C now sscale
- if (sh_frac_dist.le.0.0) cycle
-C If we reach here it means that this side chain reaches the shielding sphere
-C Lets add him to the list for gradient
- ishield_list(i)=ishield_list(i)+1
-C ishield_list is a list of non 0 side-chain that contribute to factor gradient
-C this list is essential otherwise problem would be O3
- shield_list(ishield_list(i),i)=k
-C Lets have the sscale value
- if (sh_frac_dist.gt.1.0) then
- scale_fac_dist=1.0d0
- do j=1,3
- sh_frac_dist_grad(j)=0.0d0
- enddo
- else
- scale_fac_dist=-sh_frac_dist*sh_frac_dist
- & *(2.0d0*sh_frac_dist-3.0d0)
- fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
- & /dist_pep_side/buff_shield*0.5d0
-C remember for the final gradient multiply sh_frac_dist_grad(j)
-C for side_chain by factor -2 !
- do j=1,3
- sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
-C sh_frac_dist_grad(j)=0.0d0
-C scale_fac_dist=1.0d0
-C print *,"jestem",scale_fac_dist,fac_help_scale,
-C & sh_frac_dist_grad(j)
- enddo
- endif
-C this is what is now we have the distance scaling now volume...
- short=short_r_sidechain(itype(k))
- long=long_r_sidechain(itype(k))
- costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
- sinthet=short/dist_pep_side*costhet
-C now costhet_grad
-C costhet=0.6d0
-C sinthet=0.8
- costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
-C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
-C & -short/dist_pep_side**2/costhet)
-C costhet_fac=0.0d0
- do j=1,3
- costhet_grad(j)=costhet_fac*pep_side(j)
- enddo
-C remember for the final gradient multiply costhet_grad(j)
-C for side_chain by factor -2 !
-C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
-C pep_side0pept_group is vector multiplication
- pep_side0pept_group=0.0d0
- do j=1,3
- pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
- enddo
- cosalfa=(pep_side0pept_group/
- & (dist_pep_side*dist_side_calf))
- fac_alfa_sin=1.0d0-cosalfa**2
- fac_alfa_sin=dsqrt(fac_alfa_sin)
- rkprim=fac_alfa_sin*(long-short)+short
-C rkprim=short
-
-C now costhet_grad
- cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
-C cosphi=0.6
- cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
- sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
- & dist_pep_side**2)
-C sinphi=0.8
- do j=1,3
- cosphi_grad_long(j)=cosphi_fac*pep_side(j)
- &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
- &*(long-short)/fac_alfa_sin*cosalfa/
- &((dist_pep_side*dist_side_calf))*
- &((side_calf(j))-cosalfa*
- &((pep_side(j)/dist_pep_side)*dist_side_calf))
-C cosphi_grad_long(j)=0.0d0
- cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
- &*(long-short)/fac_alfa_sin*cosalfa
- &/((dist_pep_side*dist_side_calf))*
- &(pep_side(j)-
- &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
-C cosphi_grad_loc(j)=0.0d0
- enddo
-C print *,sinphi,sinthet
- VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
- & /VSolvSphere_div
-C & *wshield
-C now the gradient...
- do j=1,3
- grad_shield(j,i)=grad_shield(j,i)
-C gradient po skalowaniu
- & +(sh_frac_dist_grad(j)*VofOverlap
-C gradient po costhet
- & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
- &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
- & sinphi/sinthet*costhet*costhet_grad(j)
- & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
- & )*wshield
-C grad_shield_side is Cbeta sidechain gradient
- grad_shield_side(j,ishield_list(i),i)=
- & (sh_frac_dist_grad(j)*-2.0d0
- & *VofOverlap
- & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
- &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
- & sinphi/sinthet*costhet*costhet_grad(j)
- & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
- & )*wshield
-
- grad_shield_loc(j,ishield_list(i),i)=
- & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
- &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
- & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
- & ))
- & *wshield
- enddo
- VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
- enddo
- fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
-C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
- enddo
- return
- end
-C first for shielding is setting of function of side-chains
- subroutine set_shield_fac
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.SHIELD'
- include 'COMMON.INTERACT'
-C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
- double precision div77_81/0.974996043d0/,
- &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
-
-C the vector between center of side_chain and peptide group
- double precision pep_side(3),long,side_calf(3),
- &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
- &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
-C the line belowe needs to be changed for FGPROC>1
- do i=1,nres-1
- if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
- ishield_list(i)=0
-Cif there two consequtive dummy atoms there is no peptide group between them
-C the line below has to be changed for FGPROC>1
- VolumeTotal=0.0
- do k=1,nres
- if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
- dist_pep_side=0.0
- dist_side_calf=0.0
- do j=1,3
-C first lets set vector conecting the ithe side-chain with kth side-chain
- pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
-C pep_side(j)=2.0d0
-C and vector conecting the side-chain with its proper calfa
- side_calf(j)=c(j,k+nres)-c(j,k)
-C side_calf(j)=2.0d0
- pept_group(j)=c(j,i)-c(j,i+1)
-C lets have their lenght
- dist_pep_side=pep_side(j)**2+dist_pep_side
- dist_side_calf=dist_side_calf+side_calf(j)**2
- dist_pept_group=dist_pept_group+pept_group(j)**2
- enddo
- dist_pep_side=dsqrt(dist_pep_side)
- dist_pept_group=dsqrt(dist_pept_group)
- dist_side_calf=dsqrt(dist_side_calf)
- do j=1,3
- pep_side_norm(j)=pep_side(j)/dist_pep_side
- side_calf_norm(j)=dist_side_calf
- enddo
-C now sscale fraction
- sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
-C print *,buff_shield,"buff"
-C now sscale
- if (sh_frac_dist.le.0.0) cycle
-C If we reach here it means that this side chain reaches the shielding sphere
-C Lets add him to the list for gradient
- ishield_list(i)=ishield_list(i)+1
-C ishield_list is a list of non 0 side-chain that contribute to factor gradient
-C this list is essential otherwise problem would be O3
- shield_list(ishield_list(i),i)=k
-C Lets have the sscale value
- if (sh_frac_dist.gt.1.0) then
- scale_fac_dist=1.0d0
- do j=1,3
- sh_frac_dist_grad(j)=0.0d0
- enddo
- else
- scale_fac_dist=-sh_frac_dist*sh_frac_dist
- & *(2.0*sh_frac_dist-3.0d0)
- fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
- & /dist_pep_side/buff_shield*0.5
-C remember for the final gradient multiply sh_frac_dist_grad(j)
-C for side_chain by factor -2 !
- do j=1,3
- sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
-C print *,"jestem",scale_fac_dist,fac_help_scale,
-C & sh_frac_dist_grad(j)
- enddo
- endif
-C if ((i.eq.3).and.(k.eq.2)) then
-C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
-C & ,"TU"
-C endif
-
-C this is what is now we have the distance scaling now volume...
- short=short_r_sidechain(itype(k))
- long=long_r_sidechain(itype(k))
- costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
-C now costhet_grad
-C costhet=0.0d0
- costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
-C costhet_fac=0.0d0
- do j=1,3
- costhet_grad(j)=costhet_fac*pep_side(j)
- enddo
-C remember for the final gradient multiply costhet_grad(j)
-C for side_chain by factor -2 !
-C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
-C pep_side0pept_group is vector multiplication
- pep_side0pept_group=0.0
- do j=1,3
- pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
- enddo
- cosalfa=(pep_side0pept_group/
- & (dist_pep_side*dist_side_calf))
- fac_alfa_sin=1.0-cosalfa**2
- fac_alfa_sin=dsqrt(fac_alfa_sin)
- rkprim=fac_alfa_sin*(long-short)+short
-C now costhet_grad
- cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
- cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
-
- do j=1,3
- cosphi_grad_long(j)=cosphi_fac*pep_side(j)
- &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
- &*(long-short)/fac_alfa_sin*cosalfa/
- &((dist_pep_side*dist_side_calf))*
- &((side_calf(j))-cosalfa*
- &((pep_side(j)/dist_pep_side)*dist_side_calf))
-
- cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
- &*(long-short)/fac_alfa_sin*cosalfa
- &/((dist_pep_side*dist_side_calf))*
- &(pep_side(j)-
- &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
- enddo
-
- VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
- & /VSolvSphere_div
- & *wshield
-C now the gradient...
-C grad_shield is gradient of Calfa for peptide groups
-C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
-C & costhet,cosphi
-C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
-C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
- do j=1,3
- grad_shield(j,i)=grad_shield(j,i)
-C gradient po skalowaniu
- & +(sh_frac_dist_grad(j)
-C gradient po costhet
- &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
- &-scale_fac_dist*(cosphi_grad_long(j))
- &/(1.0-cosphi) )*div77_81
- &*VofOverlap
-C grad_shield_side is Cbeta sidechain gradient
- grad_shield_side(j,ishield_list(i),i)=
- & (sh_frac_dist_grad(j)*-2.0d0
- & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
- & +scale_fac_dist*(cosphi_grad_long(j))
- & *2.0d0/(1.0-cosphi))
- & *div77_81*VofOverlap
-
- grad_shield_loc(j,ishield_list(i),i)=
- & scale_fac_dist*cosphi_grad_loc(j)
- & *2.0d0/(1.0-cosphi)
- & *div77_81*VofOverlap
- enddo
- VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
- enddo
- fac_shield(i)=VolumeTotal*div77_81+div4_81
-C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
- enddo
- return
- end
-C--------------------------------------------------------------------------
-C-----------------------------------------------------------------------
- double precision function sscalelip(r)
- double precision r,gamm
- include "COMMON.SPLITELE"
-C if(r.lt.r_cut-rlamb) then
-C sscale=1.0d0
-C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
-C gamm=(r-(r_cut-rlamb))/rlamb
- sscalelip=1.0d0+r*r*(2*r-3.0d0)
-C else
-C sscale=0d0
-C endif
- return
- end
-C-----------------------------------------------------------------------
- double precision function sscagradlip(r)
- double precision r,gamm
- include "COMMON.SPLITELE"
-C if(r.lt.r_cut-rlamb) then
-C sscagrad=0.0d0
-C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
-C gamm=(r-(r_cut-rlamb))/rlamb
- sscagradlip=r*(6*r-6.0d0)
-C else
-C sscagrad=0.0d0
-C endif
- return
- end
-
-C-----------------------------------------------------------------------
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- subroutine Eliptransfer(eliptran)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- include 'COMMON.SPLITELE'
- include 'COMMON.SBRIDGE'
-C this is done by Adasko
-C print *,"wchodze"
-C structure of box:
-C water
-C--bordliptop-- buffore starts
-C--bufliptop--- here true lipid starts
-C lipid
-C--buflipbot--- lipid ends buffore starts
-C--bordlipbot--buffore ends
- eliptran=0.0
- write(iout,*) "I am in?"
- do i=1,nres
-C do i=1,1
- if (itype(i).eq.ntyp1) cycle
-
- positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
-C print *,i
-C first for peptide groups
-c for each residue check if it is in lipid or lipid water border area
- if ((positi.gt.bordlipbot)
- &.and.(positi.lt.bordliptop)) then
-C the energy transfer exist
- if (positi.lt.buflipbot) then
-C what fraction I am in
- fracinbuf=1.0d0-
- & ((positi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
-C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
-C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
-C print *, "doing sscalefor top part"
-C print *,i,sslip,fracinbuf,ssgradlip
- else
- eliptran=eliptran+pepliptran
-C print *,"I am in true lipid"
- endif
-C else
-C eliptran=elpitran+0.0 ! I am in water
- endif
- enddo
-C print *, "nic nie bylo w lipidzie?"
-C now multiply all by the peptide group transfer factor
-C eliptran=eliptran*pepliptran
-C now the same for side chains
-CV do i=1,1
- do i=1,nres
- if (itype(i).eq.ntyp1) cycle
- positi=(mod(c(3,i+nres),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
-C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
-c for each residue check if it is in lipid or lipid water border area
-C respos=mod(c(3,i+nres),boxzsize)
-C print *,positi,bordlipbot,buflipbot
- if ((positi.gt.bordlipbot)
- & .and.(positi.lt.bordliptop)) then
-C the energy transfer exist
- if (positi.lt.buflipbot) then
- fracinbuf=1.0d0-
- & ((positi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i))
- gliptranx(3,i)=gliptranx(3,i)
- &+ssgradlip*liptranene(itype(i))
- gliptranc(3,i-1)= gliptranc(3,i-1)
- &+ssgradlip*liptranene(itype(i))
-C print *,"doing sccale for lower part"
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0-
- &((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i))
- gliptranx(3,i)=gliptranx(3,i)
- &+ssgradlip*liptranene(itype(i))
- gliptranc(3,i-1)= gliptranc(3,i-1)
- &+ssgradlip*liptranene(itype(i))
-C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- eliptran=eliptran+liptranene(itype(i))
-C print *,"I am in true lipid"
- endif
- endif ! if in lipid or buffor
-C else
-C eliptran=elpitran+0.0 ! I am in water
- enddo
- return
- end
-C-------------------------------------------------------------------------------------
+++ /dev/null
-gfortran -O -c -I. -Iinclude_unres -I/users/software/mpich2-1.0.7/include readpdb.f
-cc -o compinfo compinfo.c
-./compinfo | true
-gfortran -O -c -I. -Iinclude_unres -I/users/software/mpich2-1.0.7/include cinfo.f
-gfortran -O main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o setup_var.o read_ref_str.o gnmr1.o permut.o -L/users/software/mpich2-1.0.7/lib -lmpich -lpthread xdrf/libxdrf.a -o ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_NEWCORR.exe
-readrtns.o: In function `molread_':
-readrtns.F:(.text+0x498f): relocation truncated to fit: R_X86_64_PC32 against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x49c6): relocation truncated to fit: R_X86_64_PC32 against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x49e9): relocation truncated to fit: R_X86_64_32S against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4a06): relocation truncated to fit: R_X86_64_32S against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4a23): relocation truncated to fit: R_X86_64_32S against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4a40): relocation truncated to fit: R_X86_64_32S against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4ae2): relocation truncated to fit: R_X86_64_PC32 against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4b40): relocation truncated to fit: R_X86_64_32S against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4b5d): relocation truncated to fit: R_X86_64_32S against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4b7a): relocation truncated to fit: R_X86_64_32S against symbol `torcnstr_' defined in COMMON section in readrtns.o
-readrtns.F:(.text+0x4b97): additional relocation overflows omitted from the output
-energy_p_new.o: In function `egb_':
-energy_p_new.F:(.text+0xfc29): undefined reference to `dyn_ssbond_ene_'
-energy_p_new.F:(.text+0xfca0): undefined reference to `triple_ssbond_ene_'
-energy_p_new.o: In function `etotal_':
-energy_p_new.F:(.text+0x118fd): undefined reference to `dyn_set_nss_'
-collect2: ld returned 1 exit status
-make: *** [NEWCORR] Error 1
EEold(2,2,-i)=-b(10,i)+b(11,i)
EEold(2,1,-i)=-b(12,i)+b(13,i)
EEold(1,2,-i)=-b(12,i)-b(13,i)
-c write(iout,*) "TU DOCHODZE"
-c print *,"JESTEM"
+ write(iout,*) "TU DOCHODZE"
+ print *,"JESTEM"
c ee(1,1,i)=1.0d0
c ee(2,2,i)=1.0d0
c ee(2,1,i)=0.0d0
c
c FP - Nov. 2014 Temporary specifications for new vars
c
- double precision rescore_tmp,x12,y12,z12,rescore2_tmp,
- & rescore3_tmp
+ double precision rescore_tmp,x12,y12,z12,rescore2_tmp
double precision, dimension (max_template,maxres) :: rescore
double precision, dimension (max_template,maxres) :: rescore2
- double precision, dimension (max_template,maxres) :: rescore3
character*24 tpl_k_rescore
c -----------------------------------------------------------------
c Reading multiple PDB ref structures and calculation of retraints
do irec=nnt,nct ! loop for reading res sim
if (read2sigma) then
read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp,
- & rescore3_tmp,idomain_tmp
+ & idomain_tmp
i_tmp=i_tmp+nnt-1
idomain(k,i_tmp)=idomain_tmp
rescore(k,i_tmp)=rescore_tmp
rescore2(k,i_tmp)=rescore2_tmp
- rescore3(k,i_tmp)=rescore3_tmp
- write(iout,'(a7,i5,3f10.5,i5)') "rescore",
+ write(iout,'(a7,i5,2f10.5,i5)') "rescore",
& i_tmp,rescore2_tmp,rescore_tmp,
- & rescore3_tmp,idomain_tmp
+ & idomain_tmp
else
idomain(k,irec)=1
read (ientin,*,end=1401) rescore_tmp
c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i)
c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i)
c write(iout,*) "rescore(",k,i,") =",rescore(k,i)
- sigma_d(k,i)=rescore3(k,i) ! right expression ?
+ sigma_d(k,i)=rescore(k,i) ! right expression ?
if (sigma_d(k,i).ne.0)
& sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
- real*8 dihang,etot,bvar,bene,rene,rvar,avedif,difmin,
- & ebmin,ebmax,ebmaxt,cutdif,dij,dihang_in
+ double precision dihang,etot,bvar,bene,rene,rvar,avedif,difmin,
+ & ebmin,ebmax,ebmaxt,cutdif,dij,dihang_in,difcut,dele,rmscut,
+ & pnccut,rmsn,pncn,brmsn,rrmsn,bpncn,rpncn,parent,dihang_in2
integer ibank,is,jbank,ibmin,ibmax,nbank,nconf,iuse,nstep,icycle,
& iseed,ntbank,ntbankm,iref,nconf_in,indb,ilastnstep,
- & bvar_nss,bvar_ss,bvar_ns,bvar_s,
- & nss_in,iss_in,jss_in,nadd
+ & bvar_nss,bvar_ss,bvar_ns,bvar_s,movenx,movernx,nstatnx,
+ & nstatnx_tot,nss_in,iss_in,jss_in,nadd,nss_out,iss_out,jss_out,
+ & isend2,iff_in,idata
common/varin/dihang_in(mxang,maxres,mxch,mxio),nss_in(mxio),
& iss_in(maxss,mxio),jss_in(maxss,mxio)
common/minvar/dihang(mxang,maxres,mxch,mxio),etot(mxio),rmsn(mxio)
integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc,
& nres0,nstart_seq,nchain,chain_length,chain_border,iprzes,
- & ireschain,tabpermchain,npermchain,afmend,afmbeg
+ & chain_border1,ireschain,tabpermchain,npermchain,afmend,afmbeg
double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r,
& prod,rt,dc_work,cref,crefjlee,dc_norm2,velAFMconst,
& totTafm,chomo
& nsup,nstart_sup,nstart_seq,iprzes,
& chain_length(maxchain),npermchain,ireschain(maxres),
& tabpermchain(maxchain,maxperm),
- & chain_border(2,maxchain),nchain
+ & chain_border(2,maxchain),chain_border1(2,maxchain),nchain
common /from_zscore/ nz_start,nz_end,iz_sc
double precision boxxsize,boxysize,boxzsize,enecut,sscut,
& sss,sssgrad,
-C Change 12/1/95 - common block CONTACTS1 included.
integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont
double precision facont,gacont
common /contacts/ ncont,ncont_ref,icont(2,maxcont),
& icont_ref(2,maxcont)
- common /contacts1/ facont(maxconts,maxres),
- & gacont(3,maxconts,maxres),
- & num_cont(maxres),jcont(maxconts,maxres)
-C 12/26/95 - H-bonding contacts
- common /contacts_hb/
- & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres),
- & gacontp_hb3(3,maxconts,maxres),
- & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres),
- & gacontm_hb3(3,maxconts,maxres),
- & gacont_hbr(3,maxconts,maxres),
- & grij_hb_cont(3,maxconts,maxres),
- & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
- & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
- & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
-C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
-C interactions
-c 7/25/08 Commented out; not needed when cumulants used
-C Interactions of pseudo-dipoles generated by loc-el interactions.
-c double precision dip,dipderg,dipderx
-c common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres),
-c & dipderx(3,5,4,maxconts,maxres)
-C 10/30/99 Added other pre-computed vectors and matrices needed
-C to calculate three - six-order el-loc correlation terms
- double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der,
- & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,gmu,gUb2
- & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der,
- & gtEug
- common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres),
- & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres),
- & obrot_der(2,maxres),obrot2_der(2,maxres)
-C This common block contains vectors and matrices dependent on a single
-C amino-acid residue.
- common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres),
- & gmu(2,maxres),gUb2(2,maxres),
- & Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres),
- & Dtobr2(2,maxres),Dtobr2der(2,maxres),
- & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres),
- & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres),
- & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),gtEUg(2,2,maxres)
-C This common block contains vectors and matrices dependent on two
-C consecutive amino-acid residues.
- double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC,
- & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder
- common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres),
- & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres),
- & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres),
- & DtUg2EUg(2,2,maxres),Ug2DtEUg(2,2,maxres),
- & Ug2DtEUgder(2,2,2,maxres),DtUg2EUgder(2,2,2,maxres)
- double precision costab,sintab,costab2,sintab2
- common /rotat_old/ costab(maxres),sintab(maxres),
- & costab2(maxres),sintab2(maxres)
-C This common block contains dipole-interaction matrices and their
-C Cartesian derivatives.
- double precision a_chuj,a_chuj_der
- common /dipmat/ a_chuj(2,2,maxconts,maxres),
- & a_chuj_der(2,2,3,5,maxconts,maxres)
- double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx,
- & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx,
- & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont
- common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2),
- & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2),
- & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2),
- & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2),
- & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2),
- & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2),
- & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2),
- & g_contij(3,2),ekont
-C 12/13/2008 (again Poland-Jaruzel war anniversary)
-C RE: Parallelization of 4th and higher order loc-el correlations
- integer ncont_sent,ncont_recv,iint_sent,iisent_local,
- & itask_cont_from,itask_cont_to,ntask_cont_from,ntask_cont_to,
- & nat_sent,iat_sent,iturn3_sent,iturn4_sent,iturn3_sent_local,
- & iturn4_sent_local
- common /contdistrib/ ncont_sent(maxres),ncont_recv(maxres),
- & iint_sent(4,maxres,maxres),iint_sent_local(4,maxres,maxres),
- & iturn3_sent(4,maxres),iturn4_sent(4,maxres),
- & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres),
- & nat_sent,iat_sent(maxres),itask_cont_from(0:max_fg_procs-1),
- & itask_cont_to(0:max_fg_procs-1),ntask_cont_from,ntask_cont_to
+! This common block contains general variables controlling the calculations
+! and output level.
+!... energy_dec = .true. means print energy decomposition matrix
integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad,
& inprint,i2ndstr,mucadyn,constr_dist,symetr,AFMlog,selfguide,
& shield_mode,tor_mode,tubelog,constr_homology,homol_nset,
- & nsaxs,saxs_mode,iprint
+ & iprint
+!... minim = .true. means DO minimization.
logical minim,refstr,pdbref,outpdb,outmol2,overlapsc,energy_dec,
- & mremd_dec,sideadd,lsecondary,read_cart,unres_pdb,
- & vdisulf,searchsc,lmuca,dccart,extconf,out1file,
+ & mremd_dec,sideadd,lsecondary,read_cart,unres_pdb,out_cart,
+ & out_int,vdisulf,searchsc,lmuca,dccart,extconf,out1file,gmatout,
& gnorm_check,gradout,split_ene,with_theta_constr,
& with_dihed_constr,read2sigma,start_from_model,read_homol_frag,
- & out_template_coord,out_template_restr
- real*8 Psaxs(maxsaxs),distsaxs(maxsaxs),CSAXS(3,maxsaxs),wsaxs0,
- & scal_rad, saxs_cutoff
- real*8 waga_homology
- real*8 waga_dist, waga_angle, waga_theta, waga_d, dist_cut,
- & dist2_cut
+ & out_template_coord,out_template_restr,usampl,loc_qlike,adaptive
double precision aincr
common /cntrl/ aincr,modecalc,iscode,indpdb,indback,indphi,
& iranconf,
& icheckgrad,minim,i2ndstr,refstr,pdbref,outpdb,outmol2,iprint,
& overlapsc,energy_dec,mremd_dec,sideadd,lsecondary,read_cart,
- & unres_pdb,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file,
- & selfguide,AFMlog,shield_mode,tor_mode,tubelog,
- & constr_dist,gnorm_check,gradout,split_ene,with_theta_constr,
- & with_dihed_constr,symetr,
- & constr_homology,homol_nset,read2sigma,start_from_model,
+ & unres_pdb,out_cart,out_int,vdisulf,searchsc,lmuca,dccart,mucadyn,
+ & extconf,out1file,gmatout,selfguide,AFMlog,shield_mode,tor_mode,
+ & tubelog,constr_dist,gnorm_check,gradout,split_ene,
+ & with_theta_constr,with_dihed_constr,symetr,usampl,loc_qlike,
+ & adaptive,constr_homology,homol_nset,read2sigma,start_from_model,
& read_homol_frag,out_template_coord,out_template_restr
- common /homol/ waga_homology(maxprocs/20),
- & waga_dist, waga_angle, waga_theta, waga_d, dist_cut,dist2_cut
- common /saxsretr/Psaxs,distsaxs,csaxs,Wsaxs0,scal_rad,saxs_cutoff,
- & nsaxs,saxs_mode
-C... minim = .true. means DO minimization.
-C... energy_dec = .true. means print energy decomposition matrix
- integer ngroup,igroup,ntotgr,numch,irestart,ndiff
- double precision diffcut
+ integer ngroup,igroup,ntotgr,numch,irestart,ndiff,nglob_csa,
+ & nmin_csa,n1,n2,n3,n4,n5,n6,n7,n8,n9,n14,n15,n16,n17,n18,n0,
+ & is1,is2,nseed,ntotal,icmax,nstmax,nran0,nran1,irr,jstart,jend
+ double precision diffcut,eglob_csa,estop,cut1,cut2,rdih_bias
common/alphaa/ ngroup(mxgr),igroup(3,mxang,mxgr),ntotgr,numch
common/csa_input/cut1,cut2,eglob_csa,estop,jstart,jend,
& n1,n2,n3,n4,n5,n6,n7,n8,n9,n14,n15,n16,n17,n18,n0,
+ character*8 str_nam
+ double precision cart_base
+ integer nres_base,nseq
common /struct/ cart_base(3,maxres_base,maxseq),str_nam(maxseq),
& nres_base(3,maxseq),nseq
- character*8 str_nam
& gshieldc_ll, gshieldc_loc_ll
double precision gdfad,gdfat,gdfan,gdfab
integer nfl,icg
- common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres),
+c common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres),
+c 3/12/20 Adam: Arrays dcdv, dxdv, and dxds removed following recoding of gradient.
+ common /derivat/
& gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres),
& gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres),
& gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres),
+ integer maxres22
c parameter (maxres22=maxres*(maxres+1)/2)
parameter (maxres22=1)
double precision w,d0,DRDG,DD,H,XX
- integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0,
- 1 lvar_frag,svar_frag,avar_frag
- COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3)
- COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3),
- 1 lvar_frag(mxio,3),svar_frag(mxio,3),
- 2 avar_frag(mxio,5)
COMMON /WAGI/ w(MAXRES22),d0(MAXRES22)
- COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22),
+ integer nx,ny,mask
+ COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22),
1 H(MAXRES,MAXRES),XX(MAXRES)
COMMON /frozen/ mask(maxres)
COMMON /store0/ nhpb0
c NPROCS - total number of processors;
c MyID - processor's ID;
c MasterID - master processor's ID.
- integer MyId,AllGrp,DontCare,MasterId,WhatsUp,ifinish
+ integer MyId,AllGrp,DontCare,MasterId,WhatsUp,ifinish,msglen_var
logical koniec
integer tag,status(MPI_STATUS_SIZE)
common /info/ myid,masterid,allgrp,dontcare,
+! Langevin dynamics parameters
+ logical surfarea
+ integer reset_fricmat
+ double precision scal_fric,rwat,etawat,gamp,
+ & gamsc(ntyp1),stdfp,stdfsc(ntyp),stdforcp(MAXRES),
+ & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb
+ common /langevin/ pstok,restok,gamp,gamsc,
+ & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea,
+ & reset_fricmat
+! Quantities used in Langevin dynamics calculations
double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2),
& fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6),
& stoch_work(MAXRES6),
- double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2),
+! Basic Langevin dynamics parameters
+ logical surfarea
+ integer reset_fricmat
+ double precision scal_fric,rwat,etawat,gamp,
+ & gamsc(ntyp1),stdfp,stdfsc(ntyp),stdforcp(MAXRES),
+ & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb
+ common /langevin/ pstok,restok,gamp,gamsc,
+ & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,scal_fric,
+ & cPoise,Rb,surfarea,reset_fricmat
+! Variables used in Langevin dynamics calculations
+ double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2),
& fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6),
- & stoch_work(MAXRES6),
- & fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2)
- logical flag_stoch(0:maxflag_stoch)
- common /langforc/ friction,stochforc,
- & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1,
- & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat,
- & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1,
- & vrand0_mat2,flag_stoch
- common /langmat/ mt1,mt2,mt3
+ & stoch_work(MAXRES6),fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2)
+ logical flag_stoch(0:maxflag_stoch)
+ common /langforc/ friction,stochforc,fricmat,fric_work,fricgam,
+ & stoch_work,fricvec,flag_stoch
- integer nmap,res1,res2,nstep
+ integer nmap,res1,res2,nstep,kang
double precision ang_from,ang_to
common /mapp/ ang_from(maxvar),ang_to(maxvar),nmap,kang(maxvar),
& res1(maxvar),res2(maxvar),nstep(maxvar)
double precision
& gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
& gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
+ & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorrc_max,
& gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
+ & gsccorrx_max,gsclocx_max
common /maxgrad/
& gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
& gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
+ & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorrc_max,
& gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
+ & gsccorrx_max,gsclocx_max
double precision entropy(-max_ene-4:max_ene),nminima(maxsave),
- & nhist(-max_ene:max_ene)
+ & nhist(-max_ene:max_ene),emin,emax
logical ent_read,multican
+ integer indminn,indmaxx
common /mce/ entropy,emin,emax,nhist,nminima,ent_read,multican,
& indminn,indmaxx
integer npool
C... procedure
c-----------------------------------------------------------------------------
double precision Tcur,Tmin,Tmax,TstepH,TstepC,RanFract,
- & overlap_cut,e_up,delte
+ & overlap_cut,e_up,delte,Rbol,betbol
integer nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,
& maxrepm,ngen,ntrial,ntherm,nrepm,neneval,nsave,maxoverlap,
- & nsave_part,max_mcm_it,nsweep,print_mc
+ & nsave_part,max_mcm_it,nsweep,print_mc,nbond_move,nbond_acc
logical print_stat,print_int
common /mcm/ Tcur,Tmin,Tmax,TstepH,TstepC,Rbol,betbol,RanFract,
& overlap_cut,e_up,delte,
- double precision gcart, gxcart, gradcag,gradxag
- common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES),
- & gradcag(3,MAXRES),gradxag(3,MAXRES)
- integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20),
- & ipair(2,100,maxprocs/20),iset,
- & mset(maxprocs/20),nset
- logical loc_qlike,adaptive
- double precision IP,ISC(ntyp+1),mp,
- & msc(ntyp+1),d_t_work(MAXRES6),
- & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2),
- & d_af_work(MAXRES6),d_as_work(MAXRES6),
- & d_t_old(3,0:MAXRES2),d_a_old(3,0:MAXRES2),d_a_short(3,0:MAXRES2),
- & Gmat(MAXRES2,MAXRES2),Ginv(MAXRES2,MAXRES2),A(MAXRES2,MAXRES2),
- & d_a(3,0:MAXRES2),d_a_work(6*MAXRES),kinetic_force(MAXRES6),
- & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2),
- & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2)
-
- real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim),
- & dih(max_template,maxres),sigma_dih(max_template,maxres),
- & sigma_odlir(max_template,maxdim)
-c
-c Specification of new variables used in subroutine e_modeller
-c modified by FP (Nov.,2014)
- real*8 xxtpl(max_template,maxres),yytpl(max_template,maxres),
- & zztpl(max_template,maxres),thetatpl(max_template,maxres),
- & sigma_theta(max_template,maxres),
- & sigma_d(max_template,maxres)
-c
-
- integer ires_homo(maxdim),
- & jres_homo(maxdim),idomain(max_template,maxres)
-
- double precision v_ini,d_time,d_time0,t_bath,tau_bath,
- & EK,potE,potEcomp(0:n_ene+8),totE,totT,amax,kinetic_T,dvmax,damax,
- & edriftmax,
- & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20),
- & qfrag(50),qpair(100),
- & qinfrag(50,maxprocs/20),qinpair(100,maxprocs/20),
- & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst,
- & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES),
- & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back),
- & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres),
- & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20),
- & qloc(3,maxfrag_back),
- & qin_back(3,maxfrag_back,maxprocs/20),
- & uconst_back
+! General MD parameters
+ double precision v_ini,d_time,d_time0,t_bath,tau_bath,
+ & dvmax,damax,edriftmax
integer n_timestep,ntwx,ntwe,lang,count_reset_moment,
- & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back,
- & ifrag_back(3,maxfrag_back,maxprocs/20),ntime_split,ntime_split0,
- & maxtime_split,lim_odl,lim_dih,link_start_homo,link_end_homo,
- & idihconstr_start_homo,idihconstr_end_homo
+ & count_reset_vel,ntime_split,ntime_split0,
+ & maxtime_split
logical large,print_compon,tbf,rest,reset_moment,reset_vel,
- & surfarea,rattle,usampl,mdpdb,RESPA,preminim,
- & l_homo(max_template,maxdim)
- integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts,
- & nginv_start,nginv_counts,myginv_ng_count
- common /back_constr/ uconst_back,utheta,ugamma,uscdiff,
- & dutheta,dugamma,duscdiff,duscdiffx,
- & qin_back,qloc,wfrag_back,nfrag_back,ifrag_back
-
- common /homrestr/ odl,dih,sigma_dih,sigma_odl,
- & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo,
- & link_end_homo,idihconstr_start_homo,idihconstr_end_homo,
- & idomain,l_homo
-c
-c FP (30/10/2014,04/03/2015)
-c
- common /homrestr_double/
- & xxtpl,yytpl,zztpl,thetatpl,sigma_theta,sigma_d,sigma_odlir
-c
- common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time,
- & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst,
- & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag,loc_qlike,adaptive
- common /mdpar/ v_ini,d_time,d_time0,scal_fric,
- & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb,
+ & rattle,mdpdb,RESPA,preminim
+ common /mdpar/ v_ini,d_time,d_time0,t_bath,
+ & tau_bath,dvmax,damax,n_timestep,mdpdb,
& ntime_split,ntime_split0,maxtime_split,
- & ntwx,ntwe,large,print_compon,tbf,rest,preminim
- common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax,
- & kinetic_T
- common /lagrange/ d_t,d_t_old,d_t_new,d_t_work,
- & d_t_work_new,d_a,d_a_old,d_a_work,d_af_work,d_as_work,d_a_short,
- & kinetic_force,
- & A,Ginv,Gmat,Gvec,Geigen,Gsqrp,Gsqrm,
- & vtot,dimen,dimen1,dimen3,lang,
+ & ntwx,ntwe,lang,large,print_compon,tbf,rest,preminim,
& reset_moment,reset_vel,count_reset_moment,count_reset_vel,
& rattle,RESPA
- common /inertia/ IP,ISC,mp,MSC
- double precision scal_fric,rwat,etawat,gamp,
- & gamsc(ntyp1),stdfp,stdfsc(ntyp),stdforcp(MAXRES),
- & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb
- common /langevin/ pstok,restok,gamp,gamsc,
- & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea,
- & reset_fricmat
+! Basic quantities
+ double precision EK,potE,potEcomp(0:n_ene+8),totE,totT,amax,
+ & kinetic_T
+ common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax,
+ & kinetic_T
+! Parameters of distributed calculations of accelerations from forces
+ integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts,
+ & nginv_start,nginv_counts,myginv_ng_count
common /mdpmpi/ igmult_start,igmult_end,my_ng_count,
& myginv_ng_count,
& ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1),
& nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1)
+! Gradient components
+ double precision gcart, gxcart, gradcag,gradxag
+ common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES),
+ & gradcag(3,MAXRES),gradxag(3,MAXRES)
double precision VSolvSphere,VSolvSphere_div,long_r_sidechain,
& short_r_sidechain,fac_shield,grad_shield_side,grad_shield,
- & buff_shield,wshield
+ & grad_shield_loc,buff_shield,wshield
integer ishield_list,shield_list,ees0plist
common /shield/ VSolvSphere,VSolvSphere_div,buff_shield,
& long_r_sidechain(ntyp),
- double precision r_cut,rlamb
- common /splitele/ r_cut,rlamb
+ double precision r_cut_int,r_cut_respa,rlamb
+ common /splitele/ r_cut_int,r_cut_respa,rlamb
common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave),
& Origin(maxsave),nstore
C freeze some variables
- logical mask_r
- common /restr/ varall(maxvar),mask_r,mask_theta(maxres),
+ logical mask_r,sideonly
+ common /restr/ varall(maxvar),mask_r,sideonly,mask_theta(maxres),
& mask_phi(maxres),mask_side(maxres)
+ double precision uy,uz,uygrad,uzgrad
common /vectors/ uy(3,maxres),uz(3,maxres),
& uygrad(3,3,2,maxres),uzgrad(3,3,2,maxres)
parameter (max_cg_procs=maxprocs)
C Max. number of AA residues
integer maxres
-c parameter (maxres=3300)
- parameter (maxres=1200)
+ parameter (maxres=3300)
+C Max. number of AA residues per chain
+ integer maxres_chain
+ parameter (maxres_chain=1200)
C Appr. max. number of interaction sites
- integer maxres2,maxres6,mmaxres2
+ integer maxres2,maxres6,maxres2_chain,mmaxres2,mmaxres2_chain
parameter (maxres2=2*maxres,maxres6=6*maxres)
parameter (mmaxres2=(maxres2*(maxres2+1)/2))
+ parameter (maxres2_chain=2*maxres_chain,
+ & mmaxres2_chain=maxres2_chain*(maxres2_chain+1)/2)
C Max number of symetric chains
integer maxchain
parameter (maxchain=50)
C Max. number of derivatives of virtual-bond and side-chain vectors in theta
C or phi.
integer maxdim
- parameter (maxdim=(maxres-1)*(maxres-2)/2)
+ parameter (maxdim=(maxres_chain-1)*(maxres_chain-2)/2)
C Max. number of SC contacts
integer maxcont
parameter (maxcont=12*maxres)
c------------------------------------------------
c The driver for molecular dynamics subroutines
c------------------------------------------------
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
common /gucio/ cm
integer itime
logical ovrtim
+ integer i,j,icount_scale,itime_scal
+ integer nharp,iharp(4,maxres/3)
+ double precision scalfac
+ double precision tt0
c
#ifdef MPI
if (ilen(tmpdir).gt.0)
if (ilen(tmpdir).gt.0)
& call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"//'.rst')
#endif
+ write (iout,*) "MD lang",lang
t_MDsetup=0.0d0
t_langsetup=0.0d0
t_MD=0.0d0
c Perform a single velocity Verlet step; the time step can be rescaled if
c increments in accelerations exceed the threshold
c-------------------------------------------------------------------------------
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
- integer ierror,ierrcode
+ integer ierror,ierrcode,errcode
#endif
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
common /gucio/ cm
double precision stochforcvec(MAXRES6)
common /stochcalc/ stochforcvec
- integer itime
+ integer itime,icount_scale,itime_scal,ifac_time,i,j,itt
logical scale
+ double precision epdrift,fac_time
+ double precision tt0
c
scale=.true.
icount_scale=0
call zerograd
call etotal(potEcomp)
! AL 4/17/17: Reduce the steps if NaNs occurred.
- if (potEcomp(0).gt.0.99e20 .or. isnan(potEcomp(0))) then
+ if (potEcomp(0).gt.0.99e20 .or. isnan(potEcomp(0)).gt.0) then
d_time=d_time/2
cycle
endif
c-------------------------------------------------------------------------------
c Perform a single RESPA step.
c-------------------------------------------------------------------------------
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
double precision cm(3),L(3),vcm(3),incr(3)
double precision dc_old0(3,0:maxres2),d_t_old0(3,0:maxres2),
& d_a_old0(3,0:maxres2)
+ integer i,j
+ double precision fac_time
logical PRINT_AMTS_MSG /.false./
integer ilen,count,rstcount
external ilen
common /stochcalc/ stochforcvec
integer itime
logical scale
+ integer itt
common /cipiszcze/ itt
+ integer itsplit
+ double precision epdrift,epdriftmax
+ double precision tt0
itt=itime
if (ntwe.ne.0) then
if (large.and. mod(itime,ntwe).eq.0) then
write (iout,*) "Cartesian and internal coordinates: step 2"
c call cartprint
call pdbout(0.0d0,
- & cipiszcze ,iout)
+ & 'cipiszcze ',iout)
call intout
write (iout,*) "Accelerations from long-range forces"
do i=0,nres
if (ntwe.ne.0) then
if (large.and. mod(itime,ntwe).eq.0) then
call enerprint(potEcomp)
- write (iout,*) "potE",potD
+ write (iout,*) "potE",potE
endif
endif
c potE=energia_short(0)+energia_long(0)
subroutine RESPA_vel
c First and last RESPA step (incrementing velocities using long-range
c forces).
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
+ integer i,j,inres
do j=1,3
d_t(j,0)=d_t(j,0)+0.5d0*d_a(j,0)*d_time
enddo
c-----------------------------------------------------------------
subroutine verlet1
c Applying velocity Verlet algorithm - step 1 to coordinates
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
double precision adt,adt2
-
+ integer i,j,inres
#ifdef DEBUG
write (iout,*) "VELVERLET1 START: DC"
do i=0,nres
d_t_new(j,0)=d_t_old(j,0)+adt2
d_t(j,0)=d_t_old(j,0)+adt
enddo
- do i=nnt,nct-1
+ do i=nnt,nct-1
C SPYTAC ADAMA
C do i=0,nres
+#ifdef DEBUG
+ write (iout,*) "i",i," d_a_old",(d_a_old(j,i),j=1,3)
+#endif
do j=1,3
adt=d_a_old(j,i)*d_time
adt2=0.5d0*adt
c---------------------------------------------------------------------
subroutine verlet2
c Step 2 of the velocity Verlet algorithm: update velocities
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
+ integer i,j,inres
do j=1,3
d_t(j,0)=d_t_new(j,0)+0.5d0*d_a(j,0)*d_time
enddo
c-----------------------------------------------------------------
subroutine sddir_precalc
c Applying velocity Verlet algorithm - step 1 to coordinates
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
+ double precision time00
double precision stochforcvec(MAXRES6)
common /stochcalc/ stochforcvec
+ integer i
c
c Compute friction and stochastic forces
c
time00=tcpu()
#endif
call friction_force
+c write (iout,*) "After friction_force"
#ifdef MPI
time_fric=time_fric+MPI_Wtime()-time00
time00=MPI_Wtime()
time00=tcpu()
#endif
call stochastic_force(stochforcvec)
+c write (iout,*) "After stochastic_force"
#ifdef MPI
time_stoch=time_stoch+MPI_Wtime()-time00
#else
c Compute the acceleration due to friction forces (d_af_work) and stochastic
c forces (d_as_work)
c
+#ifdef FIVEDIAG
+c write (iout,*) "friction accelerations"
+ call fivediaginv_mult(dimen,fric_work, d_af_work)
+c write (iout,*) "stochastic acceleratios"
+ call fivediaginv_mult(dimen,stochforcvec, d_as_work)
+c write (iout,*) "Leaving sddir_precalc"
+#else
call ginv_mult(fric_work, d_af_work)
call ginv_mult(stochforcvec, d_as_work)
+#endif
+#ifdef DEBUG
+ write (iout,*) "d_af_work"
+ write (iout,'(3f10.5)') (d_af_work(i),i=1,dimen3)
+ write (iout,*) "d_as_work"
+ write (iout,'(3f10.5)') (d_as_work(i),i=1,dimen3)
+#endif
return
end
c---------------------------------------------------------------------
subroutine sddir_verlet1
c Applying velocity Verlet algorithm - step 1 to velocities
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
c position and velocity increments included.
double precision sqrt13 /0.57735026918962576451d0/ ! 1/sqrt(3)
double precision adt,adt2
+ integer i,j,ind,inres
c
c Add the contribution from BOTH friction and stochastic force to the
c coordinates, but ONLY the contribution from the friction forces to velocities
d_t(j,0)=d_t_old(j,0)+adt
enddo
ind=3
- do i=nnt,nct-1
+ do i=nnt,nct-1
do j=1,3
adt=(d_a_old(j,i)+d_af_work(ind+j))*d_time
adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time
c---------------------------------------------------------------------
subroutine sddir_verlet2
c Calculating the adjusted velocities for accelerations
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.NAMES'
double precision stochforcvec(MAXRES6),d_as_work1(MAXRES6)
double precision cos60 /0.5d0/, sin60 /0.86602540378443864676d0/
+ integer i,j,inres,ind
c Revised 3/31/05 AL: correlation between random contributions to
c position and velocity increments included.
c The correlation coefficients are calculated at low-friction limit.
c Compute the acceleration due to friction forces (d_af_work) and stochastic
c forces (d_as_work)
c
+#ifdef FIVEDIAG
+ call fivediaginv_mult(maxres6,stochforcvec, d_as_work1)
+#else
call ginv_mult(stochforcvec, d_as_work1)
-
+#endif
c
c Update velocities
c
c Find the maximum difference in the accelerations of the the sites
c at the beginning and the end of the time step.
c
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
+ integer i,j
double precision aux(3),accel(3),accel_old(3),dacc
do j=1,3
c aux(j)=d_a(j,0)-d_a_old(j,0)
c
c Predict the drift of the potential energy
c
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.MUCA'
double precision epdrift,epdriftij
+ integer i,j
c Drift of the potential energy
epdrift=0.0d0
do i=nnt,nct
c
c Coupling to the thermostat by using the Berendsen algorithm
c
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
double precision T_half,fact
-c
+ integer i,j ,inres
T_half=2.0d0/(dimen3*Rb)*EK
fact=dsqrt(1.0d0+(d_time/tau_bath)*(t_bath/T_half-1.0d0))
c write(iout,*) "T_half", T_half
c---------------------------------------------------------
subroutine init_MD
c Set up the initial conditions of a MD simulation
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MP
include 'mpif.h'
character*16 form
- integer IERROR,ERRCODE
+ integer IERROR,ERRCODE,error_msg,ierr,ierrcode
#endif
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+ include 'COMMON.QRESTR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.REMD'
+ include 'COMMON.TIME1'
+#ifdef LBFGS
+ character*9 status
+ integer niter
+ common /lbfgstat/ status,niter,nfun
+#endif
+ integer n_model_try,list_model_try(max_template),k
+ double precision tt0
real*8 energia_long(0:n_ene),
& energia_short(0:n_ene),vcm(3),incr(3)
double precision cm(3),L(3),xv,sigv,lowb,highb
character*50 tytul
logical file_exist
common /gucio/ cm
+ integer i,ipos,iq,iw,j,iranmin,nft_sc,iretcode,nfun,itrial,itmp,
+ & i_model,itime
+ integer iran_num
+ double precision etot
+ logical fail
write (iout,*) "init_MD INDPDB",indpdb
d_time0=d_time
c write(iout,*) "d_time", d_time
endif
call flush(iout)
write (iout,*) "init_MD before initial structure REST ",rest
- if (.not.rest) then
+ if (.not.rest) then
+ 122 continue
if (iranconf.ne.0) then
c 8/22/17 AL Loop to produce a low-energy random conformation
do iranmin=1,10
44 continue
else if (preminim) then
if (start_from_model) then
- i_model=iran_num(1,constr_homology)
- write (iout,*) 'starting from model ',i_model
- do i=1,2*nres
- do j=1,3
- c(j,i)=chomo(j,i,i_model)
+ n_model_try=0
+ do while (fail .and. n_model_try.lt.constr_homology)
+ do
+ i_model=iran_num(1,constr_homology)
+ do k=1,n_model_try
+ if (i_model.eq.list_model_try(k)) exit
+ enddo
+ if (k.gt.n_model_try) exit
enddo
- enddo
- call int_from_cart(.true.,.false.)
- call sc_loc_geom(.false.)
- do i=1,nres-1
- do j=1,3
- dc(j,i)=c(j,i+1)-c(j,i)
- dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
+ n_model_try=n_model_try+1
+ list_model_try(n_model_try)=i_model
+ write (iout,*) 'starting from model ',i_model
+ do i=1,2*nres
+ do j=1,3
+ c(j,i)=chomo(j,i,i_model)
+ enddo
enddo
- enddo
- do i=2,nres-1
- do j=1,3
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
+ call int_from_cart(.true.,.false.)
+ call sc_loc_geom(.false.)
+ do i=1,nres-1
+ do j=1,3
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
+ enddo
enddo
- enddo
- endif
+ do i=2,nres-1
+ do j=1,3
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
+ enddo
+ enddo
+ if (me.eq.king.or..not.out1file) then
+ write (iout,*) "Energies before removing overlaps"
+ call etotal(energia(0))
+ call enerprint(energia(0))
+ endif
! Remove SC overlaps if requested
- if (overlapsc) then
- write (iout,*) 'Calling OVERLAP_SC'
- call overlap_sc(fail)
- endif
+ if (overlapsc) then
+ write (iout,*) 'Calling OVERLAP_SC'
+ call overlap_sc(fail)
+ if (fail) then
+ write (iout,*)
+ & "Failed to remove overlap from model",i_model
+ cycle
+ endif
+ endif
+#ifdef SEARCHSC
+ if (me.eq.king.or..not.out1file) then
+ write (iout,*) "Energies after removing overlaps"
+ call etotal(energia(0))
+ call enerprint(energia(0))
+ endif
! Search for better SC rotamers if requested
- if (searchsc) then
- call sc_move(2,nres-1,10,1d10,nft_sc,etot)
- print *,'SC_move',nft_sc,etot
- if (me.eq.king.or..not.out1file)
- & write(iout,*) 'SC_move',nft_sc,etot
+ if (searchsc) then
+ call sc_move(2,nres-1,10,1d10,nft_sc,etot)
+ print *,'SC_move',nft_sc,etot
+ if (me.eq.king.or..not.out1file)
+ & write(iout,*) 'SC_move',nft_sc,etot
+ endif
+ call etotal(energia(0))
+#endif
+ enddo
+ if (n_model_try.gt.constr_homology) then
+ write (iout,*)
+ & "All models have irreparable overlaps. Trying randoms starts."
+ iranconf=1
+ goto 122
+ endif
endif
- call etotal(energia(0))
C 8/22/17 AL Minimize initial structure
if (dccart) then
if (me.eq.king.or..not.out1file) write(iout,*)
- & 'Minimizing initial PDB structure: Calling MINIM_DC'
+ & 'Minimizing initial PDB structure: Calling MINIM_DC'
call minim_dc(etot,iretcode,nfun)
else
call geom_to_var(nvar,varia)
if(me.eq.king.or..not.out1file) write (iout,*)
- & 'Minimizing initial PDB structure: Calling MINIMIZE.'
+ & 'Minimizing initial PDB structure: Calling MINIMIZE.'
call minimize(etot,varia,iretcode,nfun)
call var_to_geom(nvar,varia)
- endif
- if (me.eq.king.or..not.out1file)
+#ifdef LBFGS
+ if (me.eq.king.or..not.out1file)
+ & write(iout,*) 'LBFGS return code is ',status,' eval ',nfun
+ if(me.eq.king.or..not.out1file)
+ & write(iout,*) 'LBFGS return code is ',status,' eval ',nfun
+#else
+ if (me.eq.king.or..not.out1file)
& write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun
- if(me.eq.king.or..not.out1file)
+ if(me.eq.king.or..not.out1file)
& write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun
+#endif
+ endif
endif
- endif
+ endif ! .not. rest
call chainbuild_cart
call kinetic(EK)
if (tbf) then
call verlet_bath
- endif
+ endif
kinetic_T=2.0d0/(dimen3*Rb)*EK
if(me.eq.king.or..not.out1file)then
call cartprint
end
c-----------------------------------------------------------
subroutine random_vel
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
- double precision xv,sigv,lowb,highb,vec_afm(3)
+ double precision xv,sigv,lowb,highb,vec_afm(3),Ek1,Ek2,Ek3,aux
+ integer i,ii,j,k,l,ind
+ double precision anorm_distr
+ logical lprn /.true./
+#ifdef FIVEDIAG
+ integer ichain,n,innt,inct,ibeg,ierr
+ double precision work(8*maxres6)
+ integer iwork(maxres6)
+ double precision Ghalf(mmaxres2_chain),Geigen(maxres2_chain),
+ & Gvec(maxres2_chain,maxres2_chain)
+ common /przechowalnia/Ghalf,Geigen,Gvec
+#ifdef DEBUG
+ double precision inertia(maxres2_chain,maxres2_chain)
+#endif
c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m
c First generate velocities in the eigenspace of the G matrix
c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3
c call flush(iout)
+#ifdef DEBUG
+ write (iout,*) "Random_vel, fivediag"
+#endif
+ d_t=0.0d0
+ Ek2=0.0d0
+ EK=0.0d0
+ Ek3=0.0d0
+ do ichain=1,nchain
+ ind=0
+ ghalf=0.0d0
+ n=dimen_chain(ichain)
+ innt=iposd_chain(ichain)
+ inct=innt+n-1
+#ifdef DEBUG
+ write (iout,*) "Chain",ichain," n",n," start",innt
+ do i=innt,inct
+ if (i.lt.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DMorig(i),DU1orig(i),
+ & DU2orig(i)
+ else if (i.eq.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DMorig(i),DU1orig(i)
+ else
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DMorig(i)
+ endif
+ enddo
+#endif
+ ghalf(ind+1)=dmorig(innt)
+ ghalf(ind+2)=du1orig(innt)
+ ghalf(ind+3)=dmorig(innt+1)
+ ind=ind+3
+ do i=3,n
+ ind=ind+i-3
+c write (iout,*) "i",i," ind",ind," indu2",innt+i-2,
+c & " indu1",innt+i-1," indm",innt+i
+ ghalf(ind+1)=du2orig(innt-1+i-2)
+ ghalf(ind+2)=du1orig(innt-1+i-1)
+ ghalf(ind+3)=dmorig(innt-1+i)
+c write (iout,'(3(a,i2,1x))') "DU2",innt-1+i-2,
+c & "DU1",innt-1+i-1,"DM ",innt-1+i
+ ind=ind+3
+ enddo
+#ifdef DEBUG
+ ind=0
+ do i=1,n
+ do j=1,i
+ ind=ind+1
+ inertia(i,j)=ghalf(ind)
+ inertia(j,i)=ghalf(ind)
+ enddo
+ enddo
+#endif
+#ifdef DEBUG
+ write (iout,*) "Chain ",ichain," ind",ind," dim",n*(n+1)/2
+ write (iout,*) "Five-diagonal inertia matrix, lower triangle"
+ call matoutr(n,ghalf)
+#endif
+ call gldiag(maxres2_chain,n,n,Ghalf,work,Geigen,Gvec,ierr,iwork)
+ if (large) then
+ write (iout,'(//a,i3)')
+ & "Eigenvectors and eigenvalues of the G matrix chain",ichain
+ call eigout(n,n,maxres2_chain,maxres2_chain,Gvec,Geigen)
+ endif
+#ifdef DIAGCHECK
+c check diagonalization
+ do i=1,n
+ do j=1,n
+ aux=0.0d0
+ do k=1,n
+ do l=1,n
+ aux=aux+gvec(k,i)*gvec(l,j)*inertia(k,l)
+ enddo
+ enddo
+ if (i.eq.j) then
+ write (iout,*) i,j,aux,geigen(i)
+ else
+ write (iout,*) i,j,aux
+ endif
+ enddo
+ enddo
+#endif
+ xv=0.0d0
+ ii=0
+ do i=1,n
+ do k=1,3
+ ii=ii+1
+ sigv=dsqrt((Rb*t_bath)/geigen(i))
+ lowb=-5*sigv
+ highb=5*sigv
+ d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb)
+ EK=EK+0.5d0*geigen(i)*d_t_work_new(ii)**2
+c write (iout,*) "i",i," ii",ii," geigen",geigen(i),
+c & " d_t_work_new",d_t_work_new(ii)
+ enddo
+ enddo
+ do k=1,3
+ do i=1,n
+ ind=(i-1)*3+k
+ d_t_work(ind)=0.0d0
+ do j=1,n
+ d_t_work(ind)=d_t_work(ind)
+ & +Gvec(i,j)*d_t_work_new((j-1)*3+k)
+ enddo
+c write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind)
+c call flush(iout)
+ enddo
+ enddo
+#ifdef DEBUG
+ aux=0.0d0
+ do k=1,3
+ do i=1,n
+ do j=1,n
+ aux=aux+inertia(i,j)*d_t_work(3*(i-1)+k)*d_t_work(3*(j-1)+k)
+ enddo
+ enddo
+ enddo
+ Ek3=Ek3+aux/2
+#endif
+c Transfer to the d_t vector
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ ind=0
+c write (iout,*) "ichain",ichain," innt",innt," inct",inct
+ do i=innt,inct
+ do j=1,3
+ ind=ind+1
+ d_t(j,i)=d_t_work(ind)
+ enddo
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ do j=1,3
+ ind=ind+1
+ d_t(j,i+nres)=d_t_work(ind)
+ enddo
+ endif
+ enddo
+ enddo
+ if (large) then
+ write (iout,*)
+ write (iout,*) "Random velocities in the Calpha,SC space"
+ do i=1,nres
+ write (iout,'(a3,1h(,i5,1h),3f10.5,3x,3f10.5)')
+ & restyp(itype(i)),i,(d_t(j,i),j=1,3),(d_t(j,i+nres),j=1,3)
+ enddo
+ endif
+ call kinetic_CASC(Ek1)
+!
+! Transform the velocities to virtual-bond space
+!
+#define WLOS
+#ifdef WLOS
+ do i=1,nres
+ if (itype(i).eq.10 .or. itype(i).eq.ntyp1) then
+ do j=1,3
+ d_t(j,i)=d_t(j,i+1)-d_t(j,i)
+ enddo
+ else
+ do j=1,3
+ d_t(j,i+nres)=d_t(j,i+nres)-d_t(j,i)
+ d_t(j,i)=d_t(j,i+1)-d_t(j,i)
+ enddo
+ end if
+ enddo
+ d_t(:,nct)=0.0d0
+c d_a(:,0)=d_a(:,1)
+c d_a(:,1)=0.0d0
+c write (iout,*) "Shifting accelerations"
+ do ichain=1,nchain
+c write (iout,*) "ichain",chain_border1(1,ichain)-1,
+c & chain_border1(1,ichain)
+ d_t(:,chain_border1(1,ichain)-1)=d_t(:,chain_border1(1,ichain))
+ d_t(:,chain_border1(1,ichain))=0.0d0
+ enddo
+c write (iout,*) "Adding accelerations"
+ do ichain=2,nchain
+c write (iout,*) "chain",ichain,chain_border1(1,ichain)-1,
+c & chain_border(2,ichain-1)
+ d_t(:,chain_border1(1,ichain)-1)=
+ & d_t(:,chain_border1(1,ichain)-1)+d_t(:,chain_border(2,ichain-1))
+ d_t(:,chain_border(2,ichain-1))=0.0d0
+ enddo
+ do ichain=2,nchain
+ write (iout,*) "chain",ichain,chain_border1(1,ichain)-1,
+ & chain_border(2,ichain-1)
+ d_t(:,chain_border1(1,ichain)-1)=
+ & d_t(:,chain_border1(1,ichain)-1)+d_t(:,chain_border(2,ichain-1))
+ d_t(:,chain_border(2,ichain-1))=0.0d0
+ enddo
+#else
+ ibeg=0
+c do j=1,3
+c d_t(j,0)=d_t(j,nnt)
+c enddo
+ do ichain=1,nchain
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+c write (iout,*) "ichain",ichain," innt",innt," inct",inct
+c write (iout,*) "ibeg",ibeg
+ do j=1,3
+ d_t(j,ibeg)=d_t(j,innt)
+ enddo
+ ibeg=inct+1
+ do i=innt,inct
+ if (iabs(itype(i).eq.10)) then
+c write (iout,*) "i",i,(d_t(j,i),j=1,3),(d_t(j,i+1),j=1,3)
+ do j=1,3
+ d_t(j,i)=d_t(j,i+1)-d_t(j,i)
+ enddo
+ else
+ do j=1,3
+ d_t(j,i+nres)=d_t(j,i+nres)-d_t(j,i)
+ d_t(j,i)=d_t(j,i+1)-d_t(j,i)
+ enddo
+ end if
+ enddo
+ enddo
+#endif
+ if (large) then
+ write (iout,*)
+ write (iout,*)
+ & "Random velocities in the virtual-bond-vector space"
+ write (iout,'(3hORG,1h(,i5,1h),3f10.5)') 0,(d_t(j,0),j=1,3)
+ do i=1,nres
+ write (iout,'(a3,1h(,i5,1h),3f10.5,3x,3f10.5)')
+ & restyp(itype(i)),i,(d_t(j,i),j=1,3),(d_t(j,i+nres),j=1,3)
+ enddo
+ write (iout,*)
+ write (iout,*) "Kinetic energy from inertia matrix eigenvalues",
+ & Ek
+ write (iout,*)
+ & "Kinetic temperatures from inertia matrix eigenvalues",
+ & 2*Ek/(3*dimen*Rb)
+#ifdef DEBUG
+ write (iout,*) "Kinetic energy from inertia matrix",Ek3
+ write (iout,*) "Kinetic temperatures from inertia",
+ & 2*Ek3/(3*dimen*Rb)
+#endif
+ write (iout,*) "Kinetic energy from velocities in CA-SC space",
+ & Ek1
+ write (iout,*)
+ & "Kinetic temperatures from velovities in CA-SC space",
+ & 2*Ek1/(3*dimen*Rb)
+ call kinetic(Ek1)
+ write (iout,*)
+ & "Kinetic energy from virtual-bond-vector velocities",Ek1
+ write (iout,*)
+ & "Kinetic temperature from virtual-bond-vector velocities ",
+ & 2*Ek1/(dimen3*Rb)
+ endif
+#else
xv=0.0d0
ii=0
do i=1,dimen
c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature",
c & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1
c call flush(iout)
+#endif
return
end
#ifndef LANG0
c-----------------------------------------------------------
subroutine sd_verlet_p_setup
c Sets up the parameters of stochastic Verlet algorithm
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
c
c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables
c
-#ifndef LANG0
call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat)
call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat)
call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat)
call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat)
call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec1,vrand_mat1)
call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2)
-#endif
#ifdef MPI
t_sdsetup=t_sdsetup+MPI_Wtime()
#else
c-------------------------------------------------------------
subroutine sd_verlet1
c Applying stochastic velocity Verlet algorithm - step 1 to velocities
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
double precision stochforcvec(MAXRES6)
common /stochcalc/ stochforcvec
logical lprn /.false./
+ integer i,j,ind,inres
c write (iout,*) "dc_old"
c do i=0,nres
c--------------------------------------------------------------------------
subroutine sd_verlet2
c Calculating the adjusted velocities for accelerations
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.NAMES'
double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6)
common /stochcalc/ stochforcvec
+ integer i,j,ind,inres
c
c Compute the stochastic forces which contribute to velocity change
c
subroutine sd_verlet_ciccotti_setup
c Sets up the parameters of stochastic velocity Verlet algorithmi; Ciccotti's
c version
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
#else
- include 'COMMON.LANGEVIN.lang0'
+ include 'COMMON.LAGRANGE'
#endif
+ include 'COMMON.LANGEVIN'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
logical lprn /.false./
double precision zero /1.0d-8/, gdt_radius /0.05d0/
double precision ktm
+ integer i
#ifdef MPI
tt0 = MPI_Wtime()
#else
c-------------------------------------------------------------
subroutine sd_verlet1_ciccotti
c Applying stochastic velocity Verlet algorithm - step 1 to velocities
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
#else
- include 'COMMON.LANGEVIN.lang0'
+ include 'COMMON.LAGRANGE'
#endif
+ include 'COMMON.LANGEVIN'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
double precision stochforcvec(MAXRES6)
common /stochcalc/ stochforcvec
logical lprn /.false./
+ integer i,j
c write (iout,*) "dc_old"
c do i=0,nres
c--------------------------------------------------------------------------
subroutine sd_verlet2_ciccotti
c Calculating the adjusted velocities for accelerations
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
#else
- include 'COMMON.LANGEVIN.lang0'
+ include 'COMMON.LAGRANGE'
#endif
+ include 'COMMON.LANGEVIN'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.NAMES'
double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6)
common /stochcalc/ stochforcvec
+ integer i,j
c
c Compute the stochastic forces which contribute to velocity change
c
subroutine MREMD
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+ include 'COMMON.QRESTR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.SETUP'
include 'COMMON.MUCA'
include 'COMMON.HAIRPIN'
- integer ERRCODE
+ double precision time00,time01,time02,time03,time04,time05,
+ & time06,time07,time08,time001,tt0
+ double precision scalfac
+ integer i,j,k,il,il1,ii,iex,itmp,i_temp,i_mult,i_iset,i_mset,
+ & i_dir,i_temp1,i_mult1,i_mset1
+ integer ERRCODE,ierr,ierror
double precision cm(3),L(3),vcm(3)
double precision energia(0:n_ene)
double precision remd_t_bath(maxprocs)
external ilen
character*50 tytul
common /gucio/ cm
- integer itime
+ integer itime,i_set_temp,itt,itime_master,irr,i_iset1
+ integer nharp,iharp(4,maxres/3)
cold integer nup(0:maxprocs),ndown(0:maxprocs)
integer rep2i(0:maxprocs),ireqi(maxprocs)
integer icache_all(maxprocs)
integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs)
logical synflag,end_of_run,file_exist /.false./,ovrtim
+ double precision t_bath_temp,delta,ene_iex_iex,ene_i_i,ene_iex_i,
+ & ene_i_iex,xxx,tmp,econstr_temp_iex,econstr_temp_i
+ integer iran_num
+ double precision ran_number
cdeb imin_itime_old=0
ntwx_cache=0
c-----------------------------------------------------------------------
subroutine write1rst(i_index)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
+ include 'COMMON.CONTROL'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+ include 'COMMON.QRESTR'
include 'COMMON.IOUNITS'
include 'COMMON.REMD'
include 'COMMON.SETUP'
integer*2 i_index
& (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
common /przechowalnia/ d_restart1,d_restart2
+ integer i,j,il1,il,ixdrf
+ integer ierr
t5_restart1(1)=totT
t5_restart1(2)=EK
subroutine write1traj
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.IOUNITS'
include 'COMMON.REMD'
include 'COMMON.SETUP'
& p_uscdiff(100*maxprocs)
real p_c(3,(maxres2+2)*maxprocs),r_c(3,maxres2+2)
common /przechowalnia/ p_c
+ integer ii,i,il,j,ixdrf
+ integer ierr
call mpi_bcast(ii_write,1,mpi_integer,
& king,CG_COMM,ierr)
subroutine read1restart(i_index)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
+ include 'COMMON.CONTROL'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+ include 'COMMON.QRESTR'
include 'COMMON.IOUNITS'
include 'COMMON.REMD'
include 'COMMON.SETUP'
integer*2 i_index
& (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
common /przechowalnia/ d_restart1
+ integer i,j,il,il1,ixdrf,iret,itmp
+ integer ierr
write (*,*) "Processor",me," called read1restart"
if(me.eq.king)then
end
subroutine read1restart_old
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.IOUNITS'
include 'COMMON.REMD'
include 'COMMON.SETUP'
real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
& t5_restart1(5)
common /przechowalnia/ d_restart1
+ integer i,j,il,itmp
+ integer ierr
if(me.eq.king)then
open(irest2,file=mremd_rst_name,status='unknown')
read (irest2,*) (i2rep(i),i=0,nodes-1)
FC = ftn
-OPT = -O3 -ip -mcmodel=medium -shared-intel -dynamic
-#OPT = -g -CA -CB -mcmodel=medium -shared-intel -dynamic
+#OPT = -O3 -ip -mcmodel=medium -shared-intel -dynamic
+OPT = -g -CA -CB -mcmodel=medium -shared-intel -dynamic
OPT2 = -g -O0 -mcmodel=medium -shared-intel -dynamic
-OPTE = -c -O3 -ipo -mcmodel=medium -shared-intel -dynamic
-#OPTE = ${OPT} -c
+#OPTE = -c -O3 -ipo -mcmodel=medium -shared-intel -dynamic
+OPTE = ${OPT} -c
FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
#FFLAGS1 = -c -g -CA -CB -I$(INSTALL_DIR)/include
object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o econstr_qlike.o econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o \
+ pinorm.o randgens.o rescode.o intcor.o timing.o misc.o \
+ cart2intgrad.o checkder_p.o contact_cp econstr_local.o econstr_qlike.o \
+ econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o \
energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o \
eigen.o blas.o add.o entmcm.o minim_mcmf.o \
together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
indexx.o MP.o compare_s1.o prng_32.o \
- test.o banach.o distfit.o rmsd.o rmscalc.o elecont.o dihed_cons.o \
+ banach.o distfit.o rmsd.o rmscalc.o elecont.o dihed_cons.o \
sc_move.o local_move.o djacob.o \
intcartderiv.o lagrangian_lesyng.o\
chain_symmetry.o permut.o seq2chains.o iperm.o\
surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
q_measure.o gnmr1.o mygauss.o ssMD.o
+object_lbfgs = inform.o iounit.o keys.o linmin.o math.o minima.o scales.o output.o lbfgs.o search.o optsave_dum.o
+
no_option:
GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
- -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-GAB: BIN = ~/bin/unres-mult-symetr_KCC_ifort_MPICH-okeanos_GAB-SAXS-homology.exe
+ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY
+GAB: BIN = ~/bin/unres-ms_ifort_MPICH-okeanos_GAB-HCD.exe
GAB: ${object} xdrf/libxdrf.a
gcc -o compinfo compinfo.c
./compinfo | true
${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
- -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-4P: BIN = ~/bin/unres-mult-symetr_KCC_ifort_MPICH-okeanos_4P-SAXS-homology.exe
+ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DFOURBODY
+4P: BIN = ~/bin/unres-ms_KCC_ifort_MPICH-okeanos_4P-HCD.exe
4P: ${object} xdrf/libxdrf.a
gcc -o compinfo compinfo.c
./compinfo | true
${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
- -DSPLITELE -DLANG0
-E0LL2Y: BIN = ~/bin/unres-mult-symetr_KCC_ifort_MPICH-okeanos_E0LL2Y-SAXS-homology.exe
+ -DSPLITELE -DLANG0 -DFOURBODY
+E0LL2Y: BIN = ~/bin/unres-ms_ifort_MPICH-okeanos_E0LL2Y-HCD.exe
E0LL2Y: ${object} xdrf/libxdrf.a
gcc -o compinfo compinfo.c
./compinfo | true
${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
NEWCORR: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
- -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD #-DMYGAUSS #-DTIMING
-NEWCORR: BIN = ~/bin/unres-mult-symetr_KCC_ifort_MPICH-okeanos_NEWCORR-SAXS-homology.exe
+ -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD #-DFOURBODY #-DMYGAUSS #-DTIMING
+NEWCORR: BIN = ~/bin/unres-ms_ifort_MPICH-okeanos_SC-HCD.exe
NEWCORR: ${object} xdrf/libxdrf.a
gcc -o compinfo compinfo.c
./compinfo | true
${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+ ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR5D: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+ -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS #-DMYGAUSS #-DTIMING
+NEWCORR5D: BIN = ~/bin/unres-ms_ifort_MPICH-okeanos_SC-HCD5-40.exe
+NEWCORR5D: ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a
+ gcc -o compinfo compinfo.c
+ ./compinfo | true
+ ${FC} ${FFLAGS} cinfo.f
+ ${FC} ${OPT} ${object} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN}
NEWCORR_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
-DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA #-DMYGAUSS #-DTIMING
-NEWCORR_DFA: BIN = ~/bin/unres-mult-symetr_KCC_ifort_MPICH-okeanos_NEWCORR-SAXS-homology-DFA-D.exe
+NEWCORR_DFA: BIN = ~/bin/unres-ms_ifort_MPICH-okeanos_SC-HCD-DFA.exe
NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a
gcc -o compinfo compinfo.c
./compinfo | true
${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
+ ${FC} ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
+
+NEWCORR5D_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
+ -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS -DDFA #-DMYGAUSS #-DTIMING
+NEWCORR5D_DFA: BIN = ~/bin/unres-ms_ifort_MPICH-okeanos_SC-HCD5-DFA.exe
+NEWCORR5D_DFA: ${object_lbfgs} ${object} dfa.o fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a
+ gcc -o compinfo compinfo.c
+ ./compinfo | true
+ ${FC} ${FFLAGS} cinfo.f
+ ${FC} ${OPT} ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o dfa.o kinetic_CASC.o cinfo.o ${LIBS} -o ${BIN}
xdrf/libxdrf.a:
cd xdrf && make
include 'DIMENSIONS.PMF'
include 'COMMON.IOUNITS'
include 'COMMON.MD'
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
+ include 'COMMON.QRESTR'
include 'COMMON.PMF'
include 'COMMON.REMD'
integer i,iumb,iiset,j,t,nbin
#endif
include 'COMMON.IOUNITS'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.REMD'
include 'COMMON.PMF'
integer i,iqmin,iqmax,irep
+++ /dev/null
-module load tau/tau-2.17
-#with preprocessor
-setenv TAU_OPTIONS '-optPreProcess -optVerbose'
-setenv TAU_THROTTLE 1
-setenv TAU_THROTTLE_NUMCALLS 400000
-setenv TAU_THROTTLE_PERCALL 3000
double precision FUNCTION ARCOS(X)
- implicit real*8 (a-h,o-z)
+ implicit none
+ double precision x
include 'COMMON.GEO'
IF (DABS(X).LT.1.0D0) GOTO 1
ARCOS=PIPOL*(1.0d0-DSIGN(1.0D0,X))
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
*
* Version of March '95, based on an early version of November '91.
*
+* 03/11/20 Adam. Array fromto eliminated, computed on the fly
+* Fixed the problem with vbld indices, which caused errors in
+* derivatives when the backbone virtual bond lengths were not equal.
***********************************************************************
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
+ include 'COMMON.IOUNITS'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
- dimension drt(3,3,maxres),rdt(3,3,maxres),dp(3,3),temp(3,3),
- & fromto(3,3,maxdim),prordt(3,3,maxres),prodrt(3,3,maxres)
- dimension xx(3),xx1(3)
- common /przechowalnia/ fromto
+ double precision drt(3,3,maxres),rdt(3,3,maxres),dp(3,3),
+ &temp(3,3),prordt(3,3,maxres),prodrt(3,3,maxres)
+ double precision xx(3),xx1(3),alphi,omegi,xj,dpjk,yp,xp,xxp,yyp
+ double precision cosalphi,sinalphi,cosomegi,sinomegi,theta2,
+ & cost2,sint2,rj,dxoiij,tempkl,dxoijk,dsci,zzp,dj,dpkl
+ double precision fromto(3,3)
+ integer i,ii,j,jjj,k,l,m,indi,ind,ind1
* get the position of the jth ijth fragment of the chain coordinate system
* in the fromto array.
+ integer indmat
indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
+ call chainbuild_extconf
+ call cartprint
+ call intout
*
* calculate the derivatives of transformation matrix elements in theta
*
drt(3,3,i)=-rt(2,3,i)
enddo
*
-* generate the matrix products of type r(i)t(i)...r(j)t(j)
-*
- do i=2,nres-2
- ind=indmat(i,i+1)
- do k=1,3
- do l=1,3
- temp(k,l)=rt(k,l,i)
- enddo
- enddo
- do k=1,3
- do l=1,3
- fromto(k,l,ind)=temp(k,l)
- enddo
- enddo
- do j=i+1,nres-2
- ind=indmat(i,j+1)
- do k=1,3
- do l=1,3
- dpkl=0.0d0
- do m=1,3
- dpkl=dpkl+temp(k,m)*rt(m,l,j)
- enddo
- dp(k,l)=dpkl
- fromto(k,l,ind)=dpkl
- enddo
- enddo
- do k=1,3
- do l=1,3
- temp(k,l)=dp(k,l)
- enddo
- enddo
- enddo
- enddo
-*
* Calculate derivatives.
*
ind1=0
do i=1,nres-2
- ind1=ind1+1
+ ind1=ind1+1
*
* Derivatives of DC(i+1) in theta(i+2)
*
+c write (iout,*) "theta i",i
+c write(iout,'(7hprod 9f10.5)')((prod(k,l,i),l=1,3),k=1,3)
+c write(iout,'(7hrdt 9f10.5)')((rdt(k,l,i),l=1,3),k=1,3)
+c write(iout,*) "vbld",vbld(i+2)
do j=1,3
do k=1,2
dpjk=0.0D0
prordt(j,k,i)=dp(j,k)
enddo
dp(j,3)=0.0D0
- dcdv(j,ind1)=vbld(i+1)*dp(j,1)
+c dcdv(j,ind1)=vbld(i+1)*dp(j,1)
+ dcdv(j,ind1)=vbld(i+2)*dp(j,1)
enddo
+c write(iout,'(7hdcdv 3f10.5)')(dcdv(k,ind1),k=1,3)
*
* Derivatives of SC(i+1) in theta(i+2)
*
enddo
dxdv(j,ind1)=rj
enddo
+c write (iout,*) "dxdv",(dxdv(j,ind1),j=1,3)
*
* Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
* than the other off-diagonal derivatives.
enddo
dxdv(j,ind1+1)=dxoiij
enddo
-cd print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
+c write(iout,*)ind1+1,(dxdv(j,ind1+1),j=1,3)
*
* Derivatives of DC(i+1) in phi(i+2)
*
dp(j,k)=dpjk
prodrt(j,k,i)=dp(j,k)
enddo
- dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
+c dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
+ dcdv(j+3,ind1)=vbld(i+2)*dp(j,1)
enddo
*
* Derivatives of SC(i+1) in phi(i+2)
* theta(nres) and phi(i+3) thru phi(nres).
*
do j=i+1,nres-2
- ind1=ind1+1
- ind=indmat(i+1,j+1)
-cd print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
+ ind1=ind1+1
+ ind=indmat(i+1,j+1)
+c write(iout,*)'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
+ call build_fromto(i+1,j+1,fromto)
+c write(iout,'(7hfromto 9f10.5)')((fromto(k,l),l=1,3),k=1,3)
do k=1,3
do l=1,3
tempkl=0.0D0
do m=1,2
- tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
+ tempkl=tempkl+prordt(k,m,i)*fromto(m,l)
enddo
temp(k,l)=tempkl
enddo
enddo
-cd print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
-cd print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
-cd print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
+c write(iout,'(7hfromto 9f10.5)')((fromto(k,l,ind),l=1,3),k=1,3)
+c write(iout,'(7hprod 9f10.5)')((prod(k,l,i),l=1,3),k=1,3)
+c write(iout,'(7htemp 9f10.5)')((temp(k,l),l=1,3),k=1,3)
* Derivatives of virtual-bond vectors in theta
do k=1,3
- dcdv(k,ind1)=vbld(i+1)*temp(k,1)
+c dcdv(k,ind1)=vbld(i+1)*temp(k,1)
+ dcdv(k,ind1)=vbld(j+2)*temp(k,1)
enddo
-cd print '(3f8.3)',(dcdv(k,ind1),k=1,3)
+c write(iout,'(7hdcdv 3f10.5)')(dcdv(k,ind1),k=1,3)
* Derivatives of SC vectors in theta
do k=1,3
dxoijk=0.0D0
enddo
dxdv(k,ind1+1)=dxoijk
enddo
+c write(iout,'(7htheta 3f10.5)')(dxdv(k,ind1),k=1,3)
*
*--- Calculate the derivatives in phi
*
+#ifdef FIVEDIAG
+ do k=1,3
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,3
+ tempkl=tempkl+prodrt(k,m,i)*fromto(m,l)
+ enddo
+ temp(k,l)=tempkl
+ enddo
+ enddo
+#else
do k=1,3
do l=1,3
tempkl=0.0D0
temp(k,l)=tempkl
enddo
enddo
+#endif
do k=1,3
- dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
- enddo
+c dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
+ dcdv(k+3,ind1)=vbld(j+2)*temp(k,1)
+ enddo
do k=1,3
dxoijk=0.0D0
do l=1,3
enddo
enddo
enddo
+#ifdef DEBUG
+ write (iout,*)
+ write (iout,'(a)') '****************** ddc/dtheta'
+ write (iout,*)
+ do i=1,nres-2
+ do j=i+1,nres-1
+ ii = indmat(i,j)
+ write (iout,'(2i4,3e14.6)') i,j,(dcdv(k,ii),k=1,3)
+ enddo
+ enddo
+ write (iout,*)
+ write (iout,'(a)') '******************* ddc/dphi'
+ write (iout,*)
+ do i=1,nres-3
+ do j=i+2,nres-1
+ ii = indmat(i+1,j)
+ write (iout,'(2i4,3e14.6)') i,j,(dcdv(k+3,ii),k=1,3)
+ write (iout,'(a)')
+ enddo
+ enddo
+ write (iout,'(a)')
+ write (iout,'(a)') '**************** dx/dtheta'
+ write (iout,'(a)')
+ do i=3,nres
+ do j=i-1,nres-1
+ ii = indmat(i-2,j)
+ write (iout,'(2i4,3e14.6)') i,j,(dxdv(k,ii),k=1,3)
+ enddo
+ enddo
+ write (iout,'(a)')
+ write (iout,'(a)') '***************** dx/dphi'
+ write (iout,'(a)')
+ do i=4,nres
+ do j=i-1,nres-1
+ ii = indmat(i-2,j)
+ write (iout,'(2i4,3e14.6)') i,j,(dxdv(k+3,ii),k=1,3)
+ write(iout,'(a)')
+ enddo
+ enddo
+#endif
*
* Derivatives in alpha and omega:
*
if(alphi.ne.alphi) alphi=100.0
if(omegi.ne.omegi) omegi=-100.0
#else
- alphi=alph(i)
- omegi=omeg(i)
+ alphi=alph(i)
+ omegi=omeg(i)
#endif
cd print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
- cosalphi=dcos(alphi)
- sinalphi=dsin(alphi)
- cosomegi=dcos(omegi)
- sinomegi=dsin(omegi)
- temp(1,1)=-dsci*sinalphi
- temp(2,1)= dsci*cosalphi*cosomegi
- temp(3,1)=-dsci*cosalphi*sinomegi
- temp(1,2)=0.0D0
- temp(2,2)=-dsci*sinalphi*sinomegi
- temp(3,2)=-dsci*sinalphi*cosomegi
- theta2=pi-0.5D0*theta(i+1)
- cost2=dcos(theta2)
- sint2=dsin(theta2)
- jjj=0
+ cosalphi=dcos(alphi)
+ sinalphi=dsin(alphi)
+ cosomegi=dcos(omegi)
+ sinomegi=dsin(omegi)
+ temp(1,1)=-dsci*sinalphi
+ temp(2,1)= dsci*cosalphi*cosomegi
+ temp(3,1)=-dsci*cosalphi*sinomegi
+ temp(1,2)=0.0D0
+ temp(2,2)=-dsci*sinalphi*sinomegi
+ temp(3,2)=-dsci*sinalphi*cosomegi
+ theta2=pi-0.5D0*theta(i+1)
+ cost2=dcos(theta2)
+ sint2=dsin(theta2)
+ jjj=0
cd print *,((temp(l,k),l=1,3),k=1,2)
do j=1,2
- xp=temp(1,j)
- yp=temp(2,j)
- xxp= xp*cost2+yp*sint2
- yyp=-xp*sint2+yp*cost2
- zzp=temp(3,j)
- xx(1)=xxp
- xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
- xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
- do k=1,3
- dj=0.0D0
- do l=1,3
- dj=dj+prod(k,l,i-1)*xx(l)
+ xp=temp(1,j)
+ yp=temp(2,j)
+ xxp= xp*cost2+yp*sint2
+ yyp=-xp*sint2+yp*cost2
+ zzp=temp(3,j)
+ xx(1)=xxp
+ xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
+ xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
+ do k=1,3
+ dj=0.0D0
+ do l=1,3
+ dj=dj+prod(k,l,i-1)*xx(l)
enddo
- dxds(jjj+k,i)=dj
+ dxds(jjj+k,i)=dj
enddo
- jjj=jjj+3
- enddo
+ jjj=jjj+3
+ enddo
enddo
return
end
-
subroutine cartprint
- implicit real*8 (a-h,o-z)
+ implicit none
+ integer i
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
C Build the virtual polypeptide chain. Side-chain centroids are moveable.
C As of 2/17/95.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
C Build the virtual polypeptide chain. Side-chain centroids are moveable.
C As of 2/17/95.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.INTERACT'
+ integer i,j
double precision e1(3),e2(3),e3(3)
+ double precision be,be1,alfai
+ double precision xp,yp,zp,cost2,sint2,cosomegi,sinomegi
+ double precision dist,alpha,beta
logical lprn,perbox,fail
lprn=.false.
C Define the origin and orientation of the coordinate system and locate
C the first three atoms.
C
- implicit real*8 (a-h,o-z)
+ implicit none
+ integer i,j
+ double precision cost,sint
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
C
C Locate CA(i) and SC(i-1)
C
- implicit real*8 (a-h,o-z)
+ implicit none
+ integer i,j
+ double precision theti,phii,cost,sint,cosphi,sinphi
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
C
C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i).
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.INTERACT'
- dimension xx(3)
+ integer i,j,k
+ double precision xx(3)
+ double precision dsci,dsci_inv,alphi,omegi,cosalphi,sinalphi,
+ & cosomegi,sinomegi,xp,yp,zp,theta2,cost2,sint2,rj
c dsci=dsc(itype(i))
c dsci_inv=dsc_inv(itype(i))
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.HAIRPIN'
C change suggested by Ana - begin
integer allareout
+ integer i,j
C change suggested by Ana - end
j=1
chain_beg=1
subroutine check_bond
+ implicit none
+ integer i,it
C Subroutine is checking if the fitted function which describs sc_rot_pot
C is correct, printing, alpha,beta, energy, data - for some known theta.
C theta angle is read from the input file. Sc_rot_pot are printed
- subroutine check_cartgrad
-C Check the gradient of Cartesian coordinates in internal coordinates.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.DERIV'
- dimension temp(6,maxres),xx(3),gg(3)
- indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
-*
-* Check the gradient of the virtual-bond and SC vectors in the internal
-* coordinates.
-*
- print '("Calling CHECK_ECART",1pd12.3)',aincr
- write (iout,'("Calling CHECK_ECART",1pd12.3)') aincr
- aincr2=0.5d0*aincr
- call cartder
- write (iout,'(a)') '**************** dx/dalpha'
- write (iout,'(a)')
- do i=2,nres-1
- alphi=alph(i)
- alph(i)=alph(i)+aincr
- do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
- do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
- & i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- alph(i)=alphi
- call chainbuild
- enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/domega'
- write (iout,'(a)')
- do i=2,nres-1
- omegi=omeg(i)
- omeg(i)=omeg(i)+aincr
- do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
- do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k+3,i))/
- & (aincr*dabs(dxds(k+3,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
- & i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- omeg(i)=omegi
- call chainbuild
- enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/dtheta'
- write (iout,'(a)')
- do i=3,nres
- theti=theta(i)
- theta(i)=theta(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-c print *,'i=',i-2,' j=',j-1,' ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k,ii))/
- & (aincr*dabs(dxdv(k,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- write (iout,'(a)')
- theta(i)=theti
- call chainbuild
- enddo
- write (iout,'(a)') '***************** dx/dphi'
- write (iout,'(a)')
- do i=4,nres
- phi(i)=phi(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-c print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k+3,ii))/
- & (aincr*dabs(dxdv(k+3,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- phi(i)=phi(i)-aincr
- call chainbuild
- enddo
- write (iout,'(a)') '****************** ddc/dtheta'
- do i=1,nres-2
- thet=theta(i+2)
- theta(i+2)=thet+aincr
- do j=i,nres
- do k=1,3
- temp(k,j)=dc(k,j)
- enddo
- enddo
- call chainbuild
- do j=i+1,nres-1
- ii = indmat(i,j)
-c print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k,ii))/
- & (aincr*dabs(dcdv(k,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- enddo
- do j=1,nres
- do k=1,3
- dc(k,j)=temp(k,j)
- enddo
- enddo
- theta(i+2)=thet
- enddo
- write (iout,'(a)') '******************* ddc/dphi'
- do i=1,nres-3
- phii=phi(i+3)
- phi(i+3)=phii+aincr
- do j=1,nres
- do k=1,3
- temp(k,j)=dc(k,j)
- enddo
- enddo
- call chainbuild
- do j=i+2,nres-1
- ii = indmat(i+1,j)
-c print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k+3,ii))/
- & (aincr*dabs(dcdv(k+3,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- enddo
- do j=1,nres
- do k=1,3
- dc(k,j)=temp(k,j)
- enddo
- enddo
- phi(i+3)=phii
- enddo
- return
- end
C----------------------------------------------------------------------------
subroutine check_ecart
C Check the gradient of the energy in Cartesian coordinates.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.VAR'
include 'COMMON.CONTACTS'
+ integer i,j,k
+ integer icall
common /srutu/ icall
- dimension ggg(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),g(maxvar)
- dimension grad_s(6,maxres)
+ double precision ggg(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),
+ & g(maxvar),grad_s(6,maxres)
double precision energia(0:n_ene),energia1(0:n_ene)
+ double precision aincr2,etot,etot1,etot2
+ double precision dist,alpha,beta
+ double precision funcgrad,ff
+ external funcgrad
+ integer nf
integer uiparm(1)
double precision urparm(1)
+ double precision fdum
external fdum
icg=1
nf=0
call etotal(energia(0))
etot=energia(0)
call enerprint(energia(0))
+#ifdef LBFGS
+ ff=funcgrad(x,g)
+#else
call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
+#endif
icall =1
do i=1,nres
write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
c----------------------------------------------------------------------------
subroutine check_ecartint
C Check the gradient of the energy in Cartesian coordinates.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.CHAIN'
include 'COMMON.MD'
include 'COMMON.LOCAL'
include 'COMMON.SPLITELE'
+ integer icall
common /srutu/ icall
- dimension ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),
- & g(maxvar)
- dimension dcnorm_safe(3),dxnorm_safe(3)
- dimension grad_s(6,0:maxres),grad_s1(6,0:maxres)
+ double precision ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3),
+ & x(maxvar),g(maxvar)
+ double precision dcnorm_safe(3),dxnorm_safe(3)
+ double precision grad_s(6,0:maxres),grad_s1(6,0:maxres)
double precision phi_temp(maxres),theta_temp(maxres),
& alph_temp(maxres),omeg_temp(maxres)
double precision energia(0:n_ene),energia1(0:n_ene)
integer uiparm(1)
double precision urparm(1)
external fdum
+ integer i,j,k,nf
+ double precision etot,etot1,etot2,etot11,etot12,etot21,etot22
+ double precision dist,alpha,beta
c r_cut=2.0d0
c rlambd=0.3d0
icg=1
nf=0
nfl=0
- print *,"ATU 3"
+c print *,"ATU 3"
call int_from_cart1(.false.)
call intout
c call intcartderiv
call etotal_long(energia(0))
call enerprint(energia(0))
call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
+c write (iout,*) "enter cartgrad"
+c call flush(iout)
call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
+c write (iout,*) "exit cartgrad"
+c call flush(iout)
icall =1
write (iout,*) "longrange grad"
do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
+ write (iout,'(i4,3e12.4,3x,3e12.4)') i,(gcart(j,i),j=1,3),
& (gxcart(j,i),j=1,3)
enddo
do j=1,3
call etotal_short(energia(0))
call enerprint(energia(0))
call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
+c write (iout,*) "enter cartgrad"
+c call flush(iout)
call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
+c write (iout,*) "exit cartgrad"
+c call flush(iout)
icall =1
write (iout,*) "shortrange grad"
do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
+ write (iout,'(i4,3e12.4,3x,3e12.4)') i,(gcart(j,i),j=1,3),
& (gxcart(j,i),j=1,3)
enddo
do j=1,3
end
c-------------------------------------------------------------------------
subroutine int_from_cart1(lprn)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.SETUP'
include 'COMMON.TIME1'
logical lprn
+ integer i,j
+ double precision dnorm1,dnorm2,be
+ double precision time00
+ double precision dist,alpha,beta
if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates'
#ifdef TIMING
time01=MPI_Wtime()
c----------------------------------------------------------------------------
subroutine check_eint
C Check the gradient of energy in internal coordinates.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.VAR'
include 'COMMON.GEO'
+ integer icall
common /srutu/ icall
- dimension x(maxvar),gana(maxvar),gg(maxvar)
+ double precision x(maxvar),gana(maxvar),gg(maxvar)
integer uiparm(1)
double precision urparm(1)
double precision energia(0:n_ene),energia1(0:n_ene),
& energia2(0:n_ene)
character*6 key
+ double precision fdum
external fdum
+ double precision funcgrad,ff
+ external funcgrad
+ integer i,ii,nf
+ double precision xi,etot,etot1,etot2
call zerograd
c aincr=1.0D-7
print '("Calling CHECK_INT",1pd12.3)',aincr
nf=1
nfl=3
cd write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
+c write (iout,*) "Before gradient"
+c call flush(iout)
+#ifdef LBFGS
+ ff=funcgrad(x,gana)
+#else
call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
+#endif
+c write (iout,*) "After gradient"
+c call flush(iout)
cd write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar)
icall=1
do i=1,nvar
call etotal(energia2(0))
etot2=energia2(0)
gg(i)=(etot2-etot1)/aincr
- write (iout,*) i,etot1,etot2
+c write (iout,*) i,etot1,etot2
x(i)=xi
enddo
write (iout,'(/2a)')' Variable Numerical Analytical',
kkk=0
c print *,'nnt=',nnt,' nct=',nct
do i=nnt,nct-3
+ if (itype(i).eq.ntyp1) cycle
do k=1,3
c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1))
enddo
do j=i+2,nct-1
do k=1,3
+ if (itype(j).eq.ntyp1) cycle
c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1))
enddo
if (dist(2*nres+1,2*nres+2).lt.rcomp) then
C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1
C thru 2*nre-4+2*nside
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.CHAIN'
+ integer n,i
double precision x(n)
cd print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar
do i=4,nres
C
C Update geometry parameters according to the variable array.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
- dimension x(n)
+ integer n
+ integer i,ii
+ double precision x(n)
logical change,reduce
+ double precision pinorm
change=reduce(x)
if (n.gt.nphi+ntheta) then
do i=1,nside
C
C Apply periodic restrictions to variables.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.GEO'
logical zm,zmiana,convert_side
- dimension x(nvar)
+ integer i,ii,iii
+ double precision x(nvar)
+ double precision thetnorm,pinorm
zmiana=.false.
do i=4,nres
x(i-3)=pinorm(x(i-3))
C
C Update geometry parameters according to the variable array.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
- dimension x(maxvar),xx(maxvar)
+ integer n,i,ii
+ double precision x(maxvar),xx(maxvar)
logical change,reduce
+ double precision pinorm
call xx2x(x,xx)
change=reduce(x)
+++ /dev/null
- subroutine dEconstrQ_num
-c Calculating numerical dUconst/ddc and dUconst/ddx
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision uzap1,uzap2
- double precision dUcartan(3,0:MAXRES)
- & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES)
- integer kstart,kend,lstart,lend,idummy
- double precision delta /1.0d-7/
-c For the backbone
- do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.
- & ,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.
- & ,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
-c Calculating numerical gradients for dU/ddx
- do i=0,nres-1
- duxcartan(j,i)=0.0d0
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.
- & ,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),
- & ifrag(2,ii,iset),.true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
- write(iout,*) "Numerical dUconst/ddc backbone "
- do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
- enddo
-c write(iout,*) "Numerical dUconst/ddx side-chain "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
-c enddo
- return
- end
-c---------------------------------------------------------------------------
-
subroutine Econstr_back
c MD with umbrella_sampling using Wolyne's distance measure as a constraint
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
+ integer i,j,ii,k
+ double precision utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
+ double precision pinorm
Uconst_back=0.0d0
do i=1,nres
dutheta(i)=0.0d0
subroutine Econstr_back_qlike
c MD with umbrella_sampling using Wolyne's distance measure as a constraint
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
+ integer i,ii,j,k
+ double precision utheta_i,dtheta_i,expthet,ugamma_i,dgamma_i,
+ & expgam,usc_i,dxx,dyy,dzz,expsc
double precision sigmaang/0.1d0/,sigmadih /0.1d0/,sigmasc /0.1d0/
c double precision sigmaang/0.2d0/,sigmadih /0.4d0/,sigmasc /0.5d0/
double precision auxvec(maxres),auxtab(3,maxres),
& auxtab1(3,maxres),auxtabx(3,maxres)
+ double precision pinorm
Uconst_back=0.0d0
do i=1,nres
dutheta(i)=0.0d0
subroutine EconstrQ
c MD with umbrella_sampling using Wolyne's distance measure as a constraint
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
#endif
include 'COMMON.CONTROL'
include 'COMMON.VAR'
- include 'COMMON.MD'
+c include 'COMMON.MD'
+ include 'COMMON.QRESTR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
& duconst(3,0:MAXRES),duxconst(3,0:MAXRES)
integer kstart,kend,lstart,lend,idummy
double precision delta /1.0d-7/
+ integer i,ii,j,k
+ double precision qwolynes,harmonic,harmonicprim
+ double precision ePMF,ePMF_q
do i=0,nres
do j=1,3
duconst(j,i)=0.0d0
write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
enddo
#endif
-c Calculating numerical gradients of dU/dQi and dQi/dxi
-c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
-c & ,idummy,idummy)
c The gradients of Uconst in Cs
do ii=0,nres
do j=1,3
c do ii=1,nres
c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
c enddo
-c Calculating numerical gradients
-c call qwol_num(kstart,kend,.false.
-c & ,lstart,lend)
c The gradients of Uconst in Cs
do ii=0,nres
do j=1,3
write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
enddo
#endif
-c Calculating numerical gradients of dUconst/ddc and dUconst/ddx
-c call dEconstrQ_num
return
end
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
c do ii=1,nres
c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
c enddo
-c Calculating numerical gradients of dU/dQi and dQi/dxi
-c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
-c & ,idummy,idummy)
c The gradients of Uconst in Cs
do ii=0,nres
do j=1,3
c do ii=1,nres
c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
c enddo
-c Calculating numerical gradients
-c call qwol_num(kstart,kend,.false.
-c & ,lstart,lend)
c The gradients of Uconst in Cs
do ii=0,nres
do j=1,3
c do ii=1,nres
c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
c enddo
-c Calculating numerical gradients of dUconst/ddc and dUconst/ddx
-c call dEconstrQ_num
return
end
double precision app_(2,2),bpp_(2,2),rpp_(2,2)
integer ncont,icont(2,maxcont)
double precision econt(maxcont)
+ integer xshift,yshift,zshift
*
* Load the constants of peptide bond - peptide bond interactions.
* Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g.
xmedi=xi+0.5*dxi
ymedi=yi+0.5*dyi
zmedi=zi+0.5*dzi
+c write (iout,*) "i",xmedi,ymedi,zmedi
xmedi=mod(xmedi,boxxsize)
if (xmedi.lt.0) xmedi=xmedi+boxxsize
ymedi=mod(ymedi,boxysize)
if (ymedi.lt.0) ymedi=ymedi+boxysize
zmedi=mod(zmedi,boxzsize)
if (zmedi.lt.0) zmedi=zmedi+boxzsize
+c write (iout,*) "i",xmedi,ymedi,zmedi
do 4 j=i+2,nct-1
+c write (iout,*) "i",i," j",j
if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) goto 4
ind=ind+1
iteli=itel(i)
xj=c(1,j)+0.5*dxj
yj=c(2,j)+0.5*dyj
zj=c(3,j)+0.5*dzj
+c write (iout,*) "j",xj,yj,zj
xj=mod(xj,boxxsize)
if (xj.lt.0) xj=xj+boxxsize
yj=mod(yj,boxysize)
if (yj.lt.0) yj=yj+boxysize
zj=mod(zj,boxzsize)
if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+c write (iout,*) "j",xj,yj,zj
+ dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+c write (iout,*) "dist",dsqrt(dist_init)
xj_safe=xj
yj_safe=yj
zj_safe=zj
xj=xj_safe+xshift*boxxsize
yj=yj_safe+yshift*boxysize
zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+c write (iout,*) "shift",xshift,yshift,zshift," dist_temp",
+c & dist_temp," dist_init",dist_init
if(dist_temp.lt.dist_init) then
dist_init=dist_temp
xj_temp=xj
zj=zj_safe-zmedi
endif
rij=xj*xj+yj*yj+zj*zj
- sss=sscale(sqrt(rij))
- sssgrad=sscagrad(sqrt(rij))
rrmij=1.0/(xj*xj+yj*yj+zj*zj)
rmij=sqrt(rrmij)
r3ij=rrmij*rmij
econt(ncont)=eesij
endif
ees=ees+eesij
- evdw=evdw+evdwij*sss
+c write (iout,*) "i"," j",j," rij",dsqrt(rij)," eesij",eesij
4 continue
1 continue
if (lprint) then
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.CONTROL'
C-----------------------------------------------------------------------
double precision function sscalelip(r)
+ implicit none
double precision r,gamm
include "COMMON.SPLITELE"
C if(r.lt.r_cut-rlamb) then
end
C-----------------------------------------------------------------------
double precision function sscagradlip(r)
+ implicit none
double precision r,gamm
include "COMMON.SPLITELE"
C if(r.lt.r_cut-rlamb) then
end
C-----------------------------------------------------------------------
- double precision function sscale(r)
- double precision r,gamm
+ double precision function sscale(r,r_cut)
+ implicit none
+ double precision r,r_cut,gamm
include "COMMON.SPLITELE"
if(r.lt.r_cut-rlamb) then
sscale=1.0d0
return
end
C-----------------------------------------------------------------------
-C-----------------------------------------------------------------------
- double precision function sscagrad(r)
- double precision r,gamm
+ double precision function sscagrad(r,r_cut)
+ implicit none
+ double precision r,r_cut,gamm
include "COMMON.SPLITELE"
if(r.lt.r_cut-rlamb) then
sscagrad=0.0d0
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the LJ potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
- parameter (accur=1.0d-10)
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.LOCAL'
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
+ include "COMMON.SPLITELE"
+c include 'COMMON.CONTACTS'
+ double precision gg(3)
+ double precision evdw,evdwij
+ integer i,j,k,itypi,itypj,itypi1,num_conti,iint
+ double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij,
+ & sigij,r0ij,rcut,sss1,sssgrad1,sqrij
+ double precision sscale,sscagrad
c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
+ sqrij=dsqrt(rrij)
+ eps0ij=eps(itypi,itypj)
+ sss1=sscale(sqrij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(sqrij,r_cut_int)
+ sssgrad=
+ & sscagrad(sqrij/sigma(itypi,itypj),r_cut_respa)
+ sss=sscale(sqrij/sigma(itypi,itypj),r_cut_respa)
if (sss.lt.1.0d0) then
rrij=1.0D0/rij
- eps0ij=eps(itypi,itypj)
fac=rrij**expon2
e1=fac*fac*aa
e2=fac*bb
evdwij=e1+e2
- evdw=evdw+(1.0d0-sss)*evdwij
+ evdw=evdw+(1.0d0-sss)*sss1*evdwij/sqrij/expon
C
C Calculate the components of the gradient in DC and X
C
- fac=-rrij*(e1+evdwij)*(1.0d0-sss)
+ fac=-rrij*(e1+evdwij)*(1.0d0-sss)*sss1
+ & +evdwij*(-sss1*sssgrad/sigma(itypi,itypj)
+ & +(1.0d0-sss)*sssgrad1)/sqrij
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the LJ potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
- parameter (accur=1.0d-10)
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.LOCAL'
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
+ include "COMMON.SPLITELE"
+c include 'COMMON.CONTACTS'
+ double precision gg(3)
+ double precision evdw,evdwij
+ integer i,j,k,itypi,itypj,itypi1,num_conti,iint
+ double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij,
+ & sigij,r0ij,rcut,sqrij,sss1,sssgrad1
+ double precision sscale,sscagrad
c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
C Change 12/1/95 to calculate four-body interactions
rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
+ sqrij=dsqrt(rij)
+ sss=sscale(sqrij/sigma(itypi,itypj),r_cut_respa)
if (sss.gt.0.0d0) then
+ sssgrad=
+ & sscagrad(sqrij/sigma(itypi,itypj),r_cut_respa)
rrij=1.0D0/rij
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
C
C Calculate the components of the gradient in DC and X
C
- fac=-rrij*(e1+evdwij)*sss
+ fac=-rrij*(e1+evdwij)*sss+evdwij*sssgrad/sqrij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the LJK potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
- dimension gg(3)
+ include "COMMON.SPLITELE"
+ double precision gg(3)
+ double precision evdw,evdwij
+ integer i,j,k,itypi,itypj,itypi1,iint
+ double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij,
+ & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1
logical scheck
+ double precision sscale,sscagrad
c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
e_augm=augm(itypi,itypj)*fac_augm
r_inv_ij=dsqrt(rrij)
rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
+ sss1=sscale(rij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(rij,r_cut_int)
+ sss=sscale(rij/sigma(itypi,itypj),r_cut_respa)
if (sss.lt.1.0d0) then
+ sssgrad=
+ & sscagrad(rij/sigma(itypi,itypj),r_cut_respa)
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
e1=fac*fac*aa
cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+(1.0d0-sss)*evdwij
+ evdw=evdw+(1.0d0-sss)*sss1*evdwij
C
C Calculate the components of the gradient in DC and X
C
fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- fac=fac*(1.0d0-sss)
+ fac=fac*(1.0d0-sss)*sss1
+ & +evdwij*(-sss1*sssgrad/sigma(itypi,itypj)
+ & +(1.0d0-sss)*sssgrad1)*r_inv_ij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
- dimension gg(3)
+ include "COMMON.SPLITELE"
+ double precision gg(3)
+ double precision evdw,evdwij
+ integer i,j,k,itypi,itypj,itypi1,iint
+ double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij,
+ & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1
logical scheck
+ double precision sscale,sscagrad
c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
e_augm=augm(itypi,itypj)*fac_augm
r_inv_ij=dsqrt(rrij)
rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
+ sss=sscale(rij/sigma(itypi,itypj),r_cut_respa)
if (sss.gt.0.0d0) then
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
C Calculate the components of the gradient in DC and X
C
fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
+ & +evdwij*sssgrad/sigma(itypi,itypj)*r_inv_ij/expon
fac=fac*sss
gg(1)=xj*fac
gg(2)=yj*fac
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the Berne-Pechukas potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include "COMMON.SPLITELE"
+ integer icall
common /srutu/ icall
+ double precision evdw
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
+ double precision sss1,sssgrad1
+ double precision sscale,sscagrad
c double precision rrsave(maxdim)
logical lprn
evdw=0.0D0
c endif
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
dzj=dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
+ sss1=sscale(1.0d0/rij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
if (sss.lt.1.0d0) then
-
+ sssgrad=
+ & sscagrad(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
+ sssgrad1=sscagrad(1.0d0/rij,r_cut_int)
C Calculate the angle-dependent terms of energy & contributions to derivatives.
call sc_angular
C Calculate whole angle-dependent part of epsilon and contributions
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
+ evdw=evdw+evdwij*(1.0d0-sss)*sss1
if (lprn) then
sigm=dabs(aa/bb)**(1.0D0/6.0D0)
epsi=bb**2/aa
e1=e1*eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)
sigder=fac/sigsq
- fac=rrij*fac
+ fac=(fac+evdwij*(sss1/(1.0d0-sss)*sssgrad/
+ & sigmaii(itypi,itypj)+(1.0d0-sss)/sss1*sssgrad1))*rij
C Calculate radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
C Calculate the angular part of the gradient and sum add the contributions
C to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(1.0d0-sss)
+ call sc_grad_scale((1.0d0-sss)*sss1)
endif
enddo ! j
enddo ! iint
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include "COMMON.SPLITELE"
+ integer icall
common /srutu/ icall
+ double precision evdw
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
+ double precision sscale,sscagrad
c double precision rrsave(maxdim)
logical lprn
evdw=0.0D0
c endif
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
dzj=dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
if (sss.gt.0.0d0) then
e1=e1*eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)
sigder=fac/sigsq
- fac=rrij*fac
+ fac=(fac+evdwij*sssgrad/sss/sigmaii(itypi,itypj))*rrij
C Calculate radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the Gay-Berne potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
include 'COMMON.CONTROL'
+ include "COMMON.SPLITELE"
logical lprn
integer xshift,yshift,zshift
+ double precision evdw
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
+ double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij,
+ & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
+ double precision dist,sscale,sscagrad,sscagradlip,sscalelip
+ double precision subchap,sss1,sssgrad1
evdw=0.0D0
ccccc energy_dec=.false.
c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
c if (icall.eq.0) lprn=.false.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot)
- &.and.(zj.lt.bordliptop)) then
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot).and.(zj.lt.bordliptop)) then
C the energy transfer exist
- if (zj.lt.buflipbot) then
+ if (zj.lt.buflipbot) then
C what fraction I am in
- fracinbuf=1.0d0-
- & ((positi-bordlipbot)/lipbufthick)
+ fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
-
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj))
- if (sss.lt.1.0d0) then
-
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ else if (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if (dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+ sss1=sscale(1.0d0/rij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
+ if (sss.lt.1.0d0) then
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
+ sssgrad=
+ & sscagrad((1.0d0/rij)/sigmaii(itypi,itypj),r_cut_respa)
+ sssgrad1=sscagrad(1.0d0/rij,r_cut_int)
call sc_angular
sigsq=1.0D0/sigsq
sig=sig0ij*dsqrt(sigsq)
c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
+ evdw=evdw+evdwij*(1.0d0-sss)*sss1
if (lprn) then
sigm=dabs(aa/bb)**(1.0D0/6.0D0)
epsi=bb**2/aa
& evdwij
endif
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
+ if (energy_dec) write (iout,'(a6,2i5,4f10.5)')
+ & 'evdw',i,j,rij,sss,sss1,evdwij
C Calculate gradient components.
e1=e1*eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
- fac=rij*fac
- fac=fac+evdwij/(1.0-sss)*(-sssgrad)/sigmaii(itypi,itypj)*rij
+ fac=(fac+evdwij*(-sss1*sssgrad/(1.0d0-sss)
+ & /sigmaii(itypi,itypj)+(1.0d0-sss)*sssgrad1/sss1))*rij
c fac=0.0d0
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg_lipi(3)=ssgradlipi*evdwij
gg_lipj(3)=ssgradlipj*evdwij
C Calculate angular part of the gradient.
- call sc_grad_scale(1.0d0-sss)
+ call sc_grad_scale((1.0d0-sss)*sss1)
endif
enddo ! j
enddo ! iint
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the Gay-Berne potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
include 'COMMON.CONTROL'
+ include "COMMON.SPLITELE"
logical lprn
integer xshift,yshift,zshift
+ double precision evdw
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
+ double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij,
+ & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
+ double precision dist,sscale,sscagrad,sscagradlip,sscalelip
+ double precision subchap
evdw=0.0D0
ccccc energy_dec=.false.
c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
c if (icall.eq.0) lprn=.false.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot)
- &.and.(zj.lt.bordliptop)) then
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
+ if ((zj.gt.bordlipbot).and.(zj.lt.bordliptop)) then
C the energy transfer exist
- if (zj.lt.buflipbot) then
+ if (zj.lt.buflipbot) then
C what fraction I am in
- fracinbuf=1.0d0-
- & ((positi-bordlipbot)/lipbufthick)
+ fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
- & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipj=sscalelip(fracinbuf)
+ ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipj=1.0d0
+ ssgradlipj=0.0
+ endif
+ else
+ sslipj=0.0d0
+ ssgradlipj=0.0
+ endif
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+ & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ subchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj))
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
+ sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj),r_cut_respa)
if (sss.gt.0.0d0) then
C Calculate angle-dependent terms of energy and contributions to their
e1=e1*eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
- fac=rij*fac
- fac=fac+evdwij/sss*sssgrad/sigmaii(itypi,itypj)*rij
+ fac=(fac+evdwij*sssgrad/sss/sigmaii(itypi,itypj))*rij
c fac=0.0d0
C Calculate the radial part of the gradient
gg(1)=xj*fac
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include "COMMON.SPLITELE"
+ integer icall
common /srutu/ icall
logical lprn
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,r0ij,
+ & xi,yi,zi,fac_augm,e_augm
+ double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij,
+ & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
+ double precision dist,sscale,sscagrad,sscagradlip,sscalelip
+ double precision sss1,sssgrad1
evdw=0.0D0
c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
c if (icall.eq.0) lprn=.true.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+ sss1=sscale(1.0d0/rij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
if (sss.lt.1.0d0) then
+ sssgrad=
+ & sscagrad((1.0d0/rij)/sigmaii(itypi,itypj),r_cut_respa)
+ sssgrad1=sscagrad(1.0d0/rij,r_cut_int)
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
+ evdw=evdw+(evdwij+e_augm)*sss1*(1.0d0-sss)
if (lprn) then
sigm=dabs(aa/bb)**(1.0D0/6.0D0)
epsi=bb**2/aa
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac-2*expon*rrij*e_augm
+ fac=fac+(evdwij+e_augm)*
+ & (-sss1*sssgrad/(1.0d0-sss)/sigmaii(itypi,itypj)
+ & +(1.0d0-sss)*sssgrad1/sss1)*rij
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
C Calculate angular part of the gradient.
- call sc_grad_scale(1.0d0-sss)
+ call sc_grad_scale((1.0d0-sss)*sss1)
endif
enddo ! j
enddo ! iint
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the Gay-Berne-Vorobjev potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include "COMMON.SPLITELE"
+ integer icall
common /srutu/ icall
logical lprn
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,r0ij,
+ & xi,yi,zi,fac_augm,e_augm
+ double precision evdw
+ double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij,
+ & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
+ double precision dist,sscale,sscagrad,sscagradlip,sscalelip
evdw=0.0D0
c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
c if (icall.eq.0) lprn=.true.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=iabs(itype(i))
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ 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))
if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
if (sss.gt.0.0d0) then
e1=e1*eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
+ fac=rij*fac-2*expon*rrij*e_augm+
+ & (evdwij+e_augm)*sssgrad/sigmaii(itypi,itypj)/sss*rij
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
include 'COMMON.DERIV'
include 'COMMON.CALC'
include 'COMMON.IOUNITS'
+ include "COMMON.SPLITELE"
double precision dcosom1(3),dcosom2(3)
double precision scalfac
eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
include 'COMMON.TIME1'
include 'COMMON.SHIELD'
+ include "COMMON.SPLITELE"
dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
& erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
eello_turn3=0.0d0
eello_turn4=0.0d0
ind=0
+#ifdef FOURBODY
do i=1,nres
num_cont_hb(i)=0
enddo
+#endif
cd print '(a)','Enter EELEC'
cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
do i=1,nres
num_conti=0
call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo
do i=iturn4_start,iturn4_end
if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
if (ymedi.lt.0) ymedi=ymedi+boxysize
zmedi=mod(zmedi,boxzsize)
if (zmedi.lt.0) zmedi=zmedi+boxzsize
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
& call eturn4(i,eello_turn4)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
c
c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
if (ymedi.lt.0) ymedi=ymedi+boxysize
zmedi=mod(zmedi,boxzsize)
if (zmedi.lt.0) zmedi=zmedi+boxzsize
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
do j=ielstart(i),ielend(i)
if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
C & .or.itype(j+2).eq.ntyp1
&) cycle
call eelecij_scale(i,j,ees,evdw1,eel_loc)
enddo ! j
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
c write (iout,*) "Number of loop steps in EELEC:",ind
cd do i=1,nres
end
C-------------------------------------------------------------------------------
subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
include 'COMMON.TIME1'
include 'COMMON.SHIELD'
+ include "COMMON.SPLITELE"
integer xshift,yshift,zshift
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
+ double precision ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
& erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
& aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
& gmuij2(4),gmuji2(4)
+ integer j1,j2,num_conti
common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
& dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
& num_conti,j1,j2
+ integer k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap,ind,itypi,itypj
+ integer ilist,iresshield
+ double precision rlocshield
+ double precision ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
+ double precision ees,evdw1,eel_loc,aaa,bbb,ael3i
+ double precision dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,
+ & rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,
+ & evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,
+ & ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,
+ & a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,
+ & ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,
+ & ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,
+ & ecosgp,ecosam,ecosbm,ecosgm,ghalf,geel_loc_ij,geel_loc_ji,
+ & dxi,dyi,dzi,a22,a23,a32,a33
+ double precision dist_init,xmedi,ymedi,zmedi,xj_safe,yj_safe,
+ & zj_safe,xj_temp,yj_temp,zj_temp,dist_temp,dx_normi,dy_normi,
+ & dz_normi,aux
+ double precision sss1,sssgrad1
+ double precision sscale,sscagrad
+ double precision scalar
+
c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
#ifdef MOMENT
double precision scal_el /1.0d0/
c time00=MPI_Wtime()
cd write (iout,*) "eelecij",i,j
C print *,"WCHODZE2"
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj
- yj=c(2,j)+0.5D0*dyj
- zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
+ ind=ind+1
+ iteli=itel(i)
+ itelj=itel(j)
+ if (j.eq.i+2 .and. itelj.eq.2) iteli=2
+ aaa=app(iteli,itelj)
+ bbb=bpp(iteli,itelj)
+ ael6i=ael6(iteli,itelj)
+ ael3i=ael3(iteli,itelj)
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ xj=mod(xj,boxxsize)
+ if (xj.lt.0) xj=xj+boxxsize
+ yj=mod(yj,boxysize)
+ if (yj.lt.0) yj=yj+boxysize
+ zj=mod(zj,boxzsize)
+ if (zj.lt.0) zj=zj+boxzsize
dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
xj_safe=xj
yj_safe=yj
zj_temp=zj
isubchap=1
endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- rmij=1.0D0/rij
+ rij=xj*xj+yj*yj+zj*zj
+ rrmij=1.0D0/rij
+ rij=dsqrt(rij)
+ rmij=1.0D0/rij
c For extracting the short-range part of Evdwpp
- sss=sscale(rij/rpp(iteli,itelj))
- sssgrad=sscagrad(rij/rpp(iteli,itelj))
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
+ sss1=sscale(rij,r_cut_int)
+ if (sss1.eq.0.0d0) return
+ sss=sscale(rij/rpp(iteli,itelj),r_cut_respa)
+ sssgrad=sscagrad(rij/rpp(iteli,itelj),r_cut_respa)
+ sssgrad1=sscagrad(rij,r_cut_int)
+ r3ij=rrmij*rmij
+ r6ij=r3ij*r3ij
+ cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
+ cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
+ cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
+ fac=cosa-3.0D0*cosb*cosg
+ ev1=aaa*r6ij*r6ij
c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- if (shield_mode.eq.0) then
- fac_shield(i)=1.0
- fac_shield(j)=1.0
- endif
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- el1=el1*fac_shield(i)**2*fac_shield(j)**2
- el2=el2*fac_shield(i)**2*fac_shield(j)**2
- eesij=el1+el2
+ if (j.eq.i+2) ev1=scal_el*ev1
+ ev2=bbb*r6ij
+ fac3=ael6i*r6ij
+ fac4=ael3i*r3ij
+ evdwij=ev1+ev2
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+ endif
+ el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
+ el2=fac4*fac
+ el1=el1*fac_shield(i)**2*fac_shield(j)**2
+ el2=el2*fac_shield(i)**2*fac_shield(j)**2
+ eesij=el1+el2
C 12/26/95 - for the evaluation of multi-body H-bonding interactions
- ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij
- evdw1=evdw1+evdwij*(1.0d0-sss)
+ ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
+ ees=ees+eesij*sss1
+ evdw1=evdw1+evdwij*(1.0d0-sss)*sss1
cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
cd & xmedi,ymedi,zmedi,xj,yj,zj
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
- write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
- endif
+ if (energy_dec) then
+ write (iout,'(a6,2i5,0pf7.3,2f7.3)')
+ & 'evdw1',i,j,evdwij,sss,sss1
+ write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
+ endif
C
C Calculate contributions to the Cartesian gradient.
C
#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
- facel=-3*rrmij*(el1+eesij)
- fac1=fac
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
+ facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ facel=-3*rrmij*(el1+eesij)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ fac1=fac
+ erij(1)=xj*rmij
+ erij(2)=yj*rmij
+ erij(3)=zj*rmij
*
* Radial derivatives. First process both termini of the fragment (i,j)
*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
+ aux=facel+sssgrad1*(1.0d0-sss)*eesij*rmij
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(1)=aux*xj
+ ggg(2)=aux*yj
+ ggg(3)=aux*zj
+c ggg(1)=facel*xj
+c ggg(2)=facel*yj
+c ggg(3)=facel*zj
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
& (shield_mode.gt.0)) then
C print *,i,j
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do k=1,3
- rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
- & *2.0
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eesij*sss1
+ & /fac_shield(i)*2.0*sss1
gshieldx(k,iresshield)=gshieldx(k,iresshield)+
& rlocshield
- & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
+ & +grad_shield_loc(k,ilist,i)*eesij*sss1/fac_shield(i)*2.0
+ & *sss1
gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
C
C enddo
C endif
- enddo
enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do k=1,3
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
- & *2.0
+ & *2.0*sss1
gshieldx(k,iresshield)=gshieldx(k,iresshield)+
- & rlocshield
- & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
+ & rlocshield
+ & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0*sss1
gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
- enddo
enddo
+ enddo
- do k=1,3
- gshieldc(k,i)=gshieldc(k,i)+
- & grad_shield(k,i)*eesij/fac_shield(i)*2.0
- gshieldc(k,j)=gshieldc(k,j)+
- & grad_shield(k,j)*eesij/fac_shield(j)*2.0
- gshieldc(k,i-1)=gshieldc(k,i-1)+
- & grad_shield(k,i)*eesij/fac_shield(i)*2.0
- gshieldc(k,j-1)=gshieldc(k,j-1)+
- & grad_shield(k,j)*eesij/fac_shield(j)*2.0
+ do k=1,3
+ gshieldc(k,i)=gshieldc(k,i)+
+ & grad_shield(k,i)*eesij/fac_shield(i)*2.0*sss1
+ gshieldc(k,j)=gshieldc(k,j)+
+ & grad_shield(k,j)*eesij/fac_shield(j)*2.0*sss1
+ gshieldc(k,i-1)=gshieldc(k,i-1)+
+ & grad_shield(k,i)*eesij/fac_shield(i)*2.0*sss1
+ gshieldc(k,j-1)=gshieldc(k,j-1)+
+ & grad_shield(k,j)*eesij/fac_shield(j)*2.0*sss1
- enddo
- endif
+ enddo
+ endif
c do k=1,3
c ghalf=0.5D0*ggg(k)
c gelc(k,j)=gelc(k,j)+ghalf
c enddo
c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
+ do k=1,3
+ gelc_long(k,j)=gelc_long(k,j)+ggg(k)
+ gelc_long(k,i)=gelc_long(k,i)-ggg(k)
+ enddo
+c gelc_long(3,i)=gelc_long(3,i)+
+c ssgradlipi*eesij/2.0d0*lipscale**2*sss1
*
* Loop over residues i+1 thru j-1.
*
cgrad gelc(l,k)=gelc(l,k)+ggg(l)
cgrad enddo
cgrad enddo
- ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
- ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
- ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
+ facvdw=facvdw+
+ & (-sss1*sssgrad/rpp(iteli,itelj)+(1.0d0-sss)*sssgrad1)*rmij*evdwij
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(1)=facvdw*xj
+ ggg(2)=facvdw*yj
+ ggg(3)=facvdw*zj
c do k=1,3
c ghalf=0.5D0*ggg(k)
c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
c enddo
c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
+ do k=1,3
+ gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
+ gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+ enddo
*
* Loop over residues i+1 thru j-1.
*
cgrad enddo
cgrad enddo
#else
- facvdw=ev1+evdwij*(1.0d0-sss)
- facel=el1+eesij
- fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
+ facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ facel=-3*rrmij*(el1+eesij)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
+c facvdw=ev1+evdwij*(1.0d0-sss)*sss1
+c facel=el1+eesij
+ fac1=fac
+ fac=-3*rrmij*(facvdw+facvdw+facel)
+ erij(1)=xj*rmij
+ erij(2)=yj*rmij
+ erij(3)=zj*rmij
*
* Radial derivatives. First process both termini of the fragment (i,j)
*
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
+ aux=fac+(sssgrad1*(1.0d0-sss)-sssgrad*sss1/rpp(iteli,itelj))
+ & *eesij*rmij
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(1)=aux*xj
+ ggg(2)=aux*yj
+ ggg(3)=axu*zj
+c ggg(1)=fac*xj
+c ggg(2)=fac*yj
+c ggg(3)=fac*zj
c do k=1,3
c ghalf=0.5D0*ggg(k)
c gelc(k,i)=gelc(k,i)+ghalf
c gelc(k,j)=gelc(k,j)+ghalf
c enddo
c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc(k,j)+ggg(k)
- gelc_long(k,i)=gelc(k,i)-ggg(k)
- enddo
+ do k=1,3
+ gelc_long(k,j)=gelc(k,j)+ggg(k)
+ gelc_long(k,i)=gelc(k,i)-ggg(k)
+ enddo
*
* Loop over residues i+1 thru j-1.
*
C ggg(1)=facvdw*xj
C ggg(2)=facvdw*yj
C ggg(3)=facvdw*zj
- ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
- ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
- ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
+ facvdw=facvdw
+ & (-sssgrad*sss1/rpp(iteli,itelj)+sssgrad1*(1.0d0-sss))*rmij*evdwij
+ ggg(1)=facvdw*xj
+ ggg(2)=facvdw*yj
+ ggg(3)=facvdw*zj
+ do k=1,3
+ gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
+ gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+ enddo
#endif
*
* Angular part
*
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
+ ecosa=2.0D0*fac3*fac1+fac4
+ fac4=-3.0D0*fac4
+ fac3=-6.0D0*fac3
+ ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
+ ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
+ do k=1,3
+ dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
+ dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
+ enddo
cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
cd & (dcosg(k),k=1,3)
- do k=1,3
- ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
- & fac_shield(i)**2*fac_shield(j)**2
+ do k=1,3
+ ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss1
+ & *fac_shield(i)**2*fac_shield(j)**2
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- enddo
+ enddo
c do k=1,3
c ghalf=0.5D0*ggg(k)
c gelc(k,i)=gelc(k,i)+ghalf
cgrad gelc(l,k)=gelc(l,k)+ggg(l)
cgrad enddo
cgrad enddo
- do k=1,3
- gelc(k,i)=gelc(k,i)
- & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
- & *fac_shield(i)**2*fac_shield(j)**2
+ do k=1,3
+ gelc(k,i)=gelc(k,i)
+ & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
+ & +ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))*sss1
+ & *fac_shield(i)**2*fac_shield(j)**2
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- gelc(k,j)=gelc(k,j)
- & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
- & *fac_shield(i)**2*fac_shield(j)**2
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
- & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
+ gelc(k,j)=gelc(k,j)
+ & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
+ & +ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))*sss1
+ & *fac_shield(i)**2*fac_shield(j)**2
+c & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ gelc_long(k,j)=gelc_long(k,j)+ggg(k)
+ gelc_long(k,i)=gelc_long(k,i)-ggg(k)
+ enddo
+ IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
+ & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
+ & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
C
C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
C energy of a peptide unit is assumed in the form of a second-order
C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
C are computed for EVERY pair of non-contiguous peptide groups.
C
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
+ if (j.lt.nres-1) then
+ j1=j+1
+ j2=j-1
+ else
+ j1=j-1
+ j2=j-2
+ endif
+ kkk=0
+ do k=1,2
+ do l=1,2
+ kkk=kkk+1
+ muij(kkk)=mu(k,i)*mu(l,j)
#ifdef NEWCORR
- gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
+ gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
- gmuij2(kkk)=gUb2(k,i)*mu(l,j)
- gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
+ gmuij2(kkk)=gUb2(k,i)*mu(l,j)
+ gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
- gmuji2(kkk)=mu(k,i)*gUb2(l,j)
+ gmuji2(kkk)=mu(k,i)*gUb2(l,j)
#endif
- enddo
- enddo
+ enddo
+ enddo
cd write (iout,*) 'EELEC: i',i,' j',j
cd write (iout,*) 'j',j,' j1',j1,' j2',j2
cd write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
- fac=dsqrt(-ael6i)*r3ij
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
+ ury=scalar(uy(1,i),erij)
+ urz=scalar(uz(1,i),erij)
+ vry=scalar(uy(1,j),erij)
+ vrz=scalar(uz(1,j),erij)
+ a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
+ a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
+ a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
+ a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
+ fac=dsqrt(-ael6i)*r3ij
+ a22=a22*fac
+ a23=a23*fac
+ a32=a32*fac
+ a33=a33*fac
cd write (iout,'(4i5,4f10.5)')
cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
cd write (iout,'(9f10.5/)')
cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
C Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
- do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
- enddo
+ call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
+ do k=1,3
+ uryg(k,1)=scalar(erder(1,k),uy(1,i))
+ uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
+ uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
+ urzg(k,1)=scalar(erder(1,k),uz(1,i))
+ urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
+ urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
+ vryg(k,1)=scalar(erder(1,k),uy(1,j))
+ vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
+ vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
+ vrzg(k,1)=scalar(erder(1,k),uz(1,j))
+ vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
+ vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
+ enddo
C Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
+ facr=-3.0d0*rrmij
+ a22der=a22*facr
+ a23der=a23*facr
+ a32der=a32*facr
+ a33der=a33*facr
+ agg(1,1)=a22der*xj
+ agg(2,1)=a22der*yj
+ agg(3,1)=a22der*zj
+ agg(1,2)=a23der*xj
+ agg(2,2)=a23der*yj
+ agg(3,2)=a23der*zj
+ agg(1,3)=a32der*xj
+ agg(2,3)=a32der*yj
+ agg(3,3)=a32der*zj
+ agg(1,4)=a33der*xj
+ agg(2,4)=a33der*yj
+ agg(3,4)=a33der*zj
C Add the contributions coming from er
- fac3=-3.0d0*fac
- do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
- do k=1,3
+ fac3=-3.0d0*fac
+ do k=1,3
+ agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
+ agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
+ agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
+ agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
+ enddo
+ do k=1,3
C Derivatives in DC(i)
cgrad ghalf1=0.5d0*agg(k,1)
cgrad ghalf2=0.5d0*agg(k,2)
cgrad ghalf3=0.5d0*agg(k,3)
cgrad ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
- & -3.0d0*uryg(k,2)*vry)!+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
- & -3.0d0*uryg(k,2)*vrz)!+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
- & -3.0d0*urzg(k,2)*vry)!+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
- & -3.0d0*urzg(k,2)*vrz)!+ghalf4
+ aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
+ & -3.0d0*uryg(k,2)*vry)!+ghalf1
+ aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
+ & -3.0d0*uryg(k,2)*vrz)!+ghalf2
+ aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
+ & -3.0d0*urzg(k,2)*vry)!+ghalf3
+ aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
+ & -3.0d0*urzg(k,2)*vrz)!+ghalf4
C Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
- & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
- & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
- & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
- & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
+ aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
+ & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
+ aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
+ & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
+ aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
+ & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
+ aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
+ & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
C Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
- & -3.0d0*vryg(k,2)*ury)!+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
- & -3.0d0*vrzg(k,2)*ury)!+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
- & -3.0d0*vryg(k,2)*urz)!+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
- & -3.0d0*vrzg(k,2)*urz)!+ghalf4
+ aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
+ & -3.0d0*vryg(k,2)*ury)!+ghalf1
+ aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
+ & -3.0d0*vrzg(k,2)*ury)!+ghalf2
+ aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
+ & -3.0d0*vryg(k,2)*urz)!+ghalf3
+ aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
+ & -3.0d0*vrzg(k,2)*urz)!+ghalf4
C Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
- & -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
- & -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
- & -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
- & -3.0d0*vrzg(k,3)*urz)
+ aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
+ & -3.0d0*vryg(k,3)*ury)
+ aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
+ & -3.0d0*vrzg(k,3)*ury)
+ aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
+ & -3.0d0*vryg(k,3)*urz)
+ aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
+ & -3.0d0*vrzg(k,3)*urz)
cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
cgrad do l=1,4
cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
cgrad enddo
cgrad endif
+ enddo
+ acipa(1,1)=a22
+ acipa(1,2)=a23
+ acipa(2,1)=a32
+ acipa(2,2)=a33
+ a22=-a22
+ a23=-a23
+ do l=1,2
+ do k=1,3
+ agg(k,l)=-agg(k,l)
+ aggi(k,l)=-aggi(k,l)
+ aggi1(k,l)=-aggi1(k,l)
+ aggj(k,l)=-aggj(k,l)
+ aggj1(k,l)=-aggj1(k,l)
enddo
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
+ enddo
+ if (j.lt.nres-1) then
a22=-a22
- a23=-a23
- do l=1,2
+ a32=-a32
+ do l=1,3,2
do k=1,3
agg(k,l)=-agg(k,l)
aggi(k,l)=-aggi(k,l)
aggj1(k,l)=-aggj1(k,l)
enddo
enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
+ else
+ a22=-a22
+ a23=-a23
+ a32=-a32
+ a33=-a33
+ do l=1,4
+ do k=1,3
+ agg(k,l)=-agg(k,l)
+ aggi(k,l)=-aggi(k,l)
+ aggi1(k,l)=-aggi1(k,l)
+ aggj(k,l)=-aggj(k,l)
+ aggj1(k,l)=-aggj1(k,l)
enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
- IF (wel_loc.gt.0.0d0) THEN
+ enddo
+ endif
+ ENDIF ! WCORR
+ IF (wel_loc.gt.0.0d0) THEN
C Contribution to the local-electrostatic energy coming from the i-j pair
- eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
- & +a33*muij(4)
-cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
+ eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
+ & +a33*muij(4)
+cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eelloc',i,j,eel_loc_ij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
+ & 'eelloc',i,j,eel_loc_ij
- if (shield_mode.eq.0) then
- fac_shield(i)=1.0
- fac_shield(j)=1.0
-C else
-C fac_shield(i)=0.4
-C fac_shield(j)=0.6
- endif
- eel_loc_ij=eel_loc_ij
- & *fac_shield(i)*fac_shield(j)
- eel_loc=eel_loc+eel_loc_ij
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+C else
+C fac_shield(i)=0.4
+C fac_shield(j)=0.6
+ endif
+ eel_loc_ij=eel_loc_ij
+ & *fac_shield(i)*fac_shield(j)*sss1
+ eel_loc=eel_loc+eel_loc_ij
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
& (shield_mode.gt.0)) then
C print *,i,j
C & *2.0
gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
& rlocshield
- & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
+ & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
& +rlocshield
enddo
C & *2.0
gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
& rlocshield
- & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
+ & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
& +rlocshield
& grad_shield(k,i)*eel_loc_ij/fac_shield(i)
gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
& grad_shield(k,j)*eel_loc_ij/fac_shield(j)
- enddo
- endif
+ enddo
+ endif
#ifdef NEWCORR
- geel_loc_ij=(a22*gmuij1(1)
+ geel_loc_ij=(a22*gmuij1(1)
& +a23*gmuij1(2)
& +a32*gmuij1(3)
& +a33*gmuij1(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss1
c write(iout,*) "derivative over thatai"
c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
c & a33*gmuij1(4)
- gloc(nphi+i,icg)=gloc(nphi+i,icg)+
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)+
& geel_loc_ij*wel_loc
c write(iout,*) "derivative over thatai-1"
c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
c & a33*gmuij2(4)
- geel_loc_ij=
+ geel_loc_ij=
& a22*gmuij2(1)
& +a23*gmuij2(2)
& +a32*gmuij2(3)
& +a33*gmuij2(4)
- gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
+ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
& geel_loc_ij*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss1
c Derivative over j residue
- geel_loc_ji=a22*gmuji1(1)
+ geel_loc_ji=a22*gmuji1(1)
& +a23*gmuji1(2)
& +a32*gmuji1(3)
& +a33*gmuji1(4)
gloc(nphi+j,icg)=gloc(nphi+j,icg)+
& geel_loc_ji*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss1
- geel_loc_ji=
+ geel_loc_ji=
& +a22*gmuji2(1)
& +a23*gmuji2(2)
& +a32*gmuji2(3)
c write(iout,*) "derivative over thataj-1"
c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
c & a33*gmuji2(4)
- gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
- & geel_loc_ji*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
+ & geel_loc_ji*wel_loc
+ & *fac_shield(i)*fac_shield(j)*sss1
#endif
-cC Partial derivatives in virtual-bond dihedral angles gamma
- if (i.gt.1)
+cC Paral derivatives in virtual-bond dihedral angles gamma
+ if (i.gt.1)
& gel_loc_loc(i-1)=gel_loc_loc(i-1)+
- & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
- & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
- & *fac_shield(i)*fac_shield(j)
+ & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
+ & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
+ & *fac_shield(i)*fac_shield(j)*sss1
+c & *fac_shield(i)*fac_shield(j)
+c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+
- & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
- & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
- & *fac_shield(i)*fac_shield(j)
+
+ gel_loc_loc(j-1)=gel_loc_loc(j-1)+
+ & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
+ & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
+ & *fac_shield(i)*fac_shield(j)*sss1
+c & *fac_shield(i)*fac_shield(j)
+c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
- do l=1,3
- ggg(l)=(agg(l,1)*muij(1)+
- & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ aux=eel_loc_ij/sss1*sssgrad1*rmij
+ ggg(1)=aux*xj
+ ggg(2)=aux*yj
+ ggg(3)=aux*zj
+ do l=1,3
+ ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
+ & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
+ & *fac_shield(i)*fac_shield(j)*sss1
+c & *fac_shield(i)*fac_shield(j)
+c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
- gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
- gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
-cgrad ghalf=0.5d0*ggg(l)
-cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
-cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
- enddo
+ gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
+ gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
+cgrad ghalf=0.5d0*ggg(l)
+cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
+cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
+ enddo
cgrad do k=i+1,j2
cgrad do l=1,3
cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
cgrad enddo
cgrad enddo
C Remaining derivatives of eello
- do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
- & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+c gel_loc_long(3,j)=gel_loc_long(3,j)+ &
+c ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
+c ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
+c
+c gel_loc_long(3,i)=gel_loc_long(3,i)+ &
+c ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
+c ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
- gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
- & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ do l=1,3
+ gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
+ & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
+ & *fac_shield(i)*fac_shield(j)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
- gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
- & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
+ & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
+ & *fac_shield(i)*fac_shield(j)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
- gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
- & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
+ & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
+ & *fac_shield(i)*fac_shield(j)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
- enddo
- ENDIF
+ gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
+ & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
+ & *fac_shield(i)*fac_shield(j)*sss1
+c & *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+ enddo
+ ENDIF
+#ifdef FOURBODY
C Change 12/26/95 to calculate four-body contributions to H-bonding energy
c if (j.gt.i+1 .and. num_conti.le.maxconts) then
- if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
- & .and. num_conti.le.maxconts) then
+ if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
+ & .and. num_conti.le.maxconts) then
c write (iout,*) i,j," entered corr"
C
C Calculate the contact function. The ith column of the array JCONT will
C contain the numbers of atoms that make contacts with the atom I (of numbers
C greater than I). The arrays FACONT and GACONT will contain the values of
C the contact function and its derivative.
-c r0ij=1.02D0*rpp(iteli,itelj)
-c r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-c r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',
- & ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
-cd write (iout,*) "i",i," j",j," num_conti",num_conti,
-cd & " jcont_hb",jcont_hb(num_conti,i)
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
- & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
+c r0ij=1.02D0*rpp(iteli,itelj)
+c r0ij=1.11D0*rpp(iteli,itelj)
+ r0ij=2.20D0*rpp(iteli,itelj)
+c r0ij=1.55D0*rpp(iteli,itelj)
+ call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
+ if (fcont.gt.0.0D0) then
+ num_conti=num_conti+1
+ if (num_conti.gt.maxconts) then
+ write (iout,*) 'WARNING - max. # of contacts exceeded;',
+ & ' will skip next contacts for this conf.'
+ else
+ jcont_hb(num_conti,i)=j
+cd write (iout,*) "i",i," j",j," num_conti",num_conti,
+cd " jcont_hb",jcont_hb(num_conti,i)
+ IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
+ & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
C terms.
- d_cont(num_conti,i)=rij
+ d_cont(num_conti,i)=rij
cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
C --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
+ a_chuj(1,1,num_conti,i)=a22
+ a_chuj(1,2,num_conti,i)=a23
+ a_chuj(2,1,num_conti,i)=a32
+ a_chuj(2,2,num_conti,i)=a33
C --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
- enddo
+ do kkk=1,3
+ grij_hb_cont(kkk,num_conti,i)=erij(kkk)
+ enddo
+ kkll=0
+ do k=1,2
+ do l=1,2
+ kkll=kkll+1
+ do m=1,3
+ a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
+ a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
+ a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
+ a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
+ a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
enddo
enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
+ enddo
+ ENDIF
+ IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-c fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
-c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
-c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
-c ees0mij=0.0D0
- if (shield_mode.eq.0) then
+ cosa4=4.0D0*cosa
+ wij=cosa-3.0D0*cosb*cosg
+ cosbg1=cosb+cosg
+ cosbg2=cosb-cosg
+c fac3=dsqrt(-ael6i)/r0ij**3
+ fac3=dsqrt(-ael6i)*r3ij
+c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
+ ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
+ if (ees0tmp.gt.0) then
+ ees0pij=dsqrt(ees0tmp)
+ else
+ ees0pij=0
+ endif
+c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
+ ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
+ if (ees0tmp.gt.0) then
+ ees0mij=dsqrt(ees0tmp)
+ else
+ ees0mij=0
+ endif
+c ees0mij=0.0D0
+ if (shield_mode.eq.0) then
fac_shield(i)=1.0d0
fac_shield(j)=1.0d0
- else
+ else
ees0plist(num_conti,i)=j
C fac_shield(i)=0.4d0
C fac_shield(j)=0.6d0
- endif
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- & *fac_shield(i)*fac_shield(j)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
- & *fac_shield(i)*fac_shield(j)
+ endif
+ ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
+ & *fac_shield(i)*fac_shield(j)*sss1
+ ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
+ & *fac_shield(i)*fac_shield(j)*sss1
C Diagnostics. Comment out or remove after debugging!
c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
C Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-c ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
+ ees0pij1=fac3/ees0pij
+ ees0mij1=fac3/ees0mij
+ fac3p=-3.0D0*fac3*rrmij
+ ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
+ ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
+c ees0mij1=0.0D0
+ ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
+ ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
+ ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
+ ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
+ ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
+ ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
+ ecosap=ecosa1+ecosa2
+ ecosbp=ecosb1+ecosb2
+ ecosgp=ecosg1+ecosg2
+ ecosam=ecosa1-ecosa2
+ ecosbm=ecosb1-ecosb2
+ ecosgm=ecosg1-ecosg2
C Diagnostics
c ecosap=ecosa1
c ecosbp=ecosb1
c ecosbm=0.0D0
c ecosgm=0.0D0
C End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
+ facont_hb(num_conti,i)=fcont
+ fprimcont=fprimcont/rij
cd facont_hb(num_conti,i)=1.0D0
C Following line is for diagnostics.
cd fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
+ do k=1,3
+ dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
+ dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
+ enddo
+ do k=1,3
+ gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
+ gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
+ enddo
+ gggp(1)=gggp(1)+ees0pijp*xj
+ & +ees0p(num_conti,i)/sss1*rmij*xj*sssgrad1
+ gggp(2)=gggp(2)+ees0pijp*yj
+ & +ees0p(num_conti,i)/sss1*rmij*yj*sssgrad1
+ gggp(3)=gggp(3)+ees0pijp*zj
+ & +ees0p(num_conti,i)/sss1*rmij*zj*sssgrad1
+ gggm(1)=gggm(1)+ees0mijp*xj
+ & +ees0m(num_conti,i)/sss1*rmij*xj*sssgrad1
+ gggm(2)=gggm(2)+ees0mijp*yj
+ & +ees0m(num_conti,i)/sss1*rmij*yj*sssgrad1
+ gggm(3)=gggm(3)+ees0mijp*zj
+ & +ees0m(num_conti,i)/sss1*rmij*zj*sssgrad1
C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
+ gacont_hbr(1,num_conti,i)=fprimcont*xj
+ gacont_hbr(2,num_conti,i)=fprimcont*yj
+ gacont_hbr(3,num_conti,i)=fprimcont*zj
+ do k=1,3
c
c 10/24/08 cgrad and ! comments indicate the parts of the code removed
c following the change of gradient-summation algorithm.
c
cgrad ghalfp=0.5D0*gggp(k)
cgrad ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ gacontp_hb1(k,num_conti,i)=!ghalfp
+ & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
+ & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+ & *sss1*fac_shield(i)*fac_shield(j)
- gacontp_hb2(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ gacontp_hb2(k,num_conti,i)=!ghalfp
+ & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
+ & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+ & *sss1*fac_shield(i)*fac_shield(j)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- & *fac_shield(i)*fac_shield(j)
+ gacontp_hb3(k,num_conti,i)=gggp(k)
+ & *sss1*fac_shield(i)*fac_shield(j)
- gacontm_hb1(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ gacontm_hb1(k,num_conti,i)=!ghalfm
+ & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
+ & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+ & *sss1*fac_shield(i)*fac_shield(j)
- gacontm_hb2(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ gacontm_hb2(k,num_conti,i)=!ghalfm
+ & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
+ & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+ & *sss1*fac_shield(i)*fac_shield(j)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- & *fac_shield(i)*fac_shield(j)
+ gacontm_hb3(k,num_conti,i)=gggm(k)
+ & *sss1*fac_shield(i)*fac_shield(j)
- enddo
- ENDIF ! wcorr
- endif ! num_conti.le.maxconts
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
- do k=1,4
- do l=1,3
- ghalf=0.5d0*agg(l,k)
- aggi(l,k)=aggi(l,k)+ghalf
- aggi1(l,k)=aggi1(l,k)+agg(l,k)
- aggj(l,k)=aggj(l,k)+ghalf
enddo
+ ENDIF ! wcorr
+ endif ! num_conti.le.maxconts
+ endif ! fcont.gt.0
+ endif ! j.gt.i+1
+#endif
+ if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
+ do k=1,4
+ do l=1,3
+ ghalf=0.5d0*agg(l,k)
+ aggi(l,k)=aggi(l,k)+ghalf
+ aggi1(l,k)=aggi1(l,k)+agg(l,k)
+ aggj(l,k)=aggj(l,k)+ghalf
+ enddo
+ enddo
+ if (j.eq.nres-1 .and. i.lt.j-2) then
+ do k=1,4
+ do l=1,3
+ aggj1(l,k)=aggj1(l,k)+agg(l,k)
enddo
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do k=1,4
- do l=1,3
- aggj1(l,k)=aggj1(l,k)+agg(l,k)
- enddo
- enddo
- endif
- endif
+ enddo
+ endif
+ endif
c t_eelecij=t_eelecij+MPI_Wtime()-time00
return
end
C
C Compute Evdwpp
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.IOUNITS'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
- dimension ggg(3)
+ include "COMMON.SPLITELE"
+ double precision ggg(3)
integer xshift,yshift,zshift
c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
#ifdef MOMENT
double precision scal_el /0.5d0/
#endif
c write (iout,*) "evdwpp_short"
+ integer i,j,k,iteli,itelj,num_conti,ind,isubchap
+ double precision dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
+ double precision xj,yj,zj,rij,rrmij,r3ij,r6ij,evdw1,
+ & dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
+ & dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
+ double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,
+ & dist_temp, dist_init,sss_grad
+ double precision sscale,sscagrad
evdw1=0.0D0
C print *,"WCHODZE"
c write (iout,*) "iatel_s_vdw",iatel_s_vdw,
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=mod(xmedi,boxxsize)
- if (xmedi.lt.0.0d0) xmedi=xmedi+boxxsize
- ymedi=mod(ymedi,boxysize)
- if (ymedi.lt.0.0d0) ymedi=ymedi+boxysize
- zmedi=mod(zmedi,boxzsize)
- if (zmedi.lt.0.0d0) zmedi=zmedi+boxzsize
+ xmedi=mod(xmedi,boxxsize)
+ if (xmedi.lt.0.0d0) xmedi=xmedi+boxxsize
+ ymedi=mod(ymedi,boxysize)
+ if (ymedi.lt.0.0d0) ymedi=ymedi+boxysize
+ zmedi=mod(zmedi,boxzsize)
+ if (zmedi.lt.0.0d0) zmedi=zmedi+boxzsize
num_conti=0
c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
c & ' ielend',ielend_vdw(i)
if (yj.lt.0) yj=yj+boxysize
zj=mod(zj,boxzsize)
if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- isubchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
+ dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ isubchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
+ xj=xj_safe+xshift*boxxsize
+ yj=yj_safe+yshift*boxysize
+ zj=zj_safe+zshift*boxzsize
+ dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+ if(dist_temp.lt.dist_init) then
+ dist_init=dist_temp
+ xj_temp=xj
+ yj_temp=yj
+ zj_temp=zj
+ isubchap=1
+ endif
+ enddo
+ enddo
+ enddo
+ if (isubchap.eq.1) then
+ xj=xj_temp-xmedi
+ yj=yj_temp-ymedi
+ zj=zj_temp-zmedi
+ else
+ xj=xj_safe-xmedi
+ yj=yj_safe-ymedi
+ zj=zj_safe-zmedi
+ endif
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
c sss=sscale(rij/rpp(iteli,itelj))
c sssgrad=sscagrad(rij/rpp(iteli,itelj))
- sss=sscale(rij)
- sssgrad=sscagrad(rij)
+ sss=sscale(rij/rpp(iteli,itelj),r_cut_respa)
+ sssgrad=sscagrad(rij/rpp(iteli,itelj),r_cut_respa)
if (sss.gt.0.0d0) then
rmij=1.0D0/rij
r3ij=rrmij*rmij
C Calculate contributions to the Cartesian gradient.
C
facvdw=-6*rrmij*(ev1+evdwij)*sss
- ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
- ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
- ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
+ ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
+ ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
+ ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
C ggg(1)=facvdw*xj
C ggg(2)=facvdw*yj
C ggg(3)=facvdw*zj
include 'COMMON.FFIELD'
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
+ include "COMMON.SPLITELE"
logical lprint_short
common /shortcheck/ lprint_short
- dimension ggg(3)
+ double precision ggg(3)
integer xshift,yshift,zshift
+ integer i,iint,j,k,iteli,itypj,subchap
+ double precision xi,yi,zi,xj,yj,zj,rrij,sss1,sssgrad1,
+ & fac,e1,e2,rij
+ double precision evdw2,evdw2_14,evdwij
+ double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,
+ & dist_temp, dist_init
+ double precision sscale,sscagrad
if (energy_dec) write (iout,*) "escp_long:",r_cut,rlamb
evdw2=0.0D0
evdw2_14=0.0d0
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
+
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
+ itypj=iabs(itype(j))
if (itypj.eq.ntyp1) cycle
C Uncomment following three lines for SC-p interactions
c xj=c(1,nres+j)-xi
zj=mod(zj,boxzsize)
if (zj.lt.0) zj=zj+boxzsize
c end correction
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
xj=xj_safe+xshift*boxxsize
yj=yj_safe+yshift*boxysize
zj=zj_safe+zshift*boxzsize
zj_temp=zj
subchap=1
endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ enddo
+ enddo
+ enddo
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
- sssgrad=sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
+ sss1=sscale(1.0d0/(dsqrt(rrij)),r_cut_int)
+ if (sss1.eq.0) cycle
+ sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)),r_cut_respa)
+ sssgrad=
+ & sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)),r_cut_respa)
+ sssgrad1=sscagrad(1.0d0/dsqrt(rrij),r_cut_int)
if (energy_dec) write (iout,*) "rrij",1.0d0/dsqrt(rrij),
& " rscp",rscp(itypj,iteli)," subchap",subchap," sss",sss
if (sss.lt.1.0d0) then
if (iabs(j-i) .le. 2) then
e1=scal14*e1
e2=scal14*e2
- evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
+ evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss1
endif
evdwij=e1+e2
- evdw2=evdw2+evdwij*(1.0d0-sss)
+ evdw2=evdw2+evdwij*(1.0d0-sss)*sss1
if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))')
& 'evdw2',i,j,sss,evdwij
C
C Calculate contributions to the gradient in the virtual-bond and SC vectors.
C
- fac=-(evdwij+e1)*rrij*(1.0d0-sss)
- fac=fac-(evdwij)*sssgrad*dsqrt(rrij)/rscp(itypj,iteli)
+ fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss1
+ fac=fac+evdwij*dsqrt(rrij)*(-sssgrad/rscp(itypj,iteli)
+ & +sssgrad1)/expon
ggg(1)=xj*fac
ggg(2)=yj*fac
ggg(3)=zj*fac
C peptide-group centers and side chains and its gradient in virtual-bond and
C side-chain vectors.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.FFIELD'
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
+ include "COMMON.SPLITELE"
integer xshift,yshift,zshift
logical lprint_short
common /shortcheck/ lprint_short
- dimension ggg(3)
+ integer i,iint,j,k,iteli,itypj,subchap
+ double precision xi,yi,zi,xj,yj,zj,rrij,sss1,sssgrad1,
+ & fac,e1,e2,rij
+ double precision evdw2,evdw2_14,evdwij
+ double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,
+ & dist_temp, dist_init
+ double precision ggg(3)
+ double precision sscale,sscagrad
evdw2=0.0D0
evdw2_14=0.0d0
cd print '(a)','Enter ESCP'
c if (lprint_short)
c & write (iout,*) 'ESCP_SHORT iatscp_s=',iatscp_s,
c & ' iatscp_e=',iatscp_e
- if (energy_dec) write (iout,*) "escp_short:",r_cut,rlamb
+ if (energy_dec) write (iout,*) "escp_short:",r_cut_int,rlamb
do i=iatscp_s,iatscp_e
if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
iteli=itel(i)
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
+ xi=mod(xi,boxxsize)
+ if (xi.lt.0) xi=xi+boxxsize
+ yi=mod(yi,boxysize)
+ if (yi.lt.0) yi=yi+boxysize
+ zi=mod(zi,boxzsize)
+ if (zi.lt.0) zi=zi+boxzsize
c if (lprint_short)
c & write (iout,*) "i",i," itype",itype(i),itype(i+1),
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
+ itypj=iabs(itype(j))
c if (lprint_short)
c & write (iout,*) "j",j," itypj",itypj
if (itypj.eq.ntyp1) cycle
zj=mod(zj,boxzsize)
if (zj.lt.0) zj=zj+boxzsize
c end correction
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
c if (lprint_short) then
c write (iout,*) i,j,xi,yi,zi,xj,yj,zj
c write (iout,*) "dist_init",dsqrt(dist_init)
c endif
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
+ xj_safe=xj
+ yj_safe=yj
+ zj_safe=zj
+ subchap=0
+ do xshift=-1,1
+ do yshift=-1,1
+ do zshift=-1,1
xj=xj_safe+xshift*boxxsize
yj=yj_safe+yshift*boxysize
zj=zj_safe+zshift*boxzsize
zj_temp=zj
subchap=1
endif
- enddo
- enddo
- enddo
+ enddo
+ enddo
+ enddo
c if (lprint_short) write (iout,*) "dist_temp",dsqrt(dist_temp)
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ if (subchap.eq.1) then
+ xj=xj_temp-xi
+ yj=yj_temp-yi
+ zj=zj_temp-zi
+ else
+ xj=xj_safe-xi
+ yj=yj_safe-yi
+ zj=zj_safe-zi
+ endif
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
c sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
c sssgrad=sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
- sss=sscale(1.0d0/(dsqrt(rrij)))
- sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
+ sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)),r_cut_respa)
+ sssgrad=sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)),
+ & r_cut_respa)
if (energy_dec) write (iout,*) "rrij",1.0d0/dsqrt(rrij),
& " rscp",rscp(itypj,iteli)," subchap",subchap," sss",sss
c if (lprint_short) write (iout,*) "rij",1.0/dsqrt(rrij),
C Calculate contributions to the gradient in the virtual-bond and SC vectors.
C
fac=-(evdwij+e1)*rrij*sss
- fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/rscp(itypj,iteli)
+ fac=fac+evdwij*sssgrad*dsqrt(rrij)/rscp(itypj,iteli)/expon
ggg(1)=xj*fac
ggg(2)=yj*fac
ggg(3)=zj*fac
subroutine etotal(energia)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifndef ISNAN
external proc_proc
#ifdef MPI
include "mpif.h"
double precision weights_(n_ene)
+ double precision time00
+ integer ierror,ierr
#endif
include 'COMMON.SETUP'
include 'COMMON.IOUNITS'
include 'COMMON.SBRIDGE'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
- include 'COMMON.MD'
+c include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.CONTROL'
include 'COMMON.TIME1'
include 'COMMON.SPLITELE'
include 'COMMON.TORCNSTR'
+ include 'COMMON.SAXS'
+ double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc,
+ & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr,
+ & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6,
+ & eliptran,Eafmforce,Etube,
+ & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet
+ integer n_corr,n_corr1
#ifdef MPI
c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
c & " nfgtasks",nfgtasks
weights_(17)=wbond
weights_(18)=scal14
weights_(21)=wsccor
- weights_(22)=wtube
+ weights_(22)=wliptran
+ weights_(25)=wtube
weights_(26)=wsaxs
weights_(28)=wdfa_dist
weights_(29)=wdfa_tor
wbond=weights(17)
scal14=weights(18)
wsccor=weights(21)
- wtube=weights(22)
+ wliptran=weights(22)
+ wtube=weights(25)
wsaxs=weights(26)
wdfa_dist=weights_(28)
wdfa_tor=weights_(29)
else
esccor=0.0d0
endif
+#ifdef FOURBODY
C print *,"PRZED MULIt"
c print *,"Processor",myrank," computed Usccorr"
C
c & n_corr1
c call flush(iout)
endif
+#endif
c print *,"Processor",myrank," computed Ucorr"
c write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode
if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
C print *,"przed lipidami"
if (wliptran.gt.0) then
call Eliptransfer(eliptran)
+ else
+ eliptran=0.0d0
endif
C print *,"za lipidami"
if (AFMlog.gt.0) then
end
c-------------------------------------------------------------------------------
subroutine sum_energy(energia,reduce)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifndef ISNAN
external proc_proc
#endif
#ifdef MPI
include "mpif.h"
+ integer ierr
+ double precision time00
#endif
include 'COMMON.SETUP'
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
include 'COMMON.TIME1'
logical reduce
+ integer i
+ double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc,
+ & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr,
+ & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6,
+ & eliptran,Eafmforce,Etube,
+ & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet
+ double precision Uconst,etot
#ifdef MPI
if (nfgtasks.gt.1 .and. reduce) then
#ifdef DEBUG
end
c-------------------------------------------------------------------------------
subroutine sum_gradient
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifndef ISNAN
external proc_proc
#endif
#ifdef MPI
include 'mpif.h'
+ integer ierror,ierr
+ double precision time00,time01
#endif
double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
& glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
include 'COMMON.TIME1'
include 'COMMON.MAXGRAD'
include 'COMMON.SCCOR'
- include 'COMMON.MD'
+c include 'COMMON.MD'
+ include 'COMMON.QRESTR'
+ integer i,j,k
+ double precision scalar
+ double precision gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,
+ &gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,gcorr3_turn_norm,
+ &gcorr4_turn_norm,gradcorr5_norm,gradcorr6_norm,
+ &gcorr6_turn_norm,gsccorrc_norm,gscloc_norm,gvdwx_norm,
+ &gradx_scp_norm,ghpbx_norm,gradxorr_norm,gsccorrx_norm,
+ &gsclocx_norm
#ifdef TIMING
time01=MPI_Wtime()
#endif
gradcorr5_max=0.0d0
gradcorr6_max=0.0d0
gcorr6_turn_max=0.0d0
- gsccorc_max=0.0d0
+ gsccorrc_max=0.0d0
gscloc_max=0.0d0
gvdwx_max=0.0d0
gradx_scp_max=0.0d0
ghpbx_max=0.0d0
gradxorr_max=0.0d0
- gsccorx_max=0.0d0
+ gsccorrx_max=0.0d0
gsclocx_max=0.0d0
do i=1,nct
gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
if (gradcorr5_norm.gt.gradcorr5_max)
& gradcorr5_max=gradcorr5_norm
gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
- if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
+ if (gradcorr6_norm.gt.gradcorr6_max)gradcorr6_max=gradcorr6_norm
gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
& gcorr6_turn(1,i)))
if (gcorr6_turn_norm.gt.gcorr6_turn_max)
& gcorr6_turn_max=gcorr6_turn_norm
- gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
- if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
+ gsccorrc_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
+ if (gsccorrc_norm.gt.gsccorrc_max) gsccorrc_max=gsccorrc_norm
gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
& gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
& gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
+ & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorrc_max,
& gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
+ & gsccorrx_max,gsclocx_max
close(istat)
if (gvdwc_max.gt.1.0d4) then
write (iout,*) "gvdwc gvdwx gradb gradbx"
end
c-------------------------------------------------------------------------------
subroutine rescale_weights(t_bath)
- implicit real*8 (a-h,o-z)
+ implicit none
+#ifdef MPI
+ include 'mpif.h'
+ integer ierror
+#endif
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.FFIELD'
include 'COMMON.SBRIDGE'
include 'COMMON.CONTROL'
+ double precision t_bath
+ double precision facT,facT2,facT3,facT4,facT5
double precision kfac /2.4d0/
double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
c facT=temp0/t_bath
end
C------------------------------------------------------------------------
subroutine enerprint(energia)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.FFIELD'
include 'COMMON.SBRIDGE'
- include 'COMMON.MD'
+ include 'COMMON.QRESTR'
double precision energia(0:n_ene)
+ double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc,
+ & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr,
+ & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,
+ & eello_turn6,
+ & eliptran,Eafmforce,Etube,
+ & esaxs,ehomology_constr,edfator,edfanei,edfabet,etot
etot=energia(0)
evdw=energia(1)
evdw2=energia(2)
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
& estr,wbond,ebe,wang,
& escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
+#ifdef FOURBODY
& ecorr,wcorr,
- & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
- & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
- & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
+ & ecorr5,wcorr5,ecorr6,wcorr6,
+#endif
+ & eel_loc,wel_loc,eello_turn3,wturn3,
+ & eello_turn4,wturn4,
+#ifdef FOURBODY
+ & eello_turn6,wturn6,
+#endif
+ & esccor,wsccor,edihcnstr,
+ & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforce,
& etube,wtube,esaxs,wsaxs,ehomology_constr,
& edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
& edfabet,wdfa_beta,
& 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
& 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
& ' (SS bridges & dist. cnstr.)'/
+#ifdef FOURBODY
& 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
+#endif
& 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
& 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
& 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
+#ifdef FOURBODY
& 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
+#endif
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
& 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
& estr,wbond,ebe,wang,
& escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
+#ifdef FOURBODY
& ecorr,wcorr,
- & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
- & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
+ & ecorr5,wcorr5,ecorr6,wcorr6,
+#endif
+ & eel_loc,wel_loc,eello_turn3,wturn3,
+ & eello_turn4,wturn4,
+#ifdef FOURBODY
+ & eello_turn6,wturn6,
+#endif
+ & esccor,wsccor,edihcnstr,
& ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
& etube,wtube,esaxs,wsaxs,ehomology_constr,
& edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
& 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
& 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
& ' (SS bridges & dist. restr.)'/
+#ifdef FOURBODY
& 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
+#endif
& 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
& 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
& 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
+#ifdef FOURBODY
& 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
+#endif
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
& 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the LJ potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
+ double precision accur
include 'DIMENSIONS'
parameter (accur=1.0d-10)
include 'COMMON.GEO'
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
+ include 'COMMON.SPLITELE'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
- dimension gg(3)
+ include 'COMMON.CONTMAT'
+#endif
+ double precision gg(3)
+ double precision evdw,evdwij
+ integer i,j,k,itypi,itypj,itypi1,num_conti,iint
+ double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij,
+ & sigij,r0ij,rcut,sqrij,sss1,sssgrad1
+ double precision fcont,fprimcont
+ double precision sscale,sscagrad
c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
C Change 12/1/95 to calculate four-body interactions
rij=xj*xj+yj*yj+zj*zj
rrij=1.0D0/rij
+ sqrij=dsqrt(rij)
+ sss1=sscale(sqrij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(sqrij,r_cut_int)
+
c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+evdwij
+ evdw=evdw+sss1*evdwij
C
C Calculate the components of the gradient in DC and X
C
- fac=-rrij*(e1+evdwij)
+ fac=-rrij*(e1+evdwij)*sss1
+ & +evdwij*sssgrad1/sqrij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
cgrad enddo
cgrad enddo
C
+#ifdef FOURBODY
C 12/1/95, revised on 5/20/97
C
C Calculate the contact function. The ith column of the array JCONT will
cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
endif
endif
+#endif
enddo ! j
enddo ! iint
C Change 12/1/95
+#ifdef FOURBODY
num_cont(i)=num_conti
+#endif
enddo ! i
do i=1,nct
do j=1,3
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the LJK potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
- dimension gg(3)
+ include 'COMMON.SPLITELE'
+ double precision gg(3)
+ double precision evdw,evdwij
+ integer i,j,k,itypi,itypj,itypi1,iint
+ double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij,
+ & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1
logical scheck
+ double precision sscale,sscagrad
c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
e_augm=augm(itypi,itypj)*fac_augm
r_inv_ij=dsqrt(rrij)
rij=1.0D0/r_inv_ij
+ sss1=sscale(rij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(rij,r_cut_int)
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
C have you changed here?
cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+evdwij
+ evdw=evdw+evdwij*sss1
C
C Calculate the components of the gradient in DC and X
C
fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
+ & +evdwij*sssgrad1*r_inv_ij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the Berne-Pechukas potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include 'COMMON.SPLITELE'
+ integer icall
common /srutu/ icall
+ double precision evdw
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi,
+ & sss1,sssgrad1
+ double precision sscale,sscagrad
c double precision rrsave(maxdim)
logical lprn
evdw=0.0D0
cd rrij=rrsave(ind)
cd endif
rij=dsqrt(rrij)
+ sss1=sscale(1.0d0/rij,r_cut_int)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(1.0d0/rij,r_cut_int)
C Calculate the angle-dependent terms of energy & contributions to derivatives.
call sc_angular
C Calculate whole angle-dependent part of epsilon and contributions
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij
+ evdw=evdw+sss1*evdwij
if (lprn) then
sigm=dabs(aa/bb)**(1.0D0/6.0D0)
epsi=bb**2/aa
fac=-expon*(e1+evdwij)
sigder=fac/sigsq
fac=rrij*fac
+ & +evdwij*sssgrad1/sss1*rij
C Calculate radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the Gay-Berne potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.SPLITELE'
include 'COMMON.SBRIDGE'
logical lprn
- integer xshift,yshift,zshift
-
+ integer xshift,yshift,zshift,subchap
+ double precision evdw
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
+ double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij,
+ & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
+ double precision dist,sscale,sscagrad,sscagradlip,sscalelip
evdw=0.0D0
ccccc energy_dec=.false.
C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
- sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
-
+ sss=sscale(1.0d0/rij,r_cut_int)
c write (iout,'(a7,4f8.3)')
c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
- if (sss.gt.0.0d0) then
+ if (sss.eq.0.0d0) cycle
+ sssgrad=sscagrad(1.0d0/rij,r_cut_int)
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
call sc_angular
& evdwij
endif
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
+ if (energy_dec) write (iout,'(a,2i5,3f10.5)')
+ & 'r sss evdw',i,j,rij,sss,evdwij
C Calculate gradient components.
e1=e1*eps1*eps2rt**2*eps3rt**2
fac=rij*fac
c print '(2i4,6f8.4)',i,j,sss,sssgrad*
c & evdwij,fac,sigma(itypi,itypj),expon
- fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
+ fac=fac+evdwij*sssgrad/sss*rij
c fac=0.0d0
C Calculate the radial part of the gradient
gg_lipi(3)=eps1*(eps2rt*eps2rt)
- &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
- & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
- &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
+ & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
+ & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+ & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
gg_lipj(3)=ssgradlipj*gg_lipi(3)
gg_lipi(3)=gg_lipi(3)*ssgradlipi
C gg_lipi(3)=0.0d0
gg(2)=yj*fac
gg(3)=zj*fac
C Calculate angular part of the gradient.
+c call sc_grad_scale(sss)
call sc_grad
- endif
ENDIF ! dyn_ss
enddo ! j
enddo ! iint
C This subroutine calculates the interaction energy of nonbonded side chains
C assuming the Gay-Berne-Vorobjev potential of interaction.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
- integer xshift,yshift,zshift
+ include 'COMMON.SPLITELE'
+ integer xshift,yshift,zshift,subchap
+ integer icall
common /srutu/ icall
logical lprn
+ double precision evdw
+ integer itypi,itypj,itypi1,iint,ind
+ double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,r0ij,
+ & xi,yi,zi,fac_augm,e_augm
+ double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij,
+ & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip,sssgrad1
+ double precision dist,sscale,sscagrad,sscagradlip,sscalelip
evdw=0.0D0
c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
dzj=dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
+ sss=sscale(1.0d0/rij,r_cut_int)
+ if (sss.eq.0.0d0) cycle
+ sssgrad=sscagrad(1.0d0/rij,r_cut_int)
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
call sc_angular
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac-2*expon*rrij*e_augm
- fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
+ fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
C Calculate angular part of the gradient.
+c call sc_grad_scale(sss)
call sc_grad
enddo ! j
enddo ! iint
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
dimension gg(3)
cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
evdw=0.0D0
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
zj=zj_safe-zmedi
endif
rij=xj*xj+yj*yj+zj*zj
- sss=sscale(sqrt(rij))
- sssgrad=sscagrad(sqrt(rij))
+ sss=sscale(sqrt(rij),r_cut_int)
+ sssgrad=sscagrad(sqrt(rij),r_cut_int)
if (rij.lt.r0ijsq) then
evdw1ij=0.25d0*(rij-r0ijsq)**2
fac=rij-r0ijsq
#endif
return
end
-C-----------------------------------------------------------------------------
- subroutine check_vecgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
- dimension uyt(3,maxres),uzt(3,maxres)
- dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
- double precision delta /1.0d-7/
- call vec_and_deriv
-cd do i=1,nres
-crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
-cd & (dc_norm(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
-cd write(iout,'(a)')
-cd enddo
- do i=1,nres
- do j=1,2
- do k=1,3
- do l=1,3
- uygradt(l,k,j,i)=uygrad(l,k,j,i)
- uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
- call vec_and_deriv
- do i=1,nres
- do j=1,3
- uyt(j,i)=uy(j,i)
- uzt(j,i)=uz(j,i)
- enddo
- enddo
- do i=1,nres
-cd write (iout,*) 'i=',i
- do k=1,3
- erij(k)=dc_norm(k,i)
- enddo
- do j=1,3
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
- dc_norm(j,i)=dc_norm(j,i)+delta
-c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
-c do k=1,3
-c dc_norm(k,i)=dc_norm(k,i)/fac
-c enddo
-c write (iout,*) (dc_norm(k,i),k=1,3)
-c write (iout,*) (erij(k),k=1,3)
- call vec_and_deriv
- do k=1,3
- uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
- uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
- uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
- uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
- enddo
-c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
-c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
- enddo
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
-cd do k=1,3
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
-cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
-cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
-cd write (iout,'(a)')
-cd enddo
- enddo
- return
- end
C--------------------------------------------------------------------------
subroutine set_matrices
implicit real*8 (a-h,o-z)
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
#else
do i=3,nres+1
#endif
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ ii=ireschain(i-2)
+c write (iout,*) "i",i,i-2," ii",ii
+ if (ii.eq.0) cycle
+ innt=chain_border(1,ii)
+ inct=chain_border(2,ii)
+c write (iout,*) "i",i,i-2," ii",ii," innt",innt," inct",inct
+c if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ if (i.gt. innt+2 .and. i.lt.inct+2) then
iti = itype2loc(itype(i-2))
else
iti=nloctyp
endif
c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
+ if (i.gt. innt+1 .and. i.lt.inct+1) then
iti1 = itype2loc(itype(i-1))
else
iti1=nloctyp
endif
-c write(iout,*),i
+c write(iout,*),"i",i,i-2," iti",itype(i-2),iti,
+c & " iti1",itype(i-1),iti1
#ifdef NEWCORR
cost1=dcos(theta(i-1))
sint1=dsin(theta(i-1))
write (iout,*) 'theta=', theta(i-1)
#endif
#else
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ if (i.gt. innt+2 .and. i.lt.inct+2) then
+c if (i.gt. nnt+2 .and. i.lt.nct+2) then
iti = itype2loc(itype(i-2))
else
iti=nloctyp
write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
#endif
enddo
+ mu=0.0d0
#ifdef PARMAT
do i=ivec_start+2,ivec_end+2
#else
do i=3,nres+1
#endif
- if (i .lt. nres+1) then
+c if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
+ if (i .lt. nres+1 .and. itype(i-1).lt.ntyp1) then
sin1=dsin(phi(i))
cos1=dcos(phi(i))
sintab(i-2)=sin1
Ug2(2,1,i-2)=0.0d0
Ug2(2,2,i-2)=0.0d0
endif
- if (i .gt. 3 .and. i .lt. nres+1) then
+ if (i .gt. 3) then
obrot_der(1,i-2)=-sin1
obrot_der(2,i-2)= cos1
Ugder(1,1,i-2)= sin1
Ug2der(2,2,i-2)=0.0d0
endif
c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
+c if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ if (i.gt.nnt+2 .and.i.lt.nct+2) then
iti = itype2loc(itype(i-2))
else
iti=nloctyp
c write(iout,*) "Macierz EUG",
c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
c & eug(2,2,i-2)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
& then
call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
endif
+#endif
else
do k=1,2
Ub2(k,i-2)=0.0d0
cd write (iout,*) 'mu1',mu1(:,i-2)
cd write (iout,*) 'mu2',mu2(:,i-2)
cd write (iout,*) 'mu',i-2,mu(:,i-2)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
& then
call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
endif
+#endif
enddo
+#ifdef FOURBODY
C Matrices dependent on two consecutive virtual-bond dihedrals.
C The order of matrices is from left to right.
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
enddo
endif
+#endif
#if defined(MPI) && defined(PARMAT)
#ifdef DEBUG
c if (fg_rank.eq.0) then
call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
& MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
& MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
& then
call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
& MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
& MPI_MAT2,FG_COMM1,IERR)
endif
+#endif
#else
c Passes matrix info through the ring
isend=fg_rank1
& iprev,6600+irecv,FG_COMM,status,IERR)
c write (iout,*) "Gather PRECOMP12"
c call flush(iout)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
& then
call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
& Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
& MPI_PRECOMP23(lenrecv),
& iprev,9900+irecv,FG_COMM,status,IERR)
+#endif
c write (iout,*) "Gather PRECOMP23"
c call flush(iout)
endif
cd enddo
return
end
-C--------------------------------------------------------------------------
+C-----------------------------------------------------------------------------
subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
C
C This subroutine calculates the average interaction energy and its gradient
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
eello_turn3=0.0d0
eello_turn4=0.0d0
ind=0
+#ifdef FOURBODY
do i=1,nres
num_cont_hb(i)=0
enddo
+#endif
cd print '(a)','Enter EELEC'
cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
do i=1,nres
num_conti=0
call eelecij(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo
do i=iturn4_start,iturn4_end
if (i.lt.1) cycle
zmedi=mod(zmedi,boxzsize)
if (zmedi.lt.0) zmedi=zmedi+boxzsize
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
c write(iout,*) "JESTEM W PETLI"
call eelecij(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
& call eturn4(i,eello_turn4)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
C Loop over all neighbouring boxes
C do xshift=-1,1
c endif
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
C I TU KURWA
do j=ielstart(i),ielend(i)
C do j=16,17
&) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
enddo ! j
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
C enddo ! zshift
C enddo ! yshift
end
C-------------------------------------------------------------------------------
subroutine eelecij(i,j,ees,evdw1,eel_loc)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
include 'COMMON.TIME1'
include 'COMMON.SPLITELE'
include 'COMMON.SHIELD'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
+ double precision ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
& erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
& aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
& gmuij2(4),gmuji2(4)
+ double precision dxi,dyi,dzi
+ double precision dx_normi,dy_normi,dz_normi,aux
+ integer j1,j2,lll,num_conti
common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
& dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
& num_conti,j1,j2
+ integer k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap,ilist,iresshield
+ double precision ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
+ double precision ees,evdw1,eel_loc,aaa,bbb,ael3i
+ double precision dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,
+ & rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,
+ & evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,
+ & ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,
+ & a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,
+ & ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,
+ & ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,
+ & ecosgp,ecosam,ecosbm,ecosgm,ghalf,rlocshield
+ double precision a22,a23,a32,a33,geel_loc_ij,geel_loc_ji
+ double precision dist_init,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp,dist_temp,xmedi,ymedi,zmedi
+ double precision sscale,sscagrad,scalar
+
c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
#ifdef MOMENT
double precision scal_el /1.0d0/
C zj=zj-zmedi
rij=xj*xj+yj*yj+zj*zj
- sss=sscale(sqrt(rij))
- sssgrad=sscagrad(sqrt(rij))
+ sss=sscale(dsqrt(rij),r_cut_int)
+ if (sss.eq.0.0d0) return
+ sssgrad=sscagrad(dsqrt(rij),r_cut_int)
c if (sss.gt.0.0d0) then
rrmij=1.0D0/rij
rij=dsqrt(rij)
fac_shield(i)=1.0
fac_shield(j)=1.0
eesij=(el1+el2)
- ees=ees+eesij
+ ees=ees+eesij*sss
endif
evdw1=evdw1+evdwij*sss
cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
cd & xmedi,ymedi,zmedi,xj,yj,zj
if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
- &'evdw1',i,j,evdwij
- &,iteli,itelj,aaa,evdw1,sss
- write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
- &fac_shield(i),fac_shield(j)
+ write (iout,'(a6,2i5,0pf7.3,2i5,e11.3,3f10.5)')
+ & 'evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss,rij
+ write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
+ & fac_shield(i),fac_shield(j)
endif
C
*
* Radial derivatives. First process both termini of the fragment (i,j)
*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
+ aux=facel*sss+rmij*sssgrad*eesij
+ ggg(1)=aux*xj
+ ggg(2)=aux*yj
+ ggg(3)=aux*zj
if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
& (shield_mode.gt.0)) then
C print *,i,j
iresshield=shield_list(ilist,j)
do k=1,3
rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
- & *2.0
+ & *2.0*sss
gshieldx(k,iresshield)=gshieldx(k,iresshield)+
& rlocshield
- & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
+ & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0*sss
gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
do k=1,3
gshieldc(k,i)=gshieldc(k,i)+
- & grad_shield(k,i)*eesij/fac_shield(i)*2.0
+ & grad_shield(k,i)*eesij/fac_shield(i)*2.0*sss
gshieldc(k,j)=gshieldc(k,j)+
- & grad_shield(k,j)*eesij/fac_shield(j)*2.0
+ & grad_shield(k,j)*eesij/fac_shield(j)*2.0*sss
gshieldc(k,i-1)=gshieldc(k,i-1)+
- & grad_shield(k,i)*eesij/fac_shield(i)*2.0
+ & grad_shield(k,i)*eesij/fac_shield(i)*2.0*sss
gshieldc(k,j-1)=gshieldc(k,j-1)+
- & grad_shield(k,j)*eesij/fac_shield(j)*2.0
+ & grad_shield(k,j)*eesij/fac_shield(j)*2.0*sss
enddo
endif
cgrad gelc(l,k)=gelc(l,k)+ggg(l)
cgrad enddo
cgrad enddo
- if (sss.gt.0.0) then
- ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
- ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
- ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
- else
- ggg(1)=0.0
- ggg(2)=0.0
- ggg(3)=0.0
- endif
+ facvdw=facvdw+sssgrad*rmij*evdwij
+ ggg(1)=facvdw*xj
+ ggg(2)=facvdw*yj
+ ggg(3)=facvdw*zj
c do k=1,3
c ghalf=0.5D0*ggg(k)
c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
cgrad enddo
#else
C MARYSIA
- facvdw=(ev1+evdwij)*sss
+ facvdw=(ev1+evdwij)
facel=(el1+eesij)
fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
+ fac=-3*rrmij*(facvdw+facvdw+facel)*sss
+ & +(evdwij+eesij)*sssgrad*rrmij
erij(1)=xj*rmij
erij(2)=yj*rmij
erij(3)=zj*rmij
cd & (dcosg(k),k=1,3)
do k=1,3
ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
- & fac_shield(i)**2*fac_shield(j)**2
+ & fac_shield(i)**2*fac_shield(j)**2*sss
enddo
c do k=1,3
c ghalf=0.5D0*ggg(k)
do k=1,3
gelc(k,i)=gelc(k,i)
& +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
+ & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))*sss
& *fac_shield(i)**2*fac_shield(j)**2
gelc(k,j)=gelc(k,j)
& +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
+ & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))*sss
& *fac_shield(i)**2*fac_shield(j)**2
gelc_long(k,j)=gelc_long(k,j)+ggg(k)
gelc_long(k,i)=gelc_long(k,i)-ggg(k)
C fac_shield(j)=0.6
endif
eel_loc_ij=eel_loc_ij
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
c if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
c & 'eelloc',i,j,eel_loc_ij
C Now derivative over eel_loc
& +a23*gmuij1(2)
& +a32*gmuij1(3)
& +a33*gmuij1(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
c write(iout,*) "derivative over thatai"
c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
c & a33*gmuij1(4)
& +a33*gmuij2(4)
gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
& geel_loc_ij*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
c Derivative over j residue
geel_loc_ji=a22*gmuji1(1)
gloc(nphi+j,icg)=gloc(nphi+j,icg)+
& geel_loc_ji*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
geel_loc_ji=
& +a22*gmuji2(1)
c & a33*gmuji2(4)
gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
& geel_loc_ji*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
#endif
cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
& gel_loc_loc(i-1)=gel_loc_loc(i-1)+
& (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
& +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gel_loc_loc(j-1)=gel_loc_loc(j-1)+
& (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
& +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
+ aux=eel_loc_ij/sss*sssgrad*rmij
+ ggg(1)=aux*xj
+ ggg(2)=aux*yj
+ ggg(3)=aux*zj
do l=1,3
- ggg(l)=(agg(l,1)*muij(1)+
+ ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
& agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
cgrad ghalf=0.5d0*ggg(l)
do l=1,3
gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
& aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
& aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
& aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
& aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
enddo
ENDIF
C Change 12/26/95 to calculate four-body contributions to H-bonding energy
c if (j.gt.i+1 .and. num_conti.le.maxconts) then
+#ifdef FOURBODY
if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
& .and. num_conti.le.maxconts) then
c write (iout,*) i,j," entered corr"
C fac_shield(j)=0.6d0
endif
ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
C Diagnostics. Comment out or remove after debugging!
c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
enddo
gggp(1)=gggp(1)+ees0pijp*xj
+ & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
gggp(2)=gggp(2)+ees0pijp*yj
+ & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
gggp(3)=gggp(3)+ees0pijp*zj
+ & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
gggm(1)=gggm(1)+ees0mijp*xj
+ & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
gggm(2)=gggm(2)+ees0mijp*yj
+ & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
gggm(3)=gggm(3)+ees0mijp*zj
+ & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
C Derivatives due to the contact function
gacont_hbr(1,num_conti,i)=fprimcont*xj
gacont_hbr(2,num_conti,i)=fprimcont*yj
gacontp_hb1(k,num_conti,i)=!ghalfp
& +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontp_hb2(k,num_conti,i)=!ghalfp
& +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontp_hb3(k,num_conti,i)=gggp(k)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb1(k,num_conti,i)=!ghalfm
& +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb2(k,num_conti,i)=!ghalfm
& +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb3(k,num_conti,i)=gggm(k)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
enddo
C Diagnostics. Comment out or remove after debugging!
endif ! num_conti.le.maxconts
endif ! fcont.gt.0
endif ! j.gt.i+1
+#endif
if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
do k=1,4
do l=1,3
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
C peptide-group centers and side chains and its gradient in virtual-bond and
C side-chain vectors.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.CONTROL'
include 'COMMON.SPLITELE'
integer xshift,yshift,zshift
- dimension ggg(3)
+ double precision ggg(3)
+ integer i,iint,j,k,iteli,itypj,subchap
+ double precision xi,yi,zi,xj,yj,zj,rrij,sss1,sssgrad1,
+ & fac,e1,e2,rij
+ double precision evdw2,evdw2_14,evdwij
+ double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,
+ & dist_temp, dist_init
+ double precision sscale,sscagrad
evdw2=0.0D0
evdw2_14=0.0d0
c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
C do xshift=-1,1
C do yshift=-1,1
C do zshift=-1,1
- if (energy_dec) write (iout,*) "escp:",r_cut,rlamb
+ if (energy_dec) write (iout,*) "escp:",r_cut_int,rlamb
do i=iatscp_s,iatscp_e
if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
iteli=itel(i)
c print *,xj,yj,zj,'polozenie j'
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
c print *,rrij
- sss=sscale(1.0d0/(dsqrt(rrij)))
+ sss=sscale(1.0d0/(dsqrt(rrij)),r_cut_int)
c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
c if (sss.eq.0) print *,'czasem jest OK'
if (sss.le.0.0d0) cycle
- sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
+ sssgrad=sscagrad(1.0d0/(dsqrt(rrij)),r_cut_int)
fac=rrij**expon2
e1=fac*fac*aad(itypj,iteli)
e2=fac*bad(itypj,iteli)
endif
evdwij=e1+e2
evdw2=evdw2+evdwij*sss
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
- & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
+ if (energy_dec) write (iout,'(a6,2i5,3f7.3,2i3,3e11.3)')
+ & 'evdw2',i,j,1.0d0/dsqrt(rrij),sss,
+ & evdwij,iteli,itypj,fac,aad(itypj,iteli),
& bad(itypj,iteli)
C
C Calculate contributions to the gradient in the virtual-bond and SC vectors.
estr=0.0d0
estr1=0.0d0
do i=ibondp_start,ibondp_end
+c 3/4/2020 Adam: removed dummy bond graient if Calpha and SC coords are
+c used
+#ifdef FIVEDIAG
+ if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
+ diff = vbld(i)-vbldp0
+#else
if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
c do j=1,3
c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
c else
C Checking if it involves dummy (NH3+ or COO-) group
- if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
+ if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
C YES vbldpDUM is the equlibrium length of spring for Dummy atom
- diff = vbld(i)-vbldpDUM
- if (energy_dec) write(iout,*) "dum_bond",i,diff
- else
-C NO vbldp0 is the equlibrium lenght of spring for peptide group
- diff = vbld(i)-vbldp0
- endif
- if (energy_dec) write (iout,'(a7,i5,4f7.3)')
+ diff = vbld(i)-vbldpDUM
+ if (energy_dec) write(iout,*) "dum_bond",i,diff
+ else
+C NO vbldp0 is the equlibrium length of spring for peptide group
+ diff = vbld(i)-vbldp0
+ endif
+#endif
+ if (energy_dec) write (iout,'(a7,i5,4f7.3)')
& "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
estr=estr+diff*diff
do j=1,3
& phii1*rad2deg,ethetai
c lprn1=.false.
etheta=etheta+ethetai
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'ebend',i,ethetai
if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
c & dscp1,dscp2,sumene
c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'escloc',i,sumene
-c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
+ if (energy_dec) write (2,*) "i",i," itype",itype(i)," it",it,
+ & " escloc",sumene,escloc,it,itype(i)
c & ,zz,xx,yy
c#define DEBUG
#ifdef DEBUG
include 'COMMON.IOUNITS'
include 'COMMON.FFIELD'
include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
logical lprn
C Set lprn=.true. for debugging
lprn=.false.
& (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
& (itype(i+1).eq.ntyp1)) cycle
C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
- etors_d_ii=0.0D0
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
itori2=itortyp(itype(i))
sinphi2=dsin(j*phii1)
etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
& v2cij*cosphi2+v2sij*sinphi2
- if (energy_dec) etors_d_ii=etors_d_ii+
- & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
enddo
sinphi1m2=dsin(l*phii-(k-l)*phii1)
etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
& v1sdij*sinphi1p2+v2sdij*sinphi1m2
- if (energy_dec) etors_d_ii=etors_d_ii+
- & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
- & v1sdij*sinphi1p2+v2sdij*sinphi1m2
gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
& -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
& -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
enddo
enddo
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'etor_d',i,etors_d_ii
gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
enddo
c----------------------------------------------------------------------------
c MODELLER restraint function
subroutine e_modeller(ehomology_constr)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
- integer nnn, i, j, k, ki, irec, l
+ double precision ehomology_constr
+ integer nnn,i,ii,j,k,ijk,jik,ki,kk,nexl,irec,l
integer katy, odleglosci, test7
real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
real*8 Eval,Erot
double precision, dimension (max_template) ::
& gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
& theta_diff
+ double precision sum_godl,sgodl,grad_odl3,ggodl,sum_gdih,
+ & sum_guscdiff,sum_sgdih,sgdih,grad_dih3,usc_diff_i,dxx,dyy,dzz,
+ & betai,sum_sgodl,dij
+ double precision dist,pinorm
c
-
include 'COMMON.SBRIDGE'
include 'COMMON.CHAIN'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
- include 'COMMON.MD'
+c include 'COMMON.MD'
include 'COMMON.CONTROL'
+ include 'COMMON.HOMOLOGY'
+ include 'COMMON.QRESTR'
c
c From subroutine Econstr_back
c
esccor=0.0D0
do i=itau_start,itau_end
if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
+ esccor_ii=0.0D0
isccori=isccortyp(itype(i-2))
isccori1=isccortyp(itype(i-1))
c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
phii=phi(i)
do intertyp=1,3 !intertyp
- esccor_ii=0.0D0
cc Added 09 May 2012 (Adasko)
cc Intertyp means interaction type of backbone mainchain correlation:
c 1 = SC...Ca...Ca...Ca
v2ij=v2sccor(j,intertyp,isccori,isccori1)
cosphi=dcos(j*tauangle(intertyp,i))
sinphi=dsin(j*tauangle(intertyp,i))
- if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
esccor=esccor+v1ij*cosphi+v2ij*sinphi
gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
enddo
- if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)')
- & 'esccor',i,intertyp,esccor_ii
c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
if (lprn)
return
end
+#ifdef FOURBODY
c----------------------------------------------------------------------------
subroutine multibody(ecorr)
C This subroutine calculates multi-body contributions to energy following
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision gx(3),gx1(3)
logical lprn
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.SHIELD'
double precision gx(3),gx1(3)
logical lprn
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.CONTROL'
include 'COMMON.LOCAL'
double precision gx(3),gx1(3),time00
parameter (max_cont=maxconts)
parameter (max_dim=26)
include "COMMON.CONTACTS"
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision zapas(max_dim,maxconts,max_fg_procs),
& zapas_recv(max_dim,maxconts,max_fg_procs)
common /przechowalnia/ zapas
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.CHAIN'
include 'COMMON.CONTROL'
include 'COMMON.SHIELD'
parameter (max_cont=maxconts)
parameter (max_dim=70)
include "COMMON.CONTACTS"
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision zapas(max_dim,maxconts,max_fg_procs),
& zapas_recv(max_dim,maxconts,max_fg_procs)
common /przechowalnia/ zapas
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.SHIELD'
include 'COMMON.CONTROL'
double precision gx(3),gx1(3)
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
cd write (2,*) 'eel_turn6',ekont*eel_turn6
return
end
-
C-----------------------------------------------------------------------------
+#endif
double precision function scalar(u,v)
!DIR$ INLINEALWAYS scalar
#ifndef OSF
include 'COMMON.INTERACT'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
- include 'COMMON.MD'
+c include 'COMMON.MD'
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
include 'COMMON.FFIELD'
include 'COMMON.INTERACT'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
- include 'COMMON.MD'
+c include 'COMMON.MD'
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
include 'COMMON.FFIELD'
+++ /dev/null
- subroutine etotal(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
- double precision weights_(n_ene)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energia(0:n_ene)
- include 'COMMON.LOCAL'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
-#ifdef MPI
-c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
-c & " nfgtasks",nfgtasks
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-C FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (fg_rank.eq.0) then
- call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
-c print *,"Processor",myrank," BROADCAST iorder"
-C FG master sets up the WEIGHTS_ array which will be broadcast to the
-C FG slaves as WEIGHTS array.
- weights_(1)=wsc
- weights_(2)=wscp
- weights_(3)=welec
- weights_(4)=wcorr
- weights_(5)=wcorr5
- weights_(6)=wcorr6
- weights_(7)=wel_loc
- weights_(8)=wturn3
- weights_(9)=wturn4
- weights_(10)=wturn6
- weights_(11)=wang
- weights_(12)=wscloc
- weights_(13)=wtor
- weights_(14)=wtor_d
- weights_(15)=wstrain
- weights_(16)=wvdwpp
- weights_(17)=wbond
- weights_(18)=scal14
- weights_(21)=wsccor
-C FG Master broadcasts the WEIGHTS_ array
- call MPI_Bcast(weights_(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- else
-C FG slaves receive the WEIGHTS array
- call MPI_Bcast(weights(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- wsc=weights(1)
- wscp=weights(2)
- welec=weights(3)
- wcorr=weights(4)
- wcorr5=weights(5)
- wcorr6=weights(6)
- wel_loc=weights(7)
- wturn3=weights(8)
- wturn4=weights(9)
- wturn6=weights(10)
- wang=weights(11)
- wscloc=weights(12)
- wtor=weights(13)
- wtor_d=weights(14)
- wstrain=weights(15)
- wvdwpp=weights(16)
- wbond=weights(17)
- scal14=weights(18)
- wsccor=weights(21)
- endif
- time_Bcast=time_Bcast+MPI_Wtime()-time00
- time_Bcastw=time_Bcastw+MPI_Wtime()-time00
-c call chainbuild_cart
- endif
-c print *,'Processor',myrank,' calling etotal ipot=',ipot
-c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
-#else
-c if (modecalc.eq.12.or.modecalc.eq.14) then
-c call int_from_cart1(.false.)
-c endif
-#endif
-#ifdef TIMING
- time00=MPI_Wtime()
-#endif
-C
-C Compute the side-chain and electrostatic interaction energy
-C
- goto (101,102,103,104,105,106) ipot
-C Lennard-Jones potential.
- 101 call elj(evdw)
-cd print '(a)','Exit ELJ'
- goto 107
-C Lennard-Jones-Kihara potential (shifted).
- 102 call eljk(evdw)
- goto 107
-C Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp(evdw)
- goto 107
-C Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb(evdw)
- goto 107
-C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv(evdw)
- goto 107
-C Soft-sphere potential
- 106 call e_softsphere(evdw)
-C
-C Calculate electrostatic (H-bonding) energy of the main chain.
-C
- 107 continue
-c print *,"Processor",myrank," computed USCSC"
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call vec_and_deriv
-#ifdef TIMING
- time_vec=time_vec+MPI_Wtime()-time01
-#endif
-c print *,"Processor",myrank," left VEC_AND_DERIV"
- if (ipot.lt.6) then
-#ifdef SPLITELE
- if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
- & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
- & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
- & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#else
- if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
- & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
- & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
- & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#endif
- call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
- else
- ees=0.0d0
- evdw1=0.0d0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- endif
- else
-c write (iout,*) "Soft-spheer ELEC potential"
- call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
- & eello_turn4)
- endif
-c print *,"Processor",myrank," computed UELEC"
-C
-C Calculate excluded-volume interaction energy between peptide groups
-C and side chains.
-C
- if (ipot.lt.6) then
- if(wscp.gt.0d0) then
- call escp(evdw2,evdw2_14)
- else
- evdw2=0
- evdw2_14=0
- endif
- else
-c write (iout,*) "Soft-sphere SCP potential"
- call escp_soft_sphere(evdw2,evdw2_14)
- endif
-c
-c Calculate the bond-stretching energy
-c
- call ebond(estr)
-C
-C Calculate the disulfide-bridge and other energy and the contributions
-C from other distance constraints.
-cd print *,'Calling EHPB'
- call edis(ehpb)
-cd print *,'EHPB exitted succesfully.'
-C
-C Calculate the virtual-bond-angle energy.
-C
- if (wang.gt.0d0) then
- call ebend(ebe)
- else
- ebe=0
- endif
-c print *,"Processor",myrank," computed UB"
-C
-C Calculate the SC local energy.
-C
- call esc(escloc)
-c print *,"Processor",myrank," computed USC"
-C
-C Calculate the virtual-bond torsional energy.
-C
-cd print *,'nterm=',nterm
- if (wtor.gt.0) then
- call etor(etors,edihcnstr)
- else
- etors=0
- edihcnstr=0
- endif
-c print *,"Processor",myrank," computed Utor"
-C
-C 6/23/01 Calculate double-torsional energy
-C
- if (wtor_d.gt.0) then
- call etor_d(etors_d)
- else
- etors_d=0
- endif
-c print *,"Processor",myrank," computed Utord"
-C
-C 21/5/07 Calculate local sicdechain correlation energy
-C
- if (wsccor.gt.0.0d0) then
- call eback_sc_corr(esccor)
- else
- esccor=0.0d0
- endif
-c print *,"Processor",myrank," computed Usccorr"
-C
-C 12/1/95 Multi-body terms
-C
- n_corr=0
- n_corr1=0
- if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
- & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
-cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
-cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
- else
- ecorr=0.0d0
- ecorr5=0.0d0
- ecorr6=0.0d0
- eturn6=0.0d0
- endif
- if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
-cd write (iout,*) "multibody_hb ecorr",ecorr
- endif
-c print *,"Processor",myrank," computed Ucorr"
-C
-C If performing constraint dynamics, call the constraint energy
-C after the equilibration time
- if(usampl.and.totT.gt.eq_time) then
- call EconstrQ
- call Econstr_back
- else
- Uconst=0.0d0
- Uconst_back=0.0d0
- endif
-#ifdef TIMING
- time_enecalc=time_enecalc+MPI_Wtime()-time00
-#endif
-c print *,"Processor",myrank," computed Uconstr"
-#ifdef TIMING
- time00=MPI_Wtime()
-#endif
-c
-C Sum the energies
-C
- energia(1)=evdw
-#ifdef SCP14
- energia(2)=evdw2-evdw2_14
- energia(18)=evdw2_14
-#else
- energia(2)=evdw2
- energia(18)=0.0d0
-#endif
-#ifdef SPLITELE
- energia(3)=ees
- energia(16)=evdw1
-#else
- energia(3)=ees+evdw1
- energia(16)=0.0d0
-#endif
- energia(4)=ecorr
- energia(5)=ecorr5
- energia(6)=ecorr6
- energia(7)=eel_loc
- energia(8)=eello_turn3
- energia(9)=eello_turn4
- energia(10)=eturn6
- energia(11)=ebe
- energia(12)=escloc
- energia(13)=etors
- energia(14)=etors_d
- energia(15)=ehpb
- energia(19)=edihcnstr
- energia(17)=estr
- energia(20)=Uconst+Uconst_back
- energia(21)=esccor
-c print *," Processor",myrank," calls SUM_ENERGY"
- call sum_energy(energia,.true.)
-c print *," Processor",myrank," left SUM_ENERGY"
-#ifdef TIMING
- time_sumene=time_sumene+MPI_Wtime()-time00
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sum_energy(energia,reduce)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energia(0:n_ene),enebuff(0:n_ene+1)
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
- logical reduce
-#ifdef MPI
- if (nfgtasks.gt.1 .and. reduce) then
-#ifdef DEBUG
- write (iout,*) "energies before REDUCE"
- call enerprint(energia)
- call flush(iout)
-#endif
- do i=0,n_ene
- enebuff(i)=energia(i)
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_e=time_barrier_e+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
-#ifdef DEBUG
- write (iout,*) "energies after REDUCE"
- call enerprint(energia)
- call flush(iout)
-#endif
- time_Reduce=time_Reduce+MPI_Wtime()-time00
- endif
- if (fg_rank.eq.0) then
-#endif
- evdw=energia(1)
-#ifdef SCP14
- evdw2=energia(2)+energia(18)
- evdw2_14=energia(18)
-#else
- evdw2=energia(2)
-#endif
-#ifdef SPLITELE
- ees=energia(3)
- evdw1=energia(16)
-#else
- ees=energia(3)
- evdw1=0.0d0
-#endif
- ecorr=energia(4)
- ecorr5=energia(5)
- ecorr6=energia(6)
- eel_loc=energia(7)
- eello_turn3=energia(8)
- eello_turn4=energia(9)
- eturn6=energia(10)
- ebe=energia(11)
- escloc=energia(12)
- etors=energia(13)
- etors_d=energia(14)
- ehpb=energia(15)
- edihcnstr=energia(19)
- estr=energia(17)
- Uconst=energia(20)
- esccor=energia(21)
-#ifdef SPLITELE
- etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
- & +wang*ebe+wtor*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
- & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
- & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
- & +wbond*estr+Uconst+wsccor*esccor
-#else
- etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
- & +wang*ebe+wtor*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
- & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
- & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
- & +wbond*estr+Uconst+wsccor*esccor
-#endif
- energia(0)=etot
-c detecting NaNQ
-#ifdef ISNAN
-#ifdef AIX
- if (isnan(etot).ne.0) energia(0)=1.0d+99
-#else
- if (isnan(etot)) energia(0)=1.0d+99
-#endif
-#else
- i=0
-#ifdef WINPGI
- idumm=proc_proc(etot,i)
-#else
- call proc_proc(etot,i)
-#endif
- if(i.eq.1)energia(0)=1.0d+99
-#endif
-#ifdef MPI
- endif
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sum_gradient
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include 'mpif.h'
- double precision gradbufc(3,maxres),gradbufx(3,maxres),
- & glocbuf(4*maxres),gradbufc_sum(3,maxres)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
- include 'COMMON.MAXGRAD'
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
-#ifdef DEBUG
- write (iout,*) "sum_gradient gvdwc, gvdwx"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef MPI
-C FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (nfgtasks.gt.1 .and. fg_rank.eq.0)
- & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
-C
-C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
-C in virtual-bond-vector coordinates
-C
-#ifdef DEBUG
-c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
-c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
-c enddo
-c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,2x,f10.5)')
-c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
-c enddo
- write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
- & g_corr5_loc(i)
- enddo
- call flush(iout)
-#endif
-#ifdef SPLITELE
- do i=1,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+
- & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
- & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
- enddo
- enddo
-#else
- do i=1,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+
- & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
- & welec*gelc_long(j,i)+
- & wbond*gradb(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
- enddo
- enddo
-#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-#ifdef DEBUG
- write (iout,*) "gradbufc before allreduce"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- do i=1,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
- enddo
- enddo
-c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
-c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
-c time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
-c write (iout,*) "gradbufc_sum after allreduce"
-c do i=1,nres
-c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
-c enddo
-c call flush(iout)
-#endif
-#ifdef TIMING
-c time_allreduce=time_allreduce+MPI_Wtime()-time00
-#endif
- do i=nnt,nres
- do k=1,3
- gradbufc(k,i)=0.0d0
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
- write (iout,*) (i," jgrad_start",jgrad_start(i),
- & " jgrad_end ",jgrad_end(i),
- & i=igrad_start,igrad_end)
-#endif
-c
-c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
-c do not parallelize this part.
-c
-c do i=igrad_start,igrad_end
-c do j=jgrad_start(i),jgrad_end(i)
-c do k=1,3
-c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
-c enddo
-c enddo
-c enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,nnt,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- else
-#endif
-#ifdef DEBUG
- write (iout,*) "gradbufc"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- do i=1,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
- gradbufc(j,i)=0.0d0
- enddo
- enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,nnt,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
- enddo
- enddo
-c do i=nnt,nres-1
-c do k=1,3
-c gradbufc(k,i)=0.0d0
-c enddo
-c do j=i+1,nres
-c do k=1,3
-c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
-c enddo
-c enddo
-c enddo
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef MPI
- endif
-#endif
- do k=1,3
- gradbufc(k,nres)=0.0d0
- enddo
- do i=1,nct
- do j=1,3
-#ifdef SPLITELE
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
- & wel_loc*gel_loc(j,i)+
- & 0.5d0*(wscp*gvdwc_scpp(j,i)+
- & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i))+
- & wbond*gradb(j,i)+
- & wcorr*gradcorr(j,i)+
- & wturn3*gcorr3_turn(j,i)+
- & wturn4*gcorr4_turn(j,i)+
- & wcorr5*gradcorr5(j,i)+
- & wcorr6*gradcorr6(j,i)+
- & wturn6*gcorr6_turn(j,i)+
- & wsccor*gsccorc(j,i)
- & +wscloc*gscloc(j,i)
-#else
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
- & wel_loc*gel_loc(j,i)+
- & 0.5d0*(wscp*gvdwc_scpp(j,i)+
- & welec*gelc_long(j,i)
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i))+
- & wbond*gradb(j,i)+
- & wcorr*gradcorr(j,i)+
- & wturn3*gcorr3_turn(j,i)+
- & wturn4*gcorr4_turn(j,i)+
- & wcorr5*gradcorr5(j,i)+
- & wcorr6*gradcorr6(j,i)+
- & wturn6*gcorr6_turn(j,i)+
- & wsccor*gsccorc(j,i)
- & +wscloc*gscloc(j,i)
-#endif
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*gsccorx(j,i)
- & +wscloc*gsclocx(j,i)
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc before adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
- & +wcorr5*g_corr5_loc(i)
- & +wcorr6*g_corr6_loc(i)
- & +wturn4*gel_loc_turn4(i)
- & +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"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- do j=1,3
- do i=1,nres
- gradbufc(j,i)=gradc(j,i,icg)
- gradbufx(j,i)=gradx(j,i,icg)
- enddo
- enddo
- do i=1,4*nres
- glocbuf(i)=gloc(i,icg)
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_g=time_barrier_g+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
- write (iout,*) "gloc after reduce"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
- endif
-#endif
- if (gnorm_check) then
-c
-c Compute the maximum elements of the gradient
-c
- gvdwc_max=0.0d0
- gvdwc_scp_max=0.0d0
- gelc_max=0.0d0
- gvdwpp_max=0.0d0
- gradb_max=0.0d0
- ghpbc_max=0.0d0
- gradcorr_max=0.0d0
- gel_loc_max=0.0d0
- gcorr3_turn_max=0.0d0
- gcorr4_turn_max=0.0d0
- gradcorr5_max=0.0d0
- gradcorr6_max=0.0d0
- gcorr6_turn_max=0.0d0
- gsccorc_max=0.0d0
- gscloc_max=0.0d0
- gvdwx_max=0.0d0
- gradx_scp_max=0.0d0
- ghpbx_max=0.0d0
- gradxorr_max=0.0d0
- gsccorx_max=0.0d0
- gsclocx_max=0.0d0
- do i=1,nct
- gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
- if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
- gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
- if (gvdwc_scp_norm.gt.gvdwc_scp_max)
- & gvdwc_scp_max=gvdwc_scp_norm
- gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
- if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
- gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
- if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
- gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
- if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
- ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
- if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
- gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
- if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
- gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
- if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
- gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
- & gcorr3_turn(1,i)))
- if (gcorr3_turn_norm.gt.gcorr3_turn_max)
- & gcorr3_turn_max=gcorr3_turn_norm
- gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
- & gcorr4_turn(1,i)))
- if (gcorr4_turn_norm.gt.gcorr4_turn_max)
- & gcorr4_turn_max=gcorr4_turn_norm
- gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
- if (gradcorr5_norm.gt.gradcorr5_max)
- & gradcorr5_max=gradcorr5_norm
- gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
- if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
- gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
- & gcorr6_turn(1,i)))
- if (gcorr6_turn_norm.gt.gcorr6_turn_max)
- & gcorr6_turn_max=gcorr6_turn_norm
- gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
- if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
- gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
- if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
- gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
- if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
- gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
- if (gradx_scp_norm.gt.gradx_scp_max)
- & gradx_scp_max=gradx_scp_norm
- ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
- if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
- gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
- if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
- gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
- if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
- gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
- if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
- enddo
- if (gradout) then
-#ifdef AIX
- open(istat,file=statname,position="append")
-#else
- open(istat,file=statname,access="append")
-#endif
- write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
- & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
- & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
- & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
- close(istat)
- if (gvdwc_max.gt.1.0d4) then
- write (iout,*) "gvdwc gvdwx gradb gradbx"
- do i=nnt,nct
- write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
- & gradb(j,i),gradbx(j,i),j=1,3)
- enddo
- call pdbout(0.0d0,'cipiszcze',iout)
- call flush(iout)
- endif
- endif
- endif
-#ifdef DEBUG
- write (iout,*) "gradc gradx gloc"
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
- enddo
-#endif
-#ifdef TIMING
- time_sumgradient=time_sumgradient+MPI_Wtime()-time01
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine rescale_weights(t_bath)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- double precision kfac /2.4d0/
- double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
-c facT=temp0/t_bath
-c facT=2*temp0/(t_bath+temp0)
- if (rescale_mode.eq.0) then
- facT=1.0d0
- facT2=1.0d0
- facT3=1.0d0
- facT4=1.0d0
- facT5=1.0d0
- else if (rescale_mode.eq.1) then
- facT=kfac/(kfac-1.0d0+t_bath/temp0)
- facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
- facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
- facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
- facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
- else if (rescale_mode.eq.2) then
- x=t_bath/temp0
- x2=x*x
- x3=x2*x
- x4=x3*x
- x5=x4*x
- facT=licznik/dlog(dexp(x)+dexp(-x))
- facT2=licznik/dlog(dexp(x2)+dexp(-x2))
- facT3=licznik/dlog(dexp(x3)+dexp(-x3))
- facT4=licznik/dlog(dexp(x4)+dexp(-x4))
- facT5=licznik/dlog(dexp(x5)+dexp(-x5))
- else
- write (iout,*) "Wrong RESCALE_MODE",rescale_mode
- write (*,*) "Wrong RESCALE_MODE",rescale_mode
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
-#endif
- stop 555
- endif
- welec=weights(3)*fact
- wcorr=weights(4)*fact3
- wcorr5=weights(5)*fact4
- wcorr6=weights(6)*fact5
- wel_loc=weights(7)*fact2
- wturn3=weights(8)*fact2
- wturn4=weights(9)*fact3
- wturn6=weights(10)*fact5
- wtor=weights(13)*fact
- wtor_d=weights(14)*fact2
- wsccor=weights(21)*fact
-
- return
- end
-C------------------------------------------------------------------------
- subroutine enerprint(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.MD'
- double precision energia(0:n_ene)
- etot=energia(0)
- evdw=energia(1)
- evdw2=energia(2)
-#ifdef SCP14
- evdw2=energia(2)+energia(18)
-#else
- evdw2=energia(2)
-#endif
- ees=energia(3)
-#ifdef SPLITELE
- evdw1=energia(16)
-#endif
- ecorr=energia(4)
- ecorr5=energia(5)
- ecorr6=energia(6)
- eel_loc=energia(7)
- eello_turn3=energia(8)
- eello_turn4=energia(9)
- eello_turn6=energia(10)
- ebe=energia(11)
- escloc=energia(12)
- etors=energia(13)
- etors_d=energia(14)
- ehpb=energia(15)
- edihcnstr=energia(19)
- estr=energia(17)
- Uconst=energia(20)
- esccor=energia(21)
-#ifdef SPLITELE
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
- & estr,wbond,ebe,wang,
- & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
- & ecorr,wcorr,
- & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
- & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
- & edihcnstr,ebr*nss,
- & Uconst,etot
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
- & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'UCONST= ',1pE16.6,' (Constraint energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#else
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
- & estr,wbond,ebe,wang,
- & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
- & 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
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'UCONST=',1pE16.6,' (Constraint energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#endif
- return
- end
-C-----------------------------------------------------------------------
- subroutine elj(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C Change 12/1/95
- num_conti=0
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(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)
- if (itypj.eq.21) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
-C Change 12/1/95 to calculate four-body interactions
- rij=xj*xj+yj*yj+zj*zj
- rrij=1.0D0/rij
-c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
-C
-C 12/1/95, revised on 5/20/97
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-C
-C Uncomment next line, if the correlation interactions include EVDW explicitly.
-c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
-C Uncomment next line, if the correlation interactions are contact function only
- if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
- rij=dsqrt(rij)
- sigij=sigma(itypi,itypj)
- r0ij=rs0(itypi,itypj)
-C
-C Check whether the SC's are not too far to make a contact.
-C
- rcut=1.5d0*r0ij
- call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
-C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
-C
- if (fcont.gt.0.0D0) then
-C If the SC-SC distance if close to sigma, apply spline.
-cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
-cAdam & fcont1,fprimcont1)
-cAdam fcont1=1.0d0-fcont1
-cAdam if (fcont1.gt.0.0d0) then
-cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
-cAdam fcont=fcont*fcont1
-cAdam endif
-C Uncomment following 4 lines to have the geometric average of the epsilon0's
-cga eps0ij=1.0d0/dsqrt(eps0ij)
-cga do k=1,3
-cga gg(k)=gg(k)*eps0ij
-cga enddo
-cga eps0ij=-evdwij*eps0ij
-C Uncomment for AL's type of SC correlation interactions.
-cadam eps0ij=-evdwij
- num_conti=num_conti+1
- jcont(num_conti,i)=j
- facont(num_conti,i)=fcont*eps0ij
- fprimcont=eps0ij*fprimcont/rij
- fcont=expon*fcont
-cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
-cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
-cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
-C Uncomment following 3 lines for Skolnick's type of SC correlation.
- gacont(1,num_conti,i)=-fprimcont*xj
- gacont(2,num_conti,i)=-fprimcont*yj
- gacont(3,num_conti,i)=-fprimcont*zj
-cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
-cd write (iout,'(2i3,3f10.5)')
-cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
- endif
- endif
- enddo ! j
- enddo ! iint
-C Change 12/1/95
- num_cont(i)=num_conti
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eljk(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e_augm+e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- evdw=0.0D0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-cd if (icall.eq.0) then
-cd rrsave(ind)=rrij
-cd else
-cd rrij=rrsave(ind)
-cd endif
- rij=dsqrt(rrij)
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
- call sc_grad
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- logical lprn
- evdw=0.0D0
-ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.false.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
-c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c & 1.0d0/vbld(j+nres)
-c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
-c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c write (iout,*) "j",j," dc_norm",
-c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-c for diagnostics; uncomment
-c rij_shift=1.2*sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-c fac=0.0d0
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad
- enddo ! j
- enddo ! iint
- enddo ! i
-c write (iout,*) "Number of loop steps in EGB:",ind
-cccc energy_dec=.false.
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egbv(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij+e_augm
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
- & chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij+e_augm
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C-----------------------------------------------------------------------------
- subroutine sc_angular
-C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
-C om12. Called by ebp, egb, and egbv.
- implicit none
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- chiom12=chi12*om12
-C Calculate eps1(om12) and its derivative in om12
- faceps1=1.0D0-om12*chiom12
- faceps1_inv=1.0D0/faceps1
- eps1=dsqrt(faceps1_inv)
-C Following variable is eps1*deps1/dom12
- eps1_om12=faceps1_inv*chiom12
-c diagnostics only
-c faceps1_inv=om12
-c eps1=om12
-c eps1_om12=1.0d0
-c write (iout,*) "om12",om12," eps1",eps1
-C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
-C and om12.
- om1om2=om1*om2
- chiom1=chi1*om1
- chiom2=chi2*om2
- facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
- sigsq=1.0D0-facsig*faceps1_inv
- sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
- sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
- sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
-c diagnostics only
-c sigsq=1.0d0
-c sigsq_om1=0.0d0
-c sigsq_om2=0.0d0
-c sigsq_om12=0.0d0
-c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
-c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
-c & " eps1",eps1
-C Calculate eps2 and its derivatives in om1, om2, and om12.
- chipom1=chip1*om1
- chipom2=chip2*om2
- chipom12=chip12*om12
- facp=1.0D0-om12*chipom12
- facp_inv=1.0D0/facp
- facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
-c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
-c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
-C Following variable is the square root of eps2
- eps2rt=1.0D0-facp1*facp_inv
-C Following three variables are the derivatives of the square root of eps
-C in om1, om2, and om12.
- eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
- eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
- eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
-C Evaluate the "asymmetric" factor in the VDW constant, eps3
- eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
-c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
-c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
-c & " eps2rt_om12",eps2rt_om12
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- return
- end
-C----------------------------------------------------------------------------
- subroutine sc_grad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- double precision dcosom1(3),dcosom2(3)
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
-c diagnostics only
-c eom1=0.0d0
-c eom2=0.0d0
-c eom12=evdwij*eps1_om12
-c end diagnostics
-c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-c & " sigder",sigder
-c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- do k=1,3
- gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
-c write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
- enddo
- return
- end
-C-----------------------------------------------------------------------
- subroutine e_softsphere(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(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)
- if (itypj.eq.21) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rij=xj*xj+yj*yj+zj*zj
-c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
- r0ij=r0(itypi,itypj)
- r0ijsq=r0ij*r0ij
-c print *,i,j,r0ij,dsqrt(rij)
- if (rij.lt.r0ijsq) then
- evdwij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdwij=0.0d0
- fac=0.0d0
- endif
- evdw=evdw+evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! iint
- enddo ! i
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
- & eello_turn4)
-C
-C Soft-sphere potential of p-p interaction
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- dimension ggg(3)
-cd write(iout,*) 'In EELEC_soft_sphere'
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=iatel_s,iatel_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- do j=ielstart(i),ielend(i)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- r0ij=rpp(iteli,itelj)
- r0ijsq=r0ij*r0ij
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- if (rij.lt.r0ijsq) then
- evdw1ij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdw1ij=0.0d0
- fac=0.0d0
- endif
- evdw1=evdw1+evdw1ij
-C
-C Calculate contributions to the Cartesian gradient.
-C
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
- do k=1,3
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! i
-cgrad do i=nnt,nct-1
-cgrad do k=1,3
-cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
-cgrad enddo
-cgrad do j=i+1,nct-1
-cgrad do k=1,3
-cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
-cgrad enddo
-cgrad enddo
-cgrad enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine vec_and_deriv
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
-C Compute the local reference systems. For reference system (i), the
-C X-axis points from CA(i) to CA(i+1), the Y axis is in the
-C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
-#ifdef PARVEC
- do i=ivec_start,ivec_end
-#else
- do i=1,nres-1
-#endif
- if (i.eq.nres-1) then
-C Case of the last full residue
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
- costh=dcos(pi-theta(nres))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i-1)
- uzder(3,1,1)= dc_norm(2,i-1)
- uzder(1,2,1)= dc_norm(3,i-1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i-1)
- uzder(1,3,1)=-dc_norm(2,i-1)
- uzder(2,3,1)= dc_norm(1,i-1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i-1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- else
-C Other residues
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
- costh=dcos(pi-theta(i+2))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i+1)
- uzder(3,1,1)= dc_norm(2,i+1)
- uzder(1,2,1)= dc_norm(3,i+1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i+1)
- uzder(1,3,1)=-dc_norm(2,i+1)
- uzder(2,3,1)= dc_norm(1,i+1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i+1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- endif
- enddo
- do i=1,nres-1
- vbld_inv_temp(1)=vbld_inv(i+1)
- if (i.lt.nres-1) then
- vbld_inv_temp(2)=vbld_inv(i+2)
- else
- vbld_inv_temp(2)=vbld_inv(i)
- endif
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
- uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
-#if defined(PARVEC) && defined(MPI)
- if (nfgtasks1.gt.1) then
- time00=MPI_Wtime()
-c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
-c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
-c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
- call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
- & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
- & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
- & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
- & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
- call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
- & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
- & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
- time_gather=time_gather+MPI_Wtime()-time00
- endif
-c if (fg_rank.eq.0) then
-c write (iout,*) "Arrays UY and UZ"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
-c & (uz(k,i),k=1,3)
-c enddo
-c endif
-#endif
- return
- end
-C-----------------------------------------------------------------------------
- subroutine check_vecgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
- dimension uyt(3,maxres),uzt(3,maxres)
- dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
- double precision delta /1.0d-7/
- call vec_and_deriv
-cd do i=1,nres
-crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
-cd & (dc_norm(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
-cd write(iout,'(a)')
-cd enddo
- do i=1,nres
- do j=1,2
- do k=1,3
- do l=1,3
- uygradt(l,k,j,i)=uygrad(l,k,j,i)
- uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
- call vec_and_deriv
- do i=1,nres
- do j=1,3
- uyt(j,i)=uy(j,i)
- uzt(j,i)=uz(j,i)
- enddo
- enddo
- do i=1,nres
-cd write (iout,*) 'i=',i
- do k=1,3
- erij(k)=dc_norm(k,i)
- enddo
- do j=1,3
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
- dc_norm(j,i)=dc_norm(j,i)+delta
-c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
-c do k=1,3
-c dc_norm(k,i)=dc_norm(k,i)/fac
-c enddo
-c write (iout,*) (dc_norm(k,i),k=1,3)
-c write (iout,*) (erij(k),k=1,3)
- call vec_and_deriv
- do k=1,3
- uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
- uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
- uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
- uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
- enddo
-c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
-c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
- enddo
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
-cd do k=1,3
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
-cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
-cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
-cd write (iout,'(a)')
-cd enddo
- enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine set_matrices
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
- include "COMMON.SETUP"
- integer IERR
- integer status(MPI_STATUS_SIZE)
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- double precision auxvec(2),auxmat(2,2)
-C
-C Compute the virtual-bond-torsional-angle dependent quantities needed
-C to calculate the el-loc multibody terms of various order.
-C
-#ifdef PARMAT
- do i=ivec_start+2,ivec_end+2
-#else
- do i=3,nres+1
-#endif
- if (i .lt. nres+1) then
- sin1=dsin(phi(i))
- cos1=dcos(phi(i))
- sintab(i-2)=sin1
- costab(i-2)=cos1
- obrot(1,i-2)=cos1
- obrot(2,i-2)=sin1
- sin2=dsin(2*phi(i))
- cos2=dcos(2*phi(i))
- sintab2(i-2)=sin2
- costab2(i-2)=cos2
- obrot2(1,i-2)=cos2
- obrot2(2,i-2)=sin2
- Ug(1,1,i-2)=-cos1
- Ug(1,2,i-2)=-sin1
- Ug(2,1,i-2)=-sin1
- Ug(2,2,i-2)= cos1
- Ug2(1,1,i-2)=-cos2
- Ug2(1,2,i-2)=-sin2
- Ug2(2,1,i-2)=-sin2
- Ug2(2,2,i-2)= cos2
- else
- costab(i-2)=1.0d0
- sintab(i-2)=0.0d0
- obrot(1,i-2)=1.0d0
- obrot(2,i-2)=0.0d0
- obrot2(1,i-2)=0.0d0
- obrot2(2,i-2)=0.0d0
- Ug(1,1,i-2)=1.0d0
- Ug(1,2,i-2)=0.0d0
- Ug(2,1,i-2)=0.0d0
- Ug(2,2,i-2)=1.0d0
- Ug2(1,1,i-2)=0.0d0
- Ug2(1,2,i-2)=0.0d0
- Ug2(2,1,i-2)=0.0d0
- Ug2(2,2,i-2)=0.0d0
- endif
- if (i .gt. 3 .and. i .lt. nres+1) then
- obrot_der(1,i-2)=-sin1
- obrot_der(2,i-2)= cos1
- Ugder(1,1,i-2)= sin1
- Ugder(1,2,i-2)=-cos1
- Ugder(2,1,i-2)=-cos1
- Ugder(2,2,i-2)=-sin1
- dwacos2=cos2+cos2
- dwasin2=sin2+sin2
- obrot2_der(1,i-2)=-dwasin2
- obrot2_der(2,i-2)= dwacos2
- Ug2der(1,1,i-2)= dwasin2
- Ug2der(1,2,i-2)=-dwacos2
- Ug2der(2,1,i-2)=-dwacos2
- Ug2der(2,2,i-2)=-dwasin2
- else
- obrot_der(1,i-2)=0.0d0
- obrot_der(2,i-2)=0.0d0
- Ugder(1,1,i-2)=0.0d0
- Ugder(1,2,i-2)=0.0d0
- Ugder(2,1,i-2)=0.0d0
- Ugder(2,2,i-2)=0.0d0
- obrot2_der(1,i-2)=0.0d0
- obrot2_der(2,i-2)=0.0d0
- Ug2der(1,1,i-2)=0.0d0
- Ug2der(1,2,i-2)=0.0d0
- Ug2der(2,1,i-2)=0.0d0
- Ug2der(2,2,i-2)=0.0d0
- endif
-c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
- iti = itortyp(itype(i-2))
- else
- iti=ntortyp+1
- endif
-c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
-cd write (iout,*) '*******i',i,' iti1',iti
-cd write (iout,*) 'b1',b1(:,iti)
-cd write (iout,*) 'b2',b2(:,iti)
-cd write (iout,*) 'Ug',Ug(:,:,i-2)
-c if (i .gt. iatel_s+2) then
- if (i .gt. nnt+2) then
- call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
- call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
- call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
- endif
- else
- do k=1,2
- Ub2(k,i-2)=0.0d0
- Ctobr(k,i-2)=0.0d0
- Dtobr2(k,i-2)=0.0d0
- do l=1,2
- EUg(l,k,i-2)=0.0d0
- CUg(l,k,i-2)=0.0d0
- DUg(l,k,i-2)=0.0d0
- DtUg2(l,k,i-2)=0.0d0
- enddo
- enddo
- endif
- call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
- call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
- do k=1,2
- muder(k,i-2)=Ub2der(k,i-2)
- enddo
-c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
- do k=1,2
- mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
- enddo
-cd write (iout,*) 'mu ',mu(:,i-2)
-cd write (iout,*) 'mu1',mu1(:,i-2)
-cd write (iout,*) 'mu2',mu2(:,i-2)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
- & then
- call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
- call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
-C Vectors and matrices dependent on a single virtual-bond dihedral.
- call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
- call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
- call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
- call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
- call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
- endif
- enddo
-C Matrices dependent on two consecutive virtual-bond dihedrals.
-C The order of matrices is from left to right.
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
- &then
-c do i=max0(ivec_start,2),ivec_end
- do i=2,nres-1
- call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
- call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
- call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
- call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
- call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
- call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
- enddo
- endif
-#if defined(MPI) && defined(PARMAT)
-#ifdef DEBUG
-c if (fg_rank.eq.0) then
- write (iout,*) "Arrays UG and UGDER before GATHER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug(l,k,i),l=1,2),k=1,2),
- & ((ugder(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays UG2 and UG2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug2(l,k,i),l=1,2),k=1,2),
- & ((ug2der(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
- & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
- enddo
- write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & costab(i),sintab(i),costab2(i),sintab2(i)
- enddo
- write (iout,*) "Array MUDER"
- do i=1,nres-1
- write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
- enddo
-c endif
-#endif
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
-c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
-c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
-#ifdef MATGATHER
- call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
- & MPI_MAT2,FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
- & MPI_MAT2,FG_COMM1,IERR)
- endif
-#else
-c Passes matrix info through the ring
- isend=fg_rank1
- irecv=fg_rank1-1
- if (irecv.lt.0) irecv=nfgtasks1-1
- iprev=irecv
- inext=fg_rank1+1
- if (inext.ge.nfgtasks1) inext=0
- do i=1,nfgtasks1-1
-c write (iout,*) "isend",isend," irecv",irecv
-c call flush(iout)
- lensend=lentyp(isend)
- lenrecv=lentyp(irecv)
-c write (iout,*) "lensend",lensend," lenrecv",lenrecv
-c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
-c & MPI_ROTAT1(lensend),inext,2200+isend,
-c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
-c & iprev,2200+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT1"
-c call flush(iout)
-c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
-c & MPI_ROTAT2(lensend),inext,3300+isend,
-c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
-c & iprev,3300+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT2"
-c call flush(iout)
- call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
- & MPI_ROTAT_OLD(lensend),inext,4400+isend,
- & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
- & iprev,4400+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT_OLD"
-c call flush(iout)
- call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP11(lensend),inext,5500+isend,
- & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
- & iprev,5500+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP11"
-c call flush(iout)
- call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP12(lensend),inext,6600+isend,
- & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
- & iprev,6600+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP12"
-c call flush(iout)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
- & MPI_ROTAT2(lensend),inext,7700+isend,
- & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
- & iprev,7700+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP21"
-c call flush(iout)
- call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP22(lensend),inext,8800+isend,
- & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
- & iprev,8800+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP22"
-c call flush(iout)
- call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP23(lensend),inext,9900+isend,
- & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
- & MPI_PRECOMP23(lenrecv),
- & iprev,9900+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP23"
-c call flush(iout)
- endif
- isend=irecv
- irecv=irecv-1
- if (irecv.lt.0) irecv=nfgtasks1-1
- enddo
-#endif
- time_gather=time_gather+MPI_Wtime()-time00
- endif
-#ifdef DEBUG
-c if (fg_rank.eq.0) then
- write (iout,*) "Arrays UG and UGDER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug(l,k,i),l=1,2),k=1,2),
- & ((ugder(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays UG2 and UG2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug2(l,k,i),l=1,2),k=1,2),
- & ((ug2der(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
- & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
- enddo
- write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & costab(i),sintab(i),costab2(i),sintab2(i)
- enddo
- write (iout,*) "Array MUDER"
- do i=1,nres-1
- write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
- enddo
-c endif
-#endif
-#endif
-cd do i=1,nres
-cd iti = itortyp(itype(i))
-cd write (iout,*) i
-cd do j=1,2
-cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
-cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
-cd enddo
-cd enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C
-C This subroutine calculates the average interaction energy and its gradient
-C in the virtual-bond vectors between non-adjacent peptide groups, based on
-C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
-C The potential depends both on the distance of peptide-group centers and on
-C the orientation of the CA-CA virtual bonds.
-C
- implicit real*8 (a-h,o-z)
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-cd write(iout,*) 'In EELEC'
-cd do i=1,nloctyp
-cd write(iout,*) 'Type',i
-cd write(iout,*) 'B1',B1(:,i)
-cd write(iout,*) 'B2',B2(:,i)
-cd write(iout,*) 'CC',CC(:,:,i)
-cd write(iout,*) 'DD',DD(:,:,i)
-cd write(iout,*) 'EE',EE(:,:,i)
-cd enddo
-cd call check_vecgrad
-cd stop
- if (icheckgrad.eq.1) then
- do i=1,nres-1
- fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
- do k=1,3
- dc_norm(k,i)=dc(k,i)*fac
- enddo
-c write (iout,*) 'i',i,' fac',fac
- enddo
- endif
- if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
- & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
-c call vec_and_deriv
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call set_matrices
-#ifdef TIMING
- time_mat=time_mat+MPI_Wtime()-time01
-#endif
- endif
-cd do i=1,nres-1
-cd write (iout,*) 'i=',i
-cd do k=1,3
-cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
-cd enddo
-cd do k=1,3
-cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
-cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
-cd enddo
-cd enddo
- t_eelecij=0.0d0
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=1,nres
- num_cont_hb(i)=0
- enddo
-cd print '(a)','Enter EELEC'
-cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- enddo
-c
-c
-c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
-C
-C Loop over i,i+2 and i,i+3 pairs of the peptide groups
-C
- do i=iturn3_start,iturn3_end
- if (itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
- call eelecij(i,i+2,ees,evdw1,eel_loc)
- if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
- num_cont_hb(i)=num_conti
- enddo
- do i=iturn4_start,iturn4_end
- if (itype(i).eq.21 .or. itype(i+1).eq.21 .or.
-c-----> Probably bug; should also handle itype(i+2)
- & .or. itype(i+3).eq.21
- & .or. itype(i+4).eq.21) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=num_cont_hb(i)
- call eelecij(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21)
- & call eturn4(i,eello_turn4)
- num_cont_hb(i)=num_conti
- enddo ! i
-c
-c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
-c
- do i=iatel_s,iatel_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
-c write (iout,*) i,j,itype(i),itype(j)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
- call eelecij(i,j,ees,evdw1,eel_loc)
- enddo ! j
- num_cont_hb(i)=num_conti
- enddo ! i
-c write (iout,*) "Number of loop steps in EELEC:",ind
-cd do i=1,nres
-cd write (iout,'(i3,3f10.5,5x,3f10.5)')
-cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
-cd enddo
-c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
-ccc eel_loc=eel_loc+eello_turn3
-cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eelecij(i,j,ees,evdw1,eel_loc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-c time00=MPI_Wtime()
-cd write (iout,*) "eelecij",i,j
-c ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- rmij=1.0D0/rij
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
-C 12/26/95 - for the evaluation of multi-body H-bonding interactions
- ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij
- evdw1=evdw1+evdwij
-cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
-cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
-cd & xmedi,ymedi,zmedi,xj,yj,zj
-
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
- write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
- endif
-
-C
-C Calculate contributions to the Cartesian gradient.
-C
-#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)
- facel=-3*rrmij*(el1+eesij)
- fac1=fac
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
-c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-#else
- facvdw=ev1+evdwij
- facel=el1+eesij
- fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc(k,j)+ggg(k)
- gelc_long(k,i)=gelc(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-#endif
-*
-* Angular part
-*
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
-cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
-cd & (dcosg(k),k=1,3)
- do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
- enddo
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
-c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
-c gelc(k,j)=gelc(k,j)+ghalf
-c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
-c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-c enddo
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gelc(k,i)=gelc(k,i)
- & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gelc(k,j)=gelc(k,j)
- & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
- & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C
-C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
-C energy of a peptide unit is assumed in the form of a second-order
-C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
-C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
-C are computed for EVERY pair of non-contiguous peptide groups.
-C
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
- enddo
- enddo
-cd write (iout,*) 'EELEC: i',i,' j',j
-cd write (iout,*) 'j',j,' j1',j1,' j2',j2
-cd write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
- fac=dsqrt(-ael6i)*r3ij
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
-cd write (iout,'(4i5,4f10.5)')
-cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
-cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
-cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
-cd & uy(:,j),uz(:,j)
-cd write (iout,'(4f10.5)')
-cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
-cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
-cd write (iout,'(4f10.5)') ury,urz,vry,vrz
-cd write (iout,'(9f10.5/)')
-cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
-C Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
- do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
- enddo
-C Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
-C Add the contributions coming from er
- fac3=-3.0d0*fac
- do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
- do k=1,3
-C Derivatives in DC(i)
-cgrad ghalf1=0.5d0*agg(k,1)
-cgrad ghalf2=0.5d0*agg(k,2)
-cgrad ghalf3=0.5d0*agg(k,3)
-cgrad ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
- & -3.0d0*uryg(k,2)*vry)!+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
- & -3.0d0*uryg(k,2)*vrz)!+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
- & -3.0d0*urzg(k,2)*vry)!+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
- & -3.0d0*urzg(k,2)*vrz)!+ghalf4
-C Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
- & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
- & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
- & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
- & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
-C Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
- & -3.0d0*vryg(k,2)*ury)!+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
- & -3.0d0*vrzg(k,2)*ury)!+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
- & -3.0d0*vryg(k,2)*urz)!+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
- & -3.0d0*vrzg(k,2)*urz)!+ghalf4
-C Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
- & -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
- & -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
- & -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
- & -3.0d0*vrzg(k,3)*urz)
-cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
-cgrad do l=1,4
-cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
-cgrad enddo
-cgrad endif
- enddo
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
- a22=-a22
- a23=-a23
- do l=1,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
- IF (wel_loc.gt.0.0d0) THEN
-C Contribution to the local-electrostatic energy coming from the i-j pair
- eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
- & +a33*muij(4)
-cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eelloc',i,j,eel_loc_ij
-
- eel_loc=eel_loc+eel_loc_ij
-C Partial derivatives in virtual-bond dihedral angles gamma
- if (i.gt.1)
- & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
- & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
- & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+
- & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
- & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
-C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
- do l=1,3
- ggg(l)=agg(l,1)*muij(1)+
- & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
- gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
- gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
-cgrad ghalf=0.5d0*ggg(l)
-cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
-cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
- enddo
-cgrad do k=i+1,j2
-cgrad do l=1,3
-cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-C Remaining derivatives of eello
- do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
- & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
- gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
- & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
- gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
- & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
- gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
- & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
- enddo
- ENDIF
-C Change 12/26/95 to calculate four-body contributions to H-bonding energy
-c if (j.gt.i+1 .and. num_conti.le.maxconts) then
- if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
- & .and. num_conti.le.maxconts) then
-c write (iout,*) i,j," entered corr"
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-c r0ij=1.02D0*rpp(iteli,itelj)
-c r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-c r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',
- & ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
-cd write (iout,*) "i",i," j",j," num_conti",num_conti,
-cd & " jcont_hb",jcont_hb(num_conti,i)
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
- & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
-C terms.
- d_cont(num_conti,i)=rij
-cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
-C --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
-C --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
- enddo
- enddo
- enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
-C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-c fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
-c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
-c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
-c ees0mij=0.0D0
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
-C Diagnostics. Comment out or remove after debugging!
-c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
-c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
-c ees0m(num_conti,i)=0.0D0
-C End diagnostics.
-c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
-c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
-C Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-c ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
-C Diagnostics
-c ecosap=ecosa1
-c ecosbp=ecosb1
-c ecosgp=ecosg1
-c ecosam=0.0D0
-c ecosbm=0.0D0
-c ecosgm=0.0D0
-C End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
-cd facont_hb(num_conti,i)=1.0D0
-C Following line is for diagnostics.
-cd fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
-C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
-c
-c 10/24/08 cgrad and ! comments indicate the parts of the code removed
-c following the change of gradient-summation algorithm.
-c
-cgrad ghalfp=0.5D0*gggp(k)
-cgrad ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontp_hb2(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontm_hb2(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- enddo
-C Diagnostics. Comment out or remove after debugging!
-cdiag do k=1,3
-cdiag gacontp_hb1(k,num_conti,i)=0.0D0
-cdiag gacontp_hb2(k,num_conti,i)=0.0D0
-cdiag gacontp_hb3(k,num_conti,i)=0.0D0
-cdiag gacontm_hb1(k,num_conti,i)=0.0D0
-cdiag gacontm_hb2(k,num_conti,i)=0.0D0
-cdiag gacontm_hb3(k,num_conti,i)=0.0D0
-cdiag enddo
- ENDIF ! wcorr
- endif ! num_conti.le.maxconts
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
- do k=1,4
- do l=1,3
- ghalf=0.5d0*agg(l,k)
- aggi(l,k)=aggi(l,k)+ghalf
- aggi1(l,k)=aggi1(l,k)+agg(l,k)
- aggj(l,k)=aggj(l,k)+ghalf
- enddo
- enddo
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do k=1,4
- do l=1,3
- aggj1(l,k)=aggj1(l,k)+agg(l,k)
- enddo
- enddo
- endif
- endif
-c t_eelecij=t_eelecij+MPI_Wtime()-time00
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eturn3(i,eello_turn3)
-C Third- and fourth-order contributions from turns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
- & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
- & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
- double precision agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
- j=i+2
-c write (iout,*) "eturn3",i,j,j1,j2
- a_temp(1,1)=a22
- a_temp(1,2)=a23
- a_temp(2,1)=a32
- a_temp(2,2)=a33
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Third-order contributions
-C
-C (i+2)o----(i+3)
-C | |
-C | |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn3(i,a_temp,eello_turn3_num)
- call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
- call transpose2(auxmat(1,1),auxmat1(1,1))
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
-cd write (2,*) 'i,',i,' j',j,'eello_turn3',
-cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
-cd & ' eello_turn3_num',4*eello_turn3_num
-C Derivatives in gamma(i)
- call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),auxmat3(1,1))
- call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
- gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
-C Derivatives in gamma(i+1)
- call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),auxmat3(1,1))
- call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
- gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
-C Cartesian derivatives
- do l=1,3
-c ghalf1=0.5d0*agg(l,1)
-c ghalf2=0.5d0*agg(l,2)
-c ghalf3=0.5d0*agg(l,3)
-c ghalf4=0.5d0*agg(l,4)
- a_temp(1,1)=aggi(l,1)!+ghalf1
- a_temp(1,2)=aggi(l,2)!+ghalf2
- a_temp(2,1)=aggi(l,3)!+ghalf3
- a_temp(2,2)=aggi(l,4)!+ghalf4
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i)=gcorr3_turn(l,i)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggi1(l,1)!+agg(l,1)
- a_temp(1,2)=aggi1(l,2)!+agg(l,2)
- a_temp(2,1)=aggi1(l,3)!+agg(l,3)
- a_temp(2,2)=aggi1(l,4)!+agg(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggj(l,1)!+ghalf1
- a_temp(1,2)=aggj(l,2)!+ghalf2
- a_temp(2,1)=aggj(l,3)!+ghalf3
- a_temp(2,2)=aggj(l,4)!+ghalf4
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j)=gcorr3_turn(l,j)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- enddo
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eturn4(i,eello_turn4)
-C Third- and fourth-order contributions from turns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
- & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
- & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
- double precision agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
- j=i+3
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Fourth-order contributions
-C
-C (i+3)o----(i+4)
-C / |
-C (i+2)o |
-C \ |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn4(i,a_temp,eello_turn4_num)
-c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
- a_temp(1,1)=a22
- a_temp(1,2)=a23
- a_temp(2,1)=a32
- a_temp(2,2)=a33
- iti1=itortyp(itype(i+1))
- iti2=itortyp(itype(i+2))
- iti3=itortyp(itype(i+3))
-c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
- call transpose2(EUg(1,1,i+1),e1t(1,1))
- call transpose2(Eug(1,1,i+2),e2t(1,1))
- call transpose2(Eug(1,1,i+3),e3t(1,1))
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- eello_turn4=eello_turn4-(s1+s2+s3)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eturn4',i,j,-(s1+s2+s3)
-cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
-cd & ' eello_turn4_num',8*eello_turn4_num
-C Derivatives in gamma(i)
- call transpose2(EUgder(1,1,i+1),e1tder(1,1))
- call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
-C Derivatives in gamma(i+1)
- call transpose2(EUgder(1,1,i+2),e2tder(1,1))
- call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
- call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
-C Derivatives in gamma(i+2)
- call transpose2(EUgder(1,1,i+3),e3tder(1,1))
- call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
- call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
-C Cartesian derivatives
-C Derivatives of this turn contributions in DC(i+2)
- if (j.lt.nres-1) then
- do l=1,3
- a_temp(1,1)=agg(l,1)
- a_temp(1,2)=agg(l,2)
- a_temp(2,1)=agg(l,3)
- a_temp(2,2)=agg(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- ggg(l)=-(s1+s2+s3)
- gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
- enddo
- endif
-C Remaining derivatives of this turn contribution
- do l=1,3
- a_temp(1,1)=aggi(l,1)
- a_temp(1,2)=aggi(l,2)
- a_temp(2,1)=aggi(l,3)
- a_temp(2,2)=aggi(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
- a_temp(1,1)=aggi1(l,1)
- a_temp(1,2)=aggi1(l,2)
- a_temp(2,1)=aggi1(l,3)
- a_temp(2,2)=aggi1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
- a_temp(1,1)=aggj(l,1)
- a_temp(1,2)=aggj(l,2)
- a_temp(2,1)=aggj(l,3)
- a_temp(2,2)=aggj(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
-c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
- gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine vecpr(u,v,w)
- implicit real*8(a-h,o-z)
- dimension u(3),v(3),w(3)
- w(1)=u(2)*v(3)-u(3)*v(2)
- w(2)=-u(1)*v(3)+u(3)*v(1)
- w(3)=u(1)*v(2)-u(2)*v(1)
- return
- end
-C-----------------------------------------------------------------------------
- subroutine unormderiv(u,ugrad,unorm,ungrad)
-C This subroutine computes the derivatives of a normalized vector u, given
-C the derivatives computed without normalization conditions, ugrad. Returns
-C ungrad.
- implicit none
- double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
- double precision vec(3)
- double precision scalar
- integer i,j
-c write (2,*) 'ugrad',ugrad
-c write (2,*) 'u',u
- do i=1,3
- vec(i)=scalar(ugrad(1,i),u(1))
- enddo
-c write (2,*) 'vec',vec
- do i=1,3
- do j=1,3
- ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
- enddo
- enddo
-c write (2,*) 'ungrad',ungrad
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp_soft_sphere(evdw2,evdw2_14)
-C
-C This subroutine calculates the excluded-volume interaction energy between
-C peptide-group centers and side chains and its gradient in virtual-bond and
-C side-chain vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- evdw2=0.0D0
- evdw2_14=0.0d0
- r0_scp=4.5d0
-cd print '(a)','Enter ESCP'
-cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
- iteli=itel(i)
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
-
- do iint=1,nscp_gr(i)
-
- do j=iscpstart(i,iint),iscpend(i,iint)
- if (itype(j).eq.21) cycle
- 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 zj=c(3,nres+j)-zi
-C Uncomment following three lines for Ca-p interactions
- xj=c(1,j)-xi
- yj=c(2,j)-yi
- zj=c(3,j)-zi
- rij=xj*xj+yj*yj+zj*zj
- r0ij=r0_scp
- r0ijsq=r0ij*r0ij
- if (rij.lt.r0ijsq) then
- evdwij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdwij=0.0d0
- fac=0.0d0
- endif
- evdw2=evdw2+evdwij
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-cgrad if (j.lt.i) then
-cd write (iout,*) 'j<i'
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-cgrad else
-cd write (iout,*) 'j>i'
-cgrad do k=1,3
-cgrad ggg(k)=-ggg(k)
-C Uncomment following line for SC-p interactions
-c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
-cgrad enddo
-cgrad endif
-cgrad do k=1,3
-cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
-cgrad enddo
-cgrad kstart=min0(i+1,j)
-cgrad kend=max0(i-1,j-1)
-cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
-cd write (iout,*) ggg(1),ggg(2),ggg(3)
-cgrad do k=kstart,kend
-cgrad do l=1,3
-cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
- gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
- enddo
- enddo
-
- enddo ! iint
- enddo ! i
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp(evdw2,evdw2_14)
-C
-C This subroutine calculates the excluded-volume interaction energy between
-C peptide-group centers and side chains and its gradient in virtual-bond and
-C side-chain vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- evdw2=0.0D0
- evdw2_14=0.0d0
-cd print '(a)','Enter ESCP'
-cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
- iteli=itel(i)
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
-
- do iint=1,nscp_gr(i)
-
- do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
-C Uncomment following three lines for SC-p interactions
-c xj=c(1,nres+j)-xi
-c yj=c(2,nres+j)-yi
-c zj=c(3,nres+j)-zi
-C Uncomment following three lines for Ca-p interactions
- xj=c(1,j)-xi
- yj=c(2,j)-yi
- zj=c(3,j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac=rrij**expon2
- e1=fac*fac*aad(itypj,iteli)
- e2=fac*bad(itypj,iteli)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- evdw2_14=evdw2_14+e1+e2
- endif
- evdwij=e1+e2
- evdw2=evdw2+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw2',i,j,evdwij
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- fac=-(evdwij+e1)*rrij
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-cgrad if (j.lt.i) then
-cd write (iout,*) 'j<i'
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-cgrad else
-cd write (iout,*) 'j>i'
-cgrad do k=1,3
-cgrad ggg(k)=-ggg(k)
-C Uncomment following line for SC-p interactions
-ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-cgrad enddo
-cgrad endif
-cgrad do k=1,3
-cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
-cgrad enddo
-cgrad kstart=min0(i+1,j)
-cgrad kend=max0(i-1,j-1)
-cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
-cd write (iout,*) ggg(1),ggg(2),ggg(3)
-cgrad do k=kstart,kend
-cgrad do l=1,3
-cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
- gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
- enddo
- enddo
-
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
- gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
- gradx_scp(j,i)=expon*gradx_scp(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time the factor EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C--------------------------------------------------------------------------
- subroutine edis(ehpb)
-C
-C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- dimension ggg(3)
- ehpb=0.0D0
-cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
-cd write(iout,*)'link_start=',link_start,' link_end=',link_end
- if (link_end.eq.0) return
- do i=link_start,link_end
-C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
-C CA-CA distance used in regularization of structure.
- ii=ihpb(i)
- jj=jhpb(i)
-C iii and jjj point to the residues for which the distance is assigned.
- if (ii.gt.nres) then
- iii=ii-nres
- jjj=jj-nres
- else
- iii=ii
- jjj=jj
- endif
-cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
-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
- call ssbond_ene(iii,jjj,eij)
- ehpb=ehpb+2*eij
-cd write (iout,*) "eij",eij
- else
-C Calculate the distance between the two points and its difference from the
-C target distance.
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
-C Get the force constant corresponding to this distance.
- waga=forcon(i)
-C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-C
-C Evaluate gradient.
-C
- fac=waga*rdis/dd
-cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
-cd & ' waga=',waga,' fac=',fac
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
-cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
-C If this is a SC-SC distance, we need to calculate the contributions to the
-C Cartesian gradient in the SC vectors (ghpbx).
- if (iii.lt.ii) then
- do j=1,3
- ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
- ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
- enddo
- endif
-cgrad do j=iii,jjj-1
-cgrad do k=1,3
-cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
-cgrad enddo
-cgrad enddo
- do k=1,3
- ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
- ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
- enddo
- endif
- enddo
- ehpb=0.5D0*ehpb
- return
- end
-C--------------------------------------------------------------------------
- subroutine ssbond_ene(i,j,eij)
-C
-C Calculate the distance and angle dependent SS-bond potential energy
-C using a free-energy function derived based on RHF/6-31G** ab initio
-C calculations of diethyl disulfide.
-C
-C A. Liwo and U. Kozlowska, 11/24/03
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=itype(i)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(nres+i)
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(nres+j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- rij=1.0d0/rij
- deltad=rij-d0cm
- deltat1=1.0d0-om1
- deltat2=1.0d0+om2
- deltat12=om2-om1+2.0d0
- cosphi=om12-om1*om2
- eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
- & +akct*deltad*deltat12
- & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
-c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
-c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
-c & " deltat12",deltat12," eij",eij
- ed=2*akcm*deltad+akct*deltat12
- pom1=akct*deltad
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
- do k=1,3
- ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- ghpbx(k,i)=ghpbx(k,i)-ggk
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- ghpbx(k,j)=ghpbx(k,j)+ggk
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- ghpbc(k,i)=ghpbc(k,i)-ggk
- ghpbc(k,j)=ghpbc(k,j)+ggk
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine ebond(estr)
-c
-c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- double precision u(3),ud(3)
- estr=0.0d0
- estr1=0.0d0
- do i=ibondp_start,ibondp_end
- if (itype(i-1).eq.21 .or. itype(i).eq.21) then
- estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
- do j=1,3
- gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
- & *dc(j,i-1)/vbld(i)
- enddo
- if (energy_dec) write(iout,*)
- & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
- else
- diff = vbld(i)-vbldp0
- if (energy_dec) write (iout,*)
- & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
- estr=estr+diff*diff
- do j=1,3
- gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
- enddo
-c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
- endif
- enddo
- estr=0.5d0*AKP*estr+estr1
-c
-c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
-c
- do i=ibond_start,ibond_end
- iti=itype(i)
- if (iti.ne.10 .and. iti.ne.21) then
- nbi=nbondterm(iti)
- if (nbi.eq.1) then
- diff=vbld(i+nres)-vbldsc0(1,iti)
- if (energy_dec) write (iout,*)
- & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
- & AKSC(1,iti),AKSC(1,iti)*diff*diff
- estr=estr+0.5d0*AKSC(1,iti)*diff*diff
- do j=1,3
- gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
- enddo
- else
- do j=1,nbi
- diff=vbld(i+nres)-vbldsc0(j,iti)
- ud(j)=aksc(j,iti)*diff
- u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
- enddo
- uprod=u(1)
- do j=2,nbi
- uprod=uprod*u(j)
- enddo
- usum=0.0d0
- usumsqder=0.0d0
- do j=1,nbi
- uprod1=1.0d0
- uprod2=1.0d0
- do k=1,nbi
- if (k.ne.j) then
- uprod1=uprod1*u(k)
- uprod2=uprod2*u(k)*u(k)
- endif
- enddo
- usum=usum+uprod1
- usumsqder=usumsqder+ud(j)*uprod2
- enddo
- estr=estr+uprod/usum
- do j=1,3
- gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
- enddo
- endif
- endif
- enddo
- return
- end
-#ifdef CRYST_THETA
-C--------------------------------------------------------------------------
- subroutine ebend(etheta)
-C
-C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
-C angles gamma and its derivatives in consecutive thetas and gammas.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
- double precision y(2),z(2)
- delta=0.02d0*pi
-c time11=dexp(-2*time)
-c time12=1.0d0
- etheta=0.0D0
-c write (*,'(a,i2)') 'EBEND ICG=',icg
- do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
-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)
- if (i.gt.3 .and. itype(i-2).ne.21) then
-#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
-#else
- phii=phi(i)
-#endif
- y(1)=dcos(phii)
- y(2)=dsin(phii)
- else
- y(1)=0.0D0
- y(2)=0.0D0
- endif
- if (i.lt.nres .and. itype(i).ne.21) then
-#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
- z(1)=cos(phii1)
-#else
- phii1=phi(i+1)
- z(1)=dcos(phii1)
-#endif
- z(2)=dsin(phii1)
- else
- z(1)=0.0D0
- z(2)=0.0D0
- endif
-C Calculate the "mean" value of theta from the part of the distribution
-C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
-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)
- 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)*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)
- call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
- call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
- call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
- & E_theta)
- call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
- & E_tc)
- else if (theta(i).lt.delta) then
- call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
- call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
- call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
- & E_theta)
- call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
- call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
- & E_tc)
- else
- call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
- & E_theta,E_tc)
- endif
- etheta=etheta+ethetai
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'ebend',i,ethetai
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
- gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
- enddo
-C Ufff.... We've done all this!!!
- return
- end
-C---------------------------------------------------------------------------
- subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
- & E_tc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
-C Calculate the contributions to both Gaussian lobes.
-C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
-C The "polynomial part" of the "standard deviation" of this part of
-C the distribution.
- sig=polthet(3,it)
- do j=2,0,-1
- sig=sig*thet_pred_mean+polthet(j,it)
- enddo
-C Derivative of the "interior part" of the "standard deviation of the"
-C gamma-dependent Gaussian lobe in t_c.
- sigtc=3*polthet(3,it)
- do j=2,1,-1
- sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
- enddo
- sigtc=sig*sigtc
-C Set the parameters of both Gaussian lobes of the distribution.
-C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
- fac=sig*sig+sigc0(it)
- sigcsq=fac+fac
- sigc=1.0D0/sigcsq
-C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
- sigsqtc=-4.0D0*sigcsq*sigtc
-c print *,i,sig,sigtc,sigsqtc
-C Following variable (sigtc) is d[sigma(t_c)]/dt_c
- sigtc=-sigtc/(fac*fac)
-C Following variable is sigma(t_c)**(-2)
- sigcsq=sigcsq*sigcsq
- sig0i=sig0(it)
- sig0inv=1.0D0/sig0i**2
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
- term1=-0.5D0*sigcsq*delthec*delthec
- term2=-0.5D0*sig0inv*delthe0*delthe0
-C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
-C NaNs in taking the logarithm. We extract the largest exponent which is added
-C to the energy (this being the log of the distribution) at the end of energy
-C term evaluation for this virtual-bond angle.
- if (term1.gt.term2) then
- termm=term1
- term2=dexp(term2-termm)
- term1=1.0d0
- else
- termm=term2
- term1=dexp(term1-termm)
- term2=1.0d0
- endif
-C The ratio between the gamma-independent and gamma-dependent lobes of
-C the distribution is a Gaussian function of thet_pred_mean too.
- diffak=gthet(2,it)-thet_pred_mean
- ratak=diffak/gthet(3,it)**2
- ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
-C Let's differentiate it in thet_pred_mean NOW.
- aktc=ak*ratak
-C Now put together the distribution terms to make complete distribution.
- termexp=term1+ak*term2
- termpre=sigc+ak*sig0i
-C Contribution of the bending energy from this theta is just the -log of
-C the sum of the contributions from the two lobes and the pre-exponential
-C factor. Simple enough, isn't it?
- ethetai=(-dlog(termexp)-termm+dlog(termpre))
-C NOW the derivatives!!!
-C 6/6/97 Take into account the deformation.
- E_theta=(delthec*sigcsq*term1
- & +ak*delthe0*sig0inv*term2)/termexp
- E_tc=((sigtc+aktc*sig0i)/termpre
- & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
- & aktc*term2)/termexp)
- return
- end
-c-----------------------------------------------------------------------------
- subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
-C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
- t3 = thetai-thet_pred_mean
- t6 = t3**2
- t9 = term1
- t12 = t3*sigcsq
- t14 = t12+t6*sigsqtc
- t16 = 1.0d0
- t21 = thetai-theta0i
- t23 = t21**2
- t26 = term2
- t27 = t21*t26
- t32 = termexp
- t40 = t32**2
- E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
- & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
- & *(-t12*t9-ak*sig0inv*t27)
- return
- end
-#else
-C--------------------------------------------------------------------------
- subroutine ebend(etheta)
-C
-C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
-C angles gamma and its derivatives in consecutive thetas and gammas.
-C ab initio-derived potentials from
-c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
- & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
- & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
- & sinph1ph2(maxdouble,maxdouble)
- logical lprn /.false./, lprn1 /.false./
- etheta=0.0D0
- do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
- dethetai=0.0d0
- dephii=0.0d0
- dephii1=0.0d0
- theti2=0.5d0*theta(i)
- ityp2=ithetyp(itype(i-1))
- do k=1,nntheterm
- coskt(k)=dcos(k*theti2)
- sinkt(k)=dsin(k*theti2)
- enddo
- if (i.gt.3 .and. itype(i-2).ne.21) then
-#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
-#else
- phii=phi(i)
-#endif
- ityp1=ithetyp(itype(i-2))
- do k=1,nsingle
- cosph1(k)=dcos(k*phii)
- sinph1(k)=dsin(k*phii)
- enddo
- else
- phii=0.0d0
- ityp1=nthetyp+1
- do k=1,nsingle
- cosph1(k)=0.0d0
- sinph1(k)=0.0d0
- enddo
- endif
- if (i.lt.nres .and. itype(i).ne.21) then
-#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
-#else
- phii1=phi(i+1)
-#endif
- ityp3=ithetyp(itype(i))
- do k=1,nsingle
- cosph2(k)=dcos(k*phii1)
- sinph2(k)=dsin(k*phii1)
- enddo
- else
- phii1=0.0d0
- ityp3=nthetyp+1
- do k=1,nsingle
- cosph2(k)=0.0d0
- sinph2(k)=0.0d0
- enddo
- endif
- ethetai=aa0thet(ityp1,ityp2,ityp3)
- do k=1,ndouble
- do l=1,k-1
- ccl=cosph1(l)*cosph2(k-l)
- ssl=sinph1(l)*sinph2(k-l)
- scl=sinph1(l)*cosph2(k-l)
- csl=cosph1(l)*sinph2(k-l)
- cosph1ph2(l,k)=ccl-ssl
- cosph1ph2(k,l)=ccl+ssl
- sinph1ph2(l,k)=scl+csl
- sinph1ph2(k,l)=scl-csl
- enddo
- enddo
- if (lprn) then
- write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
- & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
- write (iout,*) "coskt and sinkt"
- do k=1,nntheterm
- write (iout,*) k,coskt(k),sinkt(k)
- enddo
- endif
- do k=1,ntheterm
- ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
- dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
- & *coskt(k)
- if (lprn)
- & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
- & " ethetai",ethetai
- enddo
- if (lprn) then
- write (iout,*) "cosph and sinph"
- do k=1,nsingle
- write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
- enddo
- write (iout,*) "cosph1ph2 and sinph2ph2"
- do k=2,ndouble
- do l=1,k-1
- write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
- & sinph1ph2(l,k),sinph1ph2(k,l)
- enddo
- enddo
- write(iout,*) "ethetai",ethetai
- endif
- do m=1,ntheterm2
- do k=1,nsingle
- aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
- & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
- & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
- & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*aux*coskt(m)
- dephii=dephii+k*sinkt(m)*(
- & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
- & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
- dephii1=dephii1+k*sinkt(m)*(
- & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
- & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
- if (lprn)
- & write (iout,*) "m",m," k",k," bbthet",
- & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
- & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
- & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
- & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- enddo
- enddo
- if (lprn)
- & write(iout,*) "ethetai",ethetai
- do m=1,ntheterm3
- do k=2,ndouble
- do l=1,k-1
- aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*coskt(m)*aux
- dephii=dephii+l*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- dephii1=dephii1+(k-l)*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- if (lprn) then
- write (iout,*) "m",m," k",k," l",l," ffthet",
- & ffthet(l,k,m,ityp1,ityp2,ityp3),
- & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
- & ggthet(l,k,m,ityp1,ityp2,ityp3),
- & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- write (iout,*) cosph1ph2(l,k)*sinkt(m),
- & cosph1ph2(k,l)*sinkt(m),
- & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
- endif
- enddo
- enddo
- enddo
-10 continue
- if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
- & i,theta(i)*rad2deg,phii*rad2deg,
- & phii1*rad2deg,ethetai
- etheta=etheta+ethetai
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
- gloc(nphi+i-2,icg)=wang*dethetai
- enddo
- return
- end
-#endif
-#ifdef CRYST_SC
-c-----------------------------------------------------------------------------
- subroutine esc(escloc)
-C Calculate the local energy of a side chain and its derivatives in the
-C corresponding virtual-bond valence angles THETA and the spherical angles
-C ALPHA and OMEGA.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
- & ddersc0(3),ddummy(3),xtemp(3),temp(3)
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- delta=0.02d0*pi
- escloc=0.0D0
-c write (iout,'(a)') 'ESC'
- do i=loc_start,loc_end
- it=itype(i)
- if (it.eq.21) cycle
- if (it.eq.10) goto 1
- 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
- x(1)=dtan(theti)
- x(2)=alph(i)
- x(3)=omeg(i)
-
- if (x(2).gt.pi-delta) then
- xtemp(1)=x(1)
- xtemp(2)=pi-delta
- xtemp(3)=x(3)
- call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
- xtemp(2)=pi
- call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
- call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
- & escloci,dersc(2))
- call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
- & ddersc0(1),dersc(1))
- call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
- & ddersc0(3),dersc(3))
- xtemp(2)=pi-delta
- call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
- xtemp(2)=pi
- call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
- call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
- & dersc0(2),esclocbi,dersc02)
- call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
- & dersc12,dersc01)
- call splinthet(x(2),0.5d0*delta,ss,ssd)
- dersc0(1)=dersc01
- dersc0(2)=dersc02
- dersc0(3)=0.0d0
- do k=1,3
- dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
- enddo
- dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
- escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c escloci=esclocbi
-c write (iout,*) escloci
- else if (x(2).lt.delta) then
- xtemp(1)=x(1)
- xtemp(2)=delta
- xtemp(3)=x(3)
- call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
- xtemp(2)=0.0d0
- call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
- call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
- & escloci,dersc(2))
- call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
- & ddersc0(1),dersc(1))
- call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
- & ddersc0(3),dersc(3))
- xtemp(2)=delta
- call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
- xtemp(2)=0.0d0
- call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
- call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
- & dersc0(2),esclocbi,dersc02)
- call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
- & dersc12,dersc01)
- dersc0(1)=dersc01
- dersc0(2)=dersc02
- dersc0(3)=0.0d0
- call splinthet(x(2),0.5d0*delta,ss,ssd)
- do k=1,3
- dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
- enddo
- dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
- escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c write (iout,*) escloci
- else
- call enesc(x,escloci,dersc,ddummy,.false.)
- endif
-
- escloc=escloc+escloci
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'escloc',i,escloci
-c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
-
- gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
- & wscloc*dersc(1)
- gloc(ialph(i,1),icg)=wscloc*dersc(2)
- gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
- 1 continue
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine enesc(x,escloci,dersc,ddersc,mixed)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
- double precision contr(maxlob,-1:1)
- logical mixed
-c write (iout,*) 'it=',it,' nlobit=',nlobit
- escloc_i=0.0D0
- do j=1,3
- dersc(j)=0.0D0
- if (mixed) ddersc(j)=0.0d0
- enddo
- x3=x(3)
-
-C Because of periodicity of the dependence of the SC energy in omega we have
-C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
-C To avoid underflows, first compute & store the exponents.
-
- do iii=-1,1
-
- x(3)=x3+iii*dwapi
-
- do j=1,nlobit
- do k=1,3
- z(k)=x(k)-censc(k,j,it)
- enddo
- do k=1,3
- Axk=0.0D0
- do l=1,3
- Axk=Axk+gaussc(l,k,j,it)*z(l)
- enddo
- Ax(k,j,iii)=Axk
- enddo
- expfac=0.0D0
- do k=1,3
- expfac=expfac+Ax(k,j,iii)*z(k)
- enddo
- contr(j,iii)=expfac
- enddo ! j
-
- enddo ! iii
-
- x(3)=x3
-C As in the case of ebend, we want to avoid underflows in exponentiation and
-C subsequent NaNs and INFs in energy calculation.
-C Find the largest exponent
- emin=contr(1,-1)
- do iii=-1,1
- do j=1,nlobit
- if (emin.gt.contr(j,iii)) emin=contr(j,iii)
- enddo
- enddo
- emin=0.5D0*emin
-cd print *,'it=',it,' emin=',emin
-
-C Compute the contribution to SC energy and derivatives
- do iii=-1,1
-
- do j=1,nlobit
-#ifdef OSF
- 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,it)-0.5D0*contr(j,iii)+emin)
-#endif
-cd print *,'j=',j,' expfac=',expfac
- escloc_i=escloc_i+expfac
- do k=1,3
- dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
- enddo
- if (mixed) then
- do k=1,3,2
- ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
- & +gaussc(k,2,j,it))*expfac
- enddo
- endif
- enddo
-
- enddo ! iii
-
- dersc(1)=dersc(1)/cos(theti)**2
- ddersc(1)=ddersc(1)/cos(theti)**2
- ddersc(3)=ddersc(3)
-
- escloci=-(dlog(escloc_i)-emin)
- do j=1,3
- dersc(j)=dersc(j)/escloc_i
- enddo
- if (mixed) then
- do j=1,3,2
- ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
- enddo
- endif
- return
- end
-C------------------------------------------------------------------------------
- subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- double precision x(3),z(3),Ax(3,maxlob),dersc(3)
- double precision contr(maxlob)
- logical mixed
-
- escloc_i=0.0D0
-
- do j=1,3
- dersc(j)=0.0D0
- enddo
-
- do j=1,nlobit
- do k=1,2
- z(k)=x(k)-censc(k,j,it)
- enddo
- z(3)=dwapi
- do k=1,3
- Axk=0.0D0
- do l=1,3
- Axk=Axk+gaussc(l,k,j,it)*z(l)
- enddo
- Ax(k,j)=Axk
- enddo
- expfac=0.0D0
- do k=1,3
- expfac=expfac+Ax(k,j)*z(k)
- enddo
- contr(j)=expfac
- enddo ! j
-
-C As in the case of ebend, we want to avoid underflows in exponentiation and
-C subsequent NaNs and INFs in energy calculation.
-C Find the largest exponent
- emin=contr(1)
- do j=1,nlobit
- if (emin.gt.contr(j)) emin=contr(j)
- enddo
- emin=0.5D0*emin
-
-C Compute the contribution to SC energy and derivatives
-
- dersc12=0.0d0
- do j=1,nlobit
- 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
- enddo
- if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
- & +gaussc(1,2,j,it))*expfac
- dersc(3)=0.0d0
- enddo
-
- dersc(1)=dersc(1)/cos(theti)**2
- dersc12=dersc12/cos(theti)**2
- escloci=-(dlog(escloc_i)-emin)
- do j=1,2
- dersc(j)=dersc(j)/escloc_i
- enddo
- if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
- return
- end
-#else
-c----------------------------------------------------------------------------------
- subroutine esc(escloc)
-C Calculate the local energy of a side chain and its derivatives in the
-C corresponding virtual-bond valence angles THETA and the spherical angles
-C ALPHA and OMEGA derived from AM1 all-atom calculations.
-C added by Urszula Kozlowska. 07/11/2007
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.SCROT'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- include 'COMMON.VECTORS'
- double precision x_prime(3),y_prime(3),z_prime(3)
- & , sumene,dsc_i,dp2_i,x(65),
- & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
- & de_dxx,de_dyy,de_dzz,de_dt
- double precision s1_t,s1_6_t,s2_t,s2_6_t
- double precision
- & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
- & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
- & dt_dCi(3),dt_dCi1(3)
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- delta=0.02d0*pi
- escloc=0.0D0
- do i=loc_start,loc_end
- if (itype(i).eq.21) cycle
- costtab(i+1) =dcos(theta(i+1))
- sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
- cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
- sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
- cosfac2=0.5d0/(1.0d0+costtab(i+1))
- cosfac=dsqrt(cosfac2)
- sinfac2=0.5d0/(1.0d0-costtab(i+1))
- sinfac=dsqrt(sinfac2)
- it=itype(i)
- if (it.eq.10) goto 1
-c
-C Compute the axes of tghe local cartesian coordinates system; store in
-c x_prime, y_prime and z_prime
-c
- do j=1,3
- x_prime(j) = 0.00
- y_prime(j) = 0.00
- z_prime(j) = 0.00
- enddo
-C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
-C & dc_norm(3,i+nres)
- do j = 1,3
- x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
- y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
- enddo
- do j = 1,3
- z_prime(j) = -uz(j,i-1)
- enddo
-c write (2,*) "i",i
-c write (2,*) "x_prime",(x_prime(j),j=1,3)
-c write (2,*) "y_prime",(y_prime(j),j=1,3)
-c write (2,*) "z_prime",(z_prime(j),j=1,3)
-c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
-c & " xy",scalar(x_prime(1),y_prime(1)),
-c & " xz",scalar(x_prime(1),z_prime(1)),
-c & " yy",scalar(y_prime(1),y_prime(1)),
-c & " yz",scalar(y_prime(1),z_prime(1)),
-c & " zz",scalar(z_prime(1),z_prime(1))
-c
-C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
-C to local coordinate system. Store in xx, yy, zz.
-c
- xx=0.0d0
- yy=0.0d0
- zz=0.0d0
- 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)
- enddo
-
- xxtab(i)=xx
- yytab(i)=yy
- zztab(i)=zz
-C
-C Compute the energy of the ith side cbain
-C
-c write (2,*) "xx",xx," yy",yy," zz",zz
- it=itype(i)
- do j = 1,65
- x(j) = sc_parmin(j,it)
- enddo
-#ifdef CHECK_COORD
-Cc diagnostics - remove later
- xx1 = dcos(alph(2))
- yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -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
-C," --- ", xx_w,yy_w,zz_w
-c end diagnostics
-#endif
- sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
- & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
- & + x(10)*yy*zz
- sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
- & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
- & + x(20)*yy*zz
- sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
- & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
- & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
- & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
- & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
- & +x(40)*xx*yy*zz
- sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
- & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
- & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
- & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
- & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
- & +x(60)*xx*yy*zz
- dsc_i = 0.743d0+x(61)
- dp2_i = 1.9d0+x(62)
- dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
- dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
- s1=(1+x(63))/(0.1d0 + dscp1)
- s1_6=(1+x(64))/(0.1d0 + dscp1**6)
- s2=(1+x(65))/(0.1d0 + dscp2)
- s2_6=(1+x(65))/(0.1d0 + dscp2**6)
- sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
- & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
-c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
-c & sumene4,
-c & dscp1,dscp2,sumene
-c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- escloc = escloc + sumene
-c write (2,*) "i",i," escloc",sumene,escloc
-#ifdef DEBUG
-C
-C This section to check the numerical derivatives of the energy of ith side
-C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
-C #define DEBUG in the code to turn it on.
-C
- write (2,*) "sumene =",sumene
- aincr=1.0d-7
- xxsave=xx
- xx=xx+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dxx_num=(sumenep-sumene)/aincr
- xx=xxsave
- write (2,*) "xx+ sumene from enesc=",sumenep
- yysave=yy
- yy=yy+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dyy_num=(sumenep-sumene)/aincr
- yy=yysave
- write (2,*) "yy+ sumene from enesc=",sumenep
- zzsave=zz
- zz=zz+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dzz_num=(sumenep-sumene)/aincr
- zz=zzsave
- write (2,*) "zz+ sumene from enesc=",sumenep
- costsave=cost2tab(i+1)
- sintsave=sint2tab(i+1)
- cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
- sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dt_num=(sumenep-sumene)/aincr
- write (2,*) " t+ sumene from enesc=",sumenep
- cost2tab(i+1)=costsave
- sint2tab(i+1)=sintsave
-C End of diagnostics section.
-#endif
-C
-C Compute the gradient of esc
-C
- pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
- pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
- pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
- pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
- pom_dx=dsc_i*dp2_i*cost2tab(i+1)
- pom_dy=dsc_i*dp2_i*sint2tab(i+1)
- pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
- pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
- pom1=(sumene3*sint2tab(i+1)+sumene1)
- & *(pom_s1/dscp1+pom_s16*dscp1**4)
- pom2=(sumene4*cost2tab(i+1)+sumene2)
- & *(pom_s2/dscp2+pom_s26*dscp2**4)
- sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
- sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
- & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
- & +x(40)*yy*zz
- sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
- sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
- & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
- & +x(60)*yy*zz
- de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
- & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
- & +(pom1+pom2)*pom_dx
-#ifdef DEBUG
- write(2,*), "de_dxx = ", de_dxx,de_dxx_num
-#endif
-C
- sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
- sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
- & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
- & +x(40)*xx*zz
- sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
- sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
- & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
- & +x(59)*zz**2 +x(60)*xx*zz
- de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
- & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
- & +(pom1-pom2)*pom_dy
-#ifdef DEBUG
- write(2,*), "de_dyy = ", de_dyy,de_dyy_num
-#endif
-C
- de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
- & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
- & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
- & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
- & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
- & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
- & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
- & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
-#ifdef DEBUG
- write(2,*), "de_dzz = ", de_dzz,de_dzz_num
-#endif
-C
- de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
- & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
- & +pom1*pom_dt1+pom2*pom_dt2
-#ifdef DEBUG
- write(2,*), "de_dt = ", de_dt,de_dt_num
-#endif
-c
-C
- cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
- cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
- cosfac2xx=cosfac2*xx
- sinfac2yy=sinfac2*yy
- do k = 1,3
- dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
- & vbld_inv(i+1)
- dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
- & vbld_inv(i)
- pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
- pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
-c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
-c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
-c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
-c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
- dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
- dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
- dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
- dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
- dZZ_Ci1(k)=0.0d0
- dZZ_Ci(k)=0.0d0
- do j=1,3
- dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
- dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
- enddo
-
- dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
- dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
- dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
-c
- dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
- dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
- enddo
-
- do k=1,3
- dXX_Ctab(k,i)=dXX_Ci(k)
- dXX_C1tab(k,i)=dXX_Ci1(k)
- dYY_Ctab(k,i)=dYY_Ci(k)
- dYY_C1tab(k,i)=dYY_Ci1(k)
- dZZ_Ctab(k,i)=dZZ_Ci(k)
- dZZ_C1tab(k,i)=dZZ_Ci1(k)
- dXX_XYZtab(k,i)=dXX_XYZ(k)
- dYY_XYZtab(k,i)=dYY_XYZ(k)
- dZZ_XYZtab(k,i)=dZZ_XYZ(k)
- enddo
-
- do k = 1,3
-c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
-c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
-c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
-c & dyy_ci(k)," dzz_ci",dzz_ci(k)
-c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
-c & dt_dci(k)
-c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
-c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
- gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
- & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
- gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
- & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
- gsclocx(k,i)= de_dxx*dxx_XYZ(k)
- & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
- enddo
-c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
-c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
-
-C to check gradient call subroutine check_grad
-
- 1 continue
- enddo
- return
- end
-c------------------------------------------------------------------------------
- double precision function enesc(x,xx,yy,zz,cost2,sint2)
- implicit none
- double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
- & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
- sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
- & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
- & + x(10)*yy*zz
- sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
- & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
- & + x(20)*yy*zz
- sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
- & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
- & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
- & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
- & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
- & +x(40)*xx*yy*zz
- sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
- & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
- & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
- & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
- & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
- & +x(60)*xx*yy*zz
- dsc_i = 0.743d0+x(61)
- dp2_i = 1.9d0+x(62)
- dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2+yy*sint2))
- dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2-yy*sint2))
- s1=(1+x(63))/(0.1d0 + dscp1)
- s1_6=(1+x(64))/(0.1d0 + dscp1**6)
- s2=(1+x(65))/(0.1d0 + dscp2)
- s2_6=(1+x(65))/(0.1d0 + dscp2**6)
- sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
- & + (sumene4*cost2 +sumene2)*(s2+s2_6)
- enesc=sumene
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
-C
-C This procedure calculates two-body contact function g(rij) and its derivative:
-C
-C eps0ij ! x < -1
-C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
-C 0 ! x > 1
-C
-C where x=(rij-r0ij)/delta
-C
-C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
-C
- implicit none
- double precision rij,r0ij,eps0ij,fcont,fprimcont
- double precision x,x2,x4,delta
-c delta=0.02D0*r0ij
-c delta=0.2D0*r0ij
- x=(rij-r0ij)/delta
- if (x.lt.-1.0D0) then
- fcont=eps0ij
- fprimcont=0.0D0
- else if (x.le.1.0D0) then
- x2=x*x
- x4=x2*x2
- fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
- fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
- else
- fcont=0.0D0
- fprimcont=0.0D0
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine splinthet(theti,delta,ss,ssder)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- thetup=pi-delta
- thetlow=delta
- if (theti.gt.pipol) then
- call gcont(theti,thetup,1.0d0,delta,ss,ssder)
- else
- call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
- ssder=-ssder
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
- implicit none
- double precision x,x0,delta,f0,f1,fprim0,f,fprim
- double precision ksi,ksi2,ksi3,a1,a2,a3
- a1=fprim0*delta/(f1-f0)
- a2=3.0d0-2.0d0*a1
- a3=a1-2.0d0
- ksi=(x-x0)/delta
- ksi2=ksi*ksi
- ksi3=ksi2*ksi
- f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
- fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
- return
- end
-c------------------------------------------------------------------------------
- subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
- implicit none
- double precision x,x0,delta,f0x,f1x,fprim0x,fx
- double precision ksi,ksi2,ksi3,a1,a2,a3
- ksi=(x-x0)/delta
- ksi2=ksi*ksi
- ksi3=ksi2*ksi
- a1=fprim0x*delta
- a2=3*(f1x-f0x)-2*fprim0x*delta
- a3=fprim0x*delta-2*(f1x-f0x)
- fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
- return
- end
-C-----------------------------------------------------------------------------
-#ifdef CRYST_TOR
-C-----------------------------------------------------------------------------
- subroutine etor(etors,edihcnstr)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors=0.0D0
- do i=iphi_start,iphi_end
- etors_ii=0.0D0
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21) cycle
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- phii=phi(i)
- gloci=0.0D0
-C Proline-Proline pair is a special case...
- if (itori.eq.3 .and. itori1.eq.3) then
- if (phii.gt.-dwapi3) then
- cosphi=dcos(3*phii)
- fac=1.0D0/(1.0D0-cosphi)
- etorsi=v1(1,3,3)*fac
- etorsi=etorsi+etorsi
- etors=etors+etorsi-v1(1,3,3)
- if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
- gloci=gloci-3*fac*etorsi*dsin(3*phii)
- endif
- do j=1,3
- v1ij=v1(j+1,itori,itori1)
- v2ij=v2(j+1,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- if (energy_dec) etors_ii=etors_ii+
- & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- else
- do j=1,nterm_old
- v1ij=v1(j,itori,itori1)
- v2ij=v2(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- if (energy_dec) etors_ii=etors_ii+
- & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- endif
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- 'etor',i,etors_ii
- 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)
- gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
-c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
- enddo
-! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
- do i=1,ndih_constr
- itori=idih_constr(i)
- phii=phi(itori)
- difi=phii-phi0(i)
- if (difi.gt.drange(i)) then
- difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- endif
-! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
-! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
- enddo
-! write (iout,*) 'edihcnstr',edihcnstr
- return
- end
-c------------------------------------------------------------------------------
- subroutine etor_d(etors_d)
- etors_d=0.0d0
- return
- end
-c----------------------------------------------------------------------------
-#else
- subroutine etor(etors,edihcnstr)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors=0.0D0
- do i=iphi_start,iphi_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21) cycle
- 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)
- v1ij=v1(j,itori,itori1)
- v2ij=v2(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi
- if (energy_dec) etors_ii=etors_ii+
- & v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
-C Lorentz terms
-C v1
-C E = SUM ----------------------------------- - v1
-C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
-C
- cosphi=dcos(0.5d0*phii)
- sinphi=dsin(0.5d0*phii)
- do j=1,nlor(itori,itori1)
- vl1ij=vlor1(j,itori,itori1)
- vl2ij=vlor2(j,itori,itori1)
- vl3ij=vlor3(j,itori,itori1)
- pom=vl2ij*cosphi+vl3ij*sinphi
- pom1=1.0d0/(pom*pom+1.0d0)
- etors=etors+vl1ij*pom1
- if (energy_dec) etors_ii=etors_ii+
- & vl1ij*pom1
- pom=-pom*pom1*pom1
- gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
- enddo
-C Subtract the constant term
- etors=etors-v0(itori,itori1)
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & '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),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
-! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
-c do i=1,ndih_constr
- do i=idihconstr_start,idihconstr_end
- itori=idih_constr(i)
- phii=phi(itori)
- difi=pinorm(phii-phi0(i))
- if (difi.gt.drange(i)) then
- difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- else
- difi=0.0
- endif
-cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
-cd & rad2deg*phi0(i), rad2deg*drange(i),
-cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
- enddo
-cd write (iout,*) 'edihcnstr',edihcnstr
- return
- end
-c----------------------------------------------------------------------------
- subroutine etor_d(etors_d)
-C 6/23/01 Compute double torsional energy
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors_d=0.0D0
- do i=iphid_start,iphid_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- itori2=itortyp(itype(i))
- phii=phi(i)
- phii1=phi(i+1)
- gloci1=0.0D0
- gloci2=0.0D0
-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)
- cosphi1=dcos(j*phii)
- sinphi1=dsin(j*phii)
- cosphi2=dcos(j*phii1)
- sinphi2=dsin(j*phii1)
- etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
- & v2cij*cosphi2+v2sij*sinphi2
- gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
- gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
- enddo
- do k=2,ntermd_2(itori,itori1,itori2)
- 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)
- cosphi1p2=dcos(l*phii+(k-l)*phii1)
- cosphi1m2=dcos(l*phii-(k-l)*phii1)
- sinphi1p2=dsin(l*phii+(k-l)*phii1)
- sinphi1m2=dsin(l*phii-(k-l)*phii1)
- etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
- & v1sdij*sinphi1p2+v2sdij*sinphi1m2
- gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
- & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
- gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
- & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
- enddo
- enddo
- gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
- gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
- enddo
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine eback_sc_corr(esccor)
-c 7/21/2007 Correlations between the backbone-local and side-chain-local
-c conformational states; temporarily implemented as differences
-c between UNRES torsional potentials (dependent on three types of
-c residues) and the torsional potentials dependent on all 20 types
-c of residues computed from AM1 energy surfaces of terminally-blocked
-c amino-acid residues.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.SCCOR'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
-c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
- esccor=0.0D0
- do i=iphi_start,iphi_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle
- esccor_ii=0.0D0
- itori=itype(i-2)
- itori1=itype(i-1)
- phii=phi(i)
- gloci=0.0D0
- do j=1,nterm_sccor
- v1ij=v1sccor(j,itori,itori1)
- v2ij=v2sccor(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- esccor=esccor+v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- 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,
- & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
- gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
- enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine multibody(ecorr)
-C This subroutine calculates multi-body contributions to energy following
-C the idea of Skolnick et al. If side chains I and J make a contact and
-C at the same time side chains I+1 and J+1 make a contact, an extra
-C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
-
-C Set lprn=.true. for debugging
- lprn=.false.
-
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(i2,20(1x,i2,f10.5))')
- & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
- enddo
- endif
- ecorr=0.0D0
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
- do i=nnt,nct-2
-
- DO ISHIFT = 3,4
-
- i1=i+ishift
- num_conti=num_cont(i)
- num_conti1=num_cont(i1)
- do jj=1,num_conti
- j=jcont(jj,i)
- do kk=1,num_conti1
- j1=jcont(kk,i1)
- if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
-cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-cd & ' ishift=',ishift
-C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
-C The system gains extra energy.
- ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
- endif ! j1==j+-ishift
- enddo ! kk
- enddo ! jj
-
- ENDDO ! ISHIFT
-
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
- double precision function esccorr(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
- lprn=.false.
- eij=facont(jj,i)
- ekl=facont(kk,k)
-cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
-C Calculate the multi-body contribution to energy.
-C Calculate multi-body contributions to the gradient.
-cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
-cd & k,l,(gacont(m,kk,k),m=1,3)
- do m=1,3
- gx(m) =ekl*gacont(m,jj,i)
- gx1(m)=eij*gacont(m,kk,k)
- gradxorr(m,i)=gradxorr(m,i)-gx(m)
- gradxorr(m,j)=gradxorr(m,j)+gx(m)
- gradxorr(m,k)=gradxorr(m,k)-gx1(m)
- gradxorr(m,l)=gradxorr(m,l)+gx1(m)
- enddo
- do m=i,j-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
- enddo
- enddo
- do m=k,l-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
- enddo
- enddo
- esccorr=-eij*ekl
- return
- end
-c------------------------------------------------------------------------------
- subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
-C This subroutine calculates multi-body contributions to hydrogen-bonding
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-#ifdef MPI
- include "mpif.h"
- parameter (max_cont=maxconts)
- parameter (max_dim=26)
- integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer status(MPI_STATUS_SIZE),req(maxconts*2),
- & status_array(MPI_STATUS_SIZE,maxconts*2)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.CONTROL'
- include 'COMMON.LOCAL'
- double precision gx(3),gx1(3),time00
- logical lprn,ldone
-
-C Set lprn=.true. for debugging
- lprn=.false.
-#ifdef MPI
- n_corr=0
- n_corr1=0
- if (nfgtasks.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values before RECEIVE:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- call flush(iout)
- do i=1,ntask_cont_from
- ncont_recv(i)=0
- enddo
- do i=1,ntask_cont_to
- ncont_sent(i)=0
- enddo
-c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
-c & ntask_cont_to
-C Make the list of contacts to send to send to other procesors
-c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
-c call flush(iout)
- do i=iturn3_start,iturn3_end
-c write (iout,*) "make contact list turn3",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
- enddo
- do i=iturn4_start,iturn4_end
-c write (iout,*) "make contact list turn4",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
- enddo
- do ii=1,nat_sent
- i=iat_sent(ii)
-c write (iout,*) "make contact list longrange",i,ii," num_cont",
-c & num_cont_hb(i)
- do j=1,num_cont_hb(i)
- do k=1,4
- jjc=jcont_hb(j,i)
- iproc=iint_sent_local(k,jjc,ii)
-c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.gt.0) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=i
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,i)
- zapas(4,nn,iproc)=ees0p(j,i)
- zapas(5,nn,iproc)=ees0m(j,i)
- zapas(6,nn,iproc)=gacont_hbr(1,j,i)
- zapas(7,nn,iproc)=gacont_hbr(2,j,i)
- zapas(8,nn,iproc)=gacont_hbr(3,j,i)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
- endif
- enddo
- enddo
- enddo
- if (lprn) then
- write (iout,*)
- & "Numbers of contacts to be sent to other processors",
- & (ncont_sent(i),i=1,ntask_cont_to)
- write (iout,*) "Contacts sent"
- do ii=1,ntask_cont_to
- nn=ncont_sent(ii)
- iproc=itask_cont_to(ii)
- write (iout,*) nn," contacts to processor",iproc,
- & " of CONT_TO_COMM group"
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
- enddo
- enddo
- call flush(iout)
- endif
- CorrelType=477
- CorrelID=fg_rank+1
- CorrelType1=478
- CorrelID1=nfgtasks+fg_rank+1
- ireq=0
-C Receive the numbers of needed contacts from other processors
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- ireq=ireq+1
- call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "IRECV ended"
-c call flush(iout)
-C Send the number of contacts needed by other processors
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- ireq=ireq+1
- call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "ISEND ended"
-c write (iout,*) "number of requests (nn)",ireq
- call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
-c write (iout,*)
-c & "Numbers of contacts to be received from other processors",
-c & (ncont_recv(i),i=1,ntask_cont_from)
-c call flush(iout)
-C Receive contacts
- ireq=0
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- nn=ncont_recv(ii)
-c write (iout,*) "Receiving",nn," contacts from processor",iproc,
-c & " of CONT_TO_COMM group"
- call flush(iout)
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
- & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
- endif
- enddo
-C Send the contacts to processors that need them
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- nn=ncont_sent(ii)
-c write (iout,*) nn," contacts to processor",iproc,
-c & " of CONT_TO_COMM group"
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
- & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
-c do i=1,nn
-c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
-c enddo
- endif
- enddo
-c write (iout,*) "number of requests (contacts)",ireq
-c write (iout,*) "req",(req(i),i=1,4)
-c call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
- do iii=1,ntask_cont_from
- iproc=itask_cont_from(iii)
- nn=ncont_recv(iii)
- if (lprn) then
- write (iout,*) "Received",nn," contacts from processor",iproc,
- & " of CONT_FROM_COMM group"
- call flush(iout)
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
- enddo
- call flush(iout)
- endif
- do i=1,nn
- ii=zapas_recv(1,i,iii)
-c Flag the received contacts to prevent double-counting
- jj=-zapas_recv(2,i,iii)
-c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
-c call flush(iout)
- nnn=num_cont_hb(ii)+1
- num_cont_hb(ii)=nnn
- jcont_hb(nnn,ii)=jj
- facont_hb(nnn,ii)=zapas_recv(3,i,iii)
- ees0p(nnn,ii)=zapas_recv(4,i,iii)
- ees0m(nnn,ii)=zapas_recv(5,i,iii)
- gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
- gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
- gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
- gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
- gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
- gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
- gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
- gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
- gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
- gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
- gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
- gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
- gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
- gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
- gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
- gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
- gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
- gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
- gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
- gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
- gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
- enddo
- enddo
- call flush(iout)
- if (lprn) then
- write (iout,'(a)') 'Contact function values after receive:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- call flush(iout)
- endif
- 30 continue
-#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- ecorr=0.0D0
-C Remove the loop below after debugging !!!
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
-C Calculate the local-electrostatic correlation terms
- do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- jp=iabs(j)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
- jp1=iabs(j1)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
- & .or. j.lt.0 .and. j1.gt.0) .and.
- & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
-C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
-C The system gains extra energy.
- ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
-C Contacts I-J and I-(J+1) occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
-C Contacts I-J and (I+1)-J occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
- subroutine add_hb_contact(ii,jj,itask)
- implicit real*8 (a-h,o-z)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- integer max_cont
- integer max_dim
- parameter (max_cont=maxconts)
- parameter (max_dim=26)
- include "COMMON.CONTACTS"
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer i,j,ii,jj,iproc,itask(4),nn
-c write (iout,*) "itask",itask
- do i=1,2
- iproc=itask(i)
- if (iproc.gt.0) then
- do j=1,num_cont_hb(ii)
- jjc=jcont_hb(j,ii)
-c write (iout,*) "i",ii," j",jj," jjc",jjc
- if (jjc.eq.jj) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=ii
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,ii)
- zapas(4,nn,iproc)=ees0p(j,ii)
- zapas(5,nn,iproc)=ees0m(j,ii)
- zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
- zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
- zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
- exit
- endif
- enddo
- endif
- enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
- & n_corr1)
-C This subroutine calculates multi-body contributions to hydrogen-bonding
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-#ifdef MPI
- include "mpif.h"
- parameter (max_cont=maxconts)
- parameter (max_dim=70)
- integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer status(MPI_STATUS_SIZE),req(maxconts*2),
- & status_array(MPI_STATUS_SIZE,maxconts*2)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.CHAIN'
- include 'COMMON.CONTROL'
- double precision gx(3),gx1(3)
- integer num_cont_hb_old(maxres)
- logical lprn,ldone
- double precision eello4,eello5,eelo6,eello_turn6
- external eello4,eello5,eello6,eello_turn6
-C Set lprn=.true. for debugging
- lprn=.false.
- eturn6=0.0d0
-#ifdef MPI
- do i=1,nres
- num_cont_hb_old(i)=num_cont_hb(i)
- enddo
- n_corr=0
- n_corr1=0
- if (nfgtasks.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values before RECEIVE:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- call flush(iout)
- do i=1,ntask_cont_from
- ncont_recv(i)=0
- enddo
- do i=1,ntask_cont_to
- ncont_sent(i)=0
- enddo
-c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
-c & ntask_cont_to
-C Make the list of contacts to send to send to other procesors
- do i=iturn3_start,iturn3_end
-c write (iout,*) "make contact list turn3",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
- enddo
- do i=iturn4_start,iturn4_end
-c write (iout,*) "make contact list turn4",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
- enddo
- do ii=1,nat_sent
- i=iat_sent(ii)
-c write (iout,*) "make contact list longrange",i,ii," num_cont",
-c & num_cont_hb(i)
- do j=1,num_cont_hb(i)
- do k=1,4
- jjc=jcont_hb(j,i)
- iproc=iint_sent_local(k,jjc,ii)
-c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.ne.0) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=i
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,i)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
- enddo
- enddo
- enddo
- enddo
- endif
- enddo
- enddo
- enddo
- if (lprn) then
- write (iout,*)
- & "Numbers of contacts to be sent to other processors",
- & (ncont_sent(i),i=1,ntask_cont_to)
- write (iout,*) "Contacts sent"
- do ii=1,ntask_cont_to
- nn=ncont_sent(ii)
- iproc=itask_cont_to(ii)
- write (iout,*) nn," contacts to processor",iproc,
- & " of CONT_TO_COMM group"
- do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
- enddo
- enddo
- call flush(iout)
- endif
- CorrelType=477
- CorrelID=fg_rank+1
- CorrelType1=478
- CorrelID1=nfgtasks+fg_rank+1
- ireq=0
-C Receive the numbers of needed contacts from other processors
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- ireq=ireq+1
- call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "IRECV ended"
-c call flush(iout)
-C Send the number of contacts needed by other processors
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- ireq=ireq+1
- call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "ISEND ended"
-c write (iout,*) "number of requests (nn)",ireq
- call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
-c write (iout,*)
-c & "Numbers of contacts to be received from other processors",
-c & (ncont_recv(i),i=1,ntask_cont_from)
-c call flush(iout)
-C Receive contacts
- ireq=0
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- nn=ncont_recv(ii)
-c write (iout,*) "Receiving",nn," contacts from processor",iproc,
-c & " of CONT_TO_COMM group"
- call flush(iout)
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
- & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
- endif
- enddo
-C Send the contacts to processors that need them
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- nn=ncont_sent(ii)
-c write (iout,*) nn," contacts to processor",iproc,
-c & " of CONT_TO_COMM group"
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
- & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
-c do i=1,nn
-c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
-c enddo
- endif
- enddo
-c write (iout,*) "number of requests (contacts)",ireq
-c write (iout,*) "req",(req(i),i=1,4)
-c call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
- do iii=1,ntask_cont_from
- iproc=itask_cont_from(iii)
- nn=ncont_recv(iii)
- if (lprn) then
- write (iout,*) "Received",nn," contacts from processor",iproc,
- & " of CONT_FROM_COMM group"
- call flush(iout)
- do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
- enddo
- call flush(iout)
- endif
- do i=1,nn
- ii=zapas_recv(1,i,iii)
-c Flag the received contacts to prevent double-counting
- jj=-zapas_recv(2,i,iii)
-c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
-c call flush(iout)
- nnn=num_cont_hb(ii)+1
- num_cont_hb(ii)=nnn
- jcont_hb(nnn,ii)=jj
- d_cont(nnn,ii)=zapas_recv(3,i,iii)
- ind=3
- do kk=1,3
- ind=ind+1
- grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- enddo
- enddo
- enddo
- enddo
- call flush(iout)
- if (lprn) then
- write (iout,'(a)') 'Contact function values after receive:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,5f6.3))')
- & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
- & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
- enddo
- call flush(iout)
- endif
- 30 continue
-#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,5f6.3))')
- & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
- & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
- enddo
- endif
- ecorr=0.0D0
- ecorr5=0.0d0
- ecorr6=0.0d0
-C Remove the loop below after debugging !!!
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
-C Calculate the dipole-dipole interaction energies
- if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
- do i=iatel_s,iatel_e+1
- num_conti=num_cont_hb(i)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
-#ifdef MOMENT
- call dipole(i,j,jj)
-#endif
- enddo
- enddo
- endif
-C Calculate the local-electrostatic correlation terms
-c write (iout,*) "gradcorr5 in eello5 before loop"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
-c write (iout,*) "corr loop i",i
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- jp=iabs(j)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
- jp1=iabs(j1)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
-c if (j1.eq.j+1 .or. j1.eq.j-1) then
- if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
- & .or. j.lt.0 .and. j1.gt.0) .and.
- & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
-C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
-C The system gains extra energy.
- n_corr=n_corr+1
- sqd1=dsqrt(d_cont(jj,i))
- sqd2=dsqrt(d_cont(kk,i1))
- sred_geom = sqd1*sqd2
- IF (sred_geom.lt.cutoff_corr) THEN
- call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
- & ekont,fprimcont)
-cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
-cd & ' jj=',jj,' kk=',kk
- fac_prim1=0.5d0*sqd2/sqd1*fprimcont
- fac_prim2=0.5d0*sqd1/sqd2*fprimcont
- do l=1,3
- g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
- g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
- enddo
- n_corr1=n_corr1+1
-cd write (iout,*) 'sred_geom=',sred_geom,
-cd & ' ekont=',ekont,' fprim=',fprimcont,
-cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
-cd write (iout,*) "g_contij",g_contij
-cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
-cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
- call calc_eello(i,jp,i+1,jp1,jj,kk)
- if (wcorr4.gt.0.0d0)
- & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
- if (energy_dec.and.wcorr4.gt.0.0d0)
- 1 write (iout,'(a6,4i5,0pf7.3)')
- 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
-c write (iout,*) "gradcorr5 before eello5"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- if (wcorr5.gt.0.0d0)
- & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
-c write (iout,*) "gradcorr5 after eello5"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- if (energy_dec.and.wcorr5.gt.0.0d0)
- 1 write (iout,'(a6,4i5,0pf7.3)')
- 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
-cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
-cd write(2,*)'ijkl',i,jp,i+1,jp1
- if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
- & .or. wturn6.eq.0.0d0))then
-cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
- ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
- 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
-cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
-cd & 'ecorr6=',ecorr6
-cd write (iout,'(4e15.5)') sred_geom,
-cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
-cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
-cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
- else if (wturn6.gt.0.0d0
- & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
-cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
- eturn6=eturn6+eello_turn6(i,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
- 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
-cd write (2,*) 'multibody_eello:eturn6',eturn6
- endif
- ENDIF
-1111 continue
- endif
- enddo ! kk
- enddo ! jj
- enddo ! i
- do i=1,nres
- num_cont_hb(i)=num_cont_hb_old(i)
- enddo
-c write (iout,*) "gradcorr5 in eello5"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine add_hb_contact_eello(ii,jj,itask)
- implicit real*8 (a-h,o-z)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- integer max_cont
- integer max_dim
- parameter (max_cont=maxconts)
- parameter (max_dim=70)
- include "COMMON.CONTACTS"
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer i,j,ii,jj,iproc,itask(4),nn
-c write (iout,*) "itask",itask
- do i=1,2
- iproc=itask(i)
- if (iproc.gt.0) then
- do j=1,num_cont_hb(ii)
- jjc=jcont_hb(j,ii)
-c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
- if (jjc.eq.jj) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=ii
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,ii)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
- enddo
- enddo
- enddo
- enddo
- exit
- endif
- enddo
- endif
- enddo
- return
- end
-c------------------------------------------------------------------------------
- double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
- lprn=.false.
- eij=facont_hb(jj,i)
- ekl=facont_hb(kk,k)
- ees0pij=ees0p(jj,i)
- ees0pkl=ees0p(kk,k)
- ees0mij=ees0m(jj,i)
- ees0mkl=ees0m(kk,k)
- ekont=eij*ekl
- ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
-cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
-C Following 4 lines for diagnostics.
-cd ees0pkl=0.0D0
-cd ees0pij=1.0D0
-cd ees0mkl=0.0D0
-cd ees0mij=1.0D0
-c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
-c & 'Contacts ',i,j,
-c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
-c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
-c & 'gradcorr_long'
-C Calculate the multi-body contribution to energy.
-c ecorr=ecorr+ekont*ees
-C Calculate multi-body contributions to the gradient.
- coeffpees0pij=coeffp*ees0pij
- coeffmees0mij=coeffm*ees0mij
- coeffpees0pkl=coeffp*ees0pkl
- coeffmees0mkl=coeffm*ees0mkl
- do ll=1,3
-cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
- gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
- & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
- & coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
- & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
- & coeffmees0mkl*gacontm_hb2(ll,jj,i))
-cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
- gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
- & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
- & coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
- & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
- & coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
- & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
- & coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
- & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
- & coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
-c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
- enddo
-c write (iout,*)
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+
-cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
-cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
-cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+
-cgrad & ees*eij*gacont_hbr(ll,kk,k)-
-cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
-cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
-cgrad enddo
-cgrad enddo
-c write (iout,*) "ehbcorr",ekont*ees
- ehbcorr=ekont*ees
- return
- end
-#ifdef MOMENT
-C---------------------------------------------------------------------------
- subroutine dipole(i,j,jj)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
- & auxmat(2,2)
- iti1 = itortyp(itype(i+1))
- if (j.lt.nres-1) then
- itj1 = itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- do iii=1,2
- dipi(iii,1)=Ub2(iii,i)
- dipderi(iii)=Ub2der(iii,i)
- dipi(iii,2)=b1(iii,iti1)
- dipj(iii,1)=Ub2(iii,j)
- dipderj(iii)=Ub2der(iii,j)
- dipj(iii,2)=b1(iii,itj1)
- enddo
- kkk=0
- do iii=1,2
- call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
- do jjj=1,2
- kkk=kkk+1
- dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
- enddo
- do kkk=1,5
- do lll=1,3
- mmm=0
- do iii=1,2
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
- & auxvec(1))
- do jjj=1,2
- mmm=mmm+1
- dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
- enddo
- enddo
- enddo
- call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
- call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
- do iii=1,2
- dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
- enddo
- call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
- do iii=1,2
- dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
- enddo
- return
- end
-#endif
-C---------------------------------------------------------------------------
- subroutine calc_eello(i,j,k,l,jj,kk)
-C
-C This subroutine computes matrices and vectors needed to calculate
-C the fourth-, fifth-, and sixth-order local-electrostatic terms.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
- & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
- logical lprn
- common /kutas/ lprn
-cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
-cd & ' jj=',jj,' kk=',kk
-cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
-cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
-cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
- do iii=1,2
- do jjj=1,2
- aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
- aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
- enddo
- enddo
- call transpose2(aa1(1,1),aa1t(1,1))
- call transpose2(aa2(1,1),aa2t(1,1))
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
- & aa1tder(1,1,lll,kkk))
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
- & aa2tder(1,1,lll,kkk))
- enddo
- enddo
- if (l.eq.j+1) then
-C parallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1))
- itj=itortyp(itype(j))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-C A1 kernel(j+1) A2T
-cd do iii=1,2
-cd write (iout,'(3f10.5,5x,3f10.5)')
-cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
-cd enddo
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
- & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
- & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
- & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
- & ADtEAderx(1,1,1,1,1,1))
- lprn=.false.
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
- & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
- & ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-C End 6-th order cumulants
-cd lprn=.false.
-cd if (lprn) then
-cd write (2,*) 'In calc_eello6'
-cd do iii=1,2
-cd write (2,*) 'iii=',iii
-cd do kkk=1,5
-cd write (2,*) 'kkk=',kkk
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
-cd enddo
-cd enddo
-cd enddo
-cd endif
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & EAEAderx(1,1,lll,kkk,iii,1))
- enddo
- enddo
- enddo
-C A1T kernel(i+1) A2
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
- & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
- & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
- & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
- & ADtEAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
- & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
- & ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
- enddo
-C AEAb1 and AEAb2
-C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-C They are needed only when the fifth- or the sixth-order cumulants are
-C indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
-C Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),
- & AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),
- & AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
- & AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),
- & AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),
- & AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
- & AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
- & AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-C End vectors
- else
-C Antiparallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
-C A2 kernel(j-1)T A1T
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
- & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
- & j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
- & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
- & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
- & ADtEAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
- & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
- & ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & EAEAderx(1,1,lll,kkk,iii,1))
- enddo
- enddo
- enddo
-C A2T kernel(i+1)T A1
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
- & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
- & j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
- & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
- & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
- & ADtEAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
- & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
- & ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
- enddo
-C AEAb1 and AEAb2
-C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-C They are needed only when the fifth- or the sixth-order cumulants are
-C indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
- & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
-C Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),
- & AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),
- & AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
- & AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),
- & AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),
- & AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
- & AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
- & AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-C End vectors
- endif
- return
- end
-C---------------------------------------------------------------------------
- subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
- & KK,KKderg,AKA,AKAderg,AKAderx)
- implicit none
- integer nderg
- logical transp
- double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
- & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
- & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
- integer iii,kkk,lll
- integer jjj,mmm
- logical lprn
- common /kutas/ lprn
- call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
- do iii=1,nderg
- call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
- & AKAderg(1,1,iii))
- enddo
-cd if (lprn) write (2,*) 'In kernel'
- do kkk=1,5
-cd if (lprn) write (2,*) 'kkk=',kkk
- do lll=1,3
- call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
- & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
-cd if (lprn) then
-cd write (2,*) 'lll=',lll
-cd write (2,*) 'iii=1'
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
-cd enddo
-cd endif
- call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
- & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
-cd if (lprn) then
-cd write (2,*) 'lll=',lll
-cd write (2,*) 'iii=2'
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
-cd enddo
-cd endif
- enddo
- enddo
- return
- end
-C---------------------------------------------------------------------------
- double precision function eello4(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision pizda(2,2),ggg1(3),ggg2(3)
-cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
-cd eello4=0.0d0
-cd return
-cd endif
-cd print *,'eello4:',i,j,k,l,jj,kk
-cd write (2,*) 'i',i,' j',j,' k',k,' l',l
-cd call checkint4(i,j,k,l,jj,kk,eel4_num)
-cold eij=facont_hb(jj,i)
-cold ekl=facont_hb(kk,k)
-cold ekont=eij*ekl
- eel4=-EAEA(1,1,1)-EAEA(2,2,1)
-cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
- gcorr_loc(k-1)=gcorr_loc(k-1)
- & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
- if (l.eq.j+1) then
- gcorr_loc(l-1)=gcorr_loc(l-1)
- & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- else
- gcorr_loc(j-1)=gcorr_loc(j-1)
- & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
- & -EAEAderx(2,2,lll,kkk,iii,1)
-cd derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd gcorr_loc(l-1)=0.0d0
-cd gcorr_loc(j-1)=0.0d0
-cd gcorr_loc(k-1)=0.0d0
-cd eel4=1.0d0
-cd write (iout,*)'Contacts have occurred for peptide groups',
-cd & i,j,' fcont:',eij,' eij',' and ',k,l,
-cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-cgrad ggg1(ll)=eel4*g_contij(ll,1)
-cgrad ggg2(ll)=eel4*g_contij(ll,2)
- glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
- glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
-cgrad ghalf=0.5d0*ggg1(ll)
- gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
- gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
- gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
-cgrad ghalf=0.5d0*ggg2(ll)
- gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
- gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
- gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
- enddo
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,gcorr_loc(iii)
-cd enddo
- eello4=ekont*eel4
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello4',ekont*eel4
- return
- end
-C---------------------------------------------------------------------------
- double precision function eello5(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
- double precision ggg1(3),ggg2(3)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel chains C
-C C
-C o o o o C
-C /l\ / \ \ / \ / \ / C
-C / \ / \ \ / \ / \ / C
-C j| o |l1 | o | o| o | | o |o C
-C \ |/k\| |/ \| / |/ \| |/ \| C
-C \i/ \ / \ / / \ / \ C
-C o k1 o C
-C (I) (II) (III) (IV) C
-C C
-C eello5_1 eello5_2 eello5_3 eello5_4 C
-C C
-C Antiparallel chains C
-C C
-C o o o o C
-C /j\ / \ \ / \ / \ / C
-C / \ / \ \ / \ / \ / C
-C j1| o |l | o | o| o | | o |o C
-C \ |/k\| |/ \| / |/ \| |/ \| C
-C \i/ \ / \ / / \ / \ C
-C o k1 o C
-C (I) (II) (III) (IV) C
-C C
-C eello5_1 eello5_2 eello5_3 eello5_4 C
-C C
-C o denotes a local interaction, vertical lines an electrostatic interaction. C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
-cd eello5=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
- itk=itortyp(itype(k))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
- eello5_1=0.0d0
- eello5_2=0.0d0
- eello5_3=0.0d0
- eello5_4=0.0d0
-cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
-cd & eel5_3_num,eel5_4_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=facont_hb(jj,i)
-cd ekl=facont_hb(kk,k)
-cd ekont=eij*ekl
-cd write (iout,*)'Contacts have occurred for peptide groups',
-cd & i,j,' fcont:',eij,' eij',' and ',k,l
-cd goto 1111
-C Contribution from the graph I.
-cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
-cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
-C Explicit gradient in virtual-dihedral angles.
- if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- if (l.eq.j+1) then
- if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- else
- if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- endif
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
- enddo
- enddo
- enddo
-c goto 1112
-c1111 continue
-C Contribution from graph II
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- if (l.eq.j+1) then
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- else
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- endif
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k))
- enddo
- enddo
- enddo
-cd goto 1112
-cd1111 continue
- if (l.eq.j+1) then
-cd goto 1110
-C Parallel orientation
-C Contribution from graph III
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
- call transpose2(EUgder(1,1,l),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
- enddo
- enddo
- enddo
-cd goto 1112
-C Contribution from graph IV
-cd1110 continue
- call transpose2(EE(1,1,itl),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l))
- enddo
- enddo
- enddo
- else
-C Antiparallel orientation
-C Contribution from graph III
-c goto 1110
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
- call transpose2(EUgder(1,1,j),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
- enddo
- enddo
- enddo
-cd goto 1112
-C Contribution from graph IV
-1110 continue
- call transpose2(EE(1,1,itj),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j))
- enddo
- enddo
- enddo
- endif
-1112 continue
- eel5=eello5_1+eello5_2+eello5_3+eello5_4
-cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
-cd write (2,*) 'ijkl',i,j,k,l
-cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
-cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
-cd endif
-cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
-cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
-cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
-cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
-cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
-C 2/11/08 AL Gradients over DC's connecting interacting sites will be
-C summed up outside the subrouine as for the other subroutines
-C handling long-range interactions. The old code is commented out
-C with "cgrad" to keep track of changes.
- do ll=1,3
-cgrad ggg1(ll)=eel5*g_contij(ll,1)
-cgrad ggg2(ll)=eel5*g_contij(ll,2)
- gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
-c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
-c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
-c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
-c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
-c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
-c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
-c & gradcorr5ij,
-c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
-cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
-cgrad ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
- gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
- gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
- gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
- gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
-cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
-cgrad ghalf=0.5d0*ggg2(ll)
-cd ghalf=0.0d0
- gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
- gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
- gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
- gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
- gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
- enddo
-cd goto 1112
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-c1112 continue
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr5_loc(iii)
-cd enddo
- eello5=ekont*eel5
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello5',ekont*eel5
- return
- end
-c--------------------------------------------------------------------------
- double precision function eello6(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision ggg1(3),ggg2(3)
-cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-cd eello6=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
- eello6_1=0.0d0
- eello6_2=0.0d0
- eello6_3=0.0d0
- eello6_4=0.0d0
- eello6_5=0.0d0
- eello6_6=0.0d0
-cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
-cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=facont_hb(jj,i)
-cd ekl=facont_hb(kk,k)
-cd ekont=eij*ekl
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
- if (l.eq.j+1) then
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(j,i,l,k,2,.false.)
- eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
- eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
- else
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(l,k,j,i,2,.true.)
- eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
- else
- eello6_5=0.0d0
- endif
- eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
- endif
-C If turn contributions are considered, they will be handled separately.
- eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
-cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
-cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
-cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
-cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
-cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
-cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
-cd goto 1112
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-cgrad ggg1(ll)=eel6*g_contij(ll,1)
-cgrad ggg2(ll)=eel6*g_contij(ll,2)
-cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
-cgrad ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
- gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
- gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
- gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
- gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
- gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
-cgrad ghalf=0.5d0*ggg2(ll)
-cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
-cd ghalf=0.0d0
- gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
- gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
- gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
- gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
- gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
- enddo
-cd goto 1112
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-cgrad1112 continue
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr6_loc(iii)
-cd enddo
- eello6=ekont*eel6
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello6',ekont*eel6
- return
- end
-c--------------------------------------------------------------------------
- double precision function eello6_graph1(i,j,k,l,imat,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
- logical swap
- logical lprn
- common /kutas/ lprn
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ /j\ C
-C / \ / \ C
-C /| o | | o |\ C
-C \ j|/k\| / \ |/k\|l / C
-C \ / \ / \ / \ / C
-C o o o o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- itk=itortyp(itype(k))
- s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
- eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
- if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
- & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
- & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
- & +scalar2(vv(1),Dtobr2der(1,i)))
- call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
- if (l.eq.j+1) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)
- & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
- & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)
- & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
- & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- endif
- call transpose2(EUgCder(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
- & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
- & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
- do iii=1,2
- if (swap) then
- ind=3-iii
- else
- ind=iii
- endif
- do kkk=1,5
- do lll=1,3
- s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
- & pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
- & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
- vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
- & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
- derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- logical swap
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
- & auxvec1(2),auxvec2(1),auxmat1(2,2)
- logical lprn
- common /kutas/ lprn
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C \ /l\ /j\ / C
-C \ / \ / \ / C
-C o| o | | o |o C
-C \ j|/k\| \ |/k\|l C
-C \ / \ \ / \ C
-C o o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
-C AL 7/4/01 s1 would occur in the sixth-order moment,
-C but not in a cluster cumulant
-#ifdef MOMENT
- s1=dip(1,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph2=-(s1+s2+s3+s4)
-#else
- eello6_graph2=-(s2+s3+s4)
-#endif
-c eello6_graph2=-s3
-C Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- s1=dipderg(1,jj,i)*dip(1,kk,k)
-#endif
- s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
-c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
- endif
-C Derivatives in gamma(k-1)
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
-c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
-C Derivatives in gamma(j-1) or gamma(l-1)
- if (j.gt.1) then
-#ifdef MOMENT
- s1=dipderg(3,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
- call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
-c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
- endif
-C Derivatives in gamma(l-1) or gamma(j-1)
- if (l.gt.1) then
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(3,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- else
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
-c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
- endif
-C Cartesian derivatives.
- if (lprn) then
- write (2,*) 'In eello6_graph2'
- do iii=1,2
- write (2,*) 'iii=',iii
- do kkk=1,5
- write (2,*) 'kkk=',kkk
- do jjj=1,2
- write (2,'(3(2f10.5),5x)')
- & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
- enddo
- enddo
- enddo
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
- else
- s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
- endif
-#endif
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
- & auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
- & auxvec(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
- logical swap
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ / \ /j\ C
-C / \ / \ / \ C
-C /| o |o o| o |\ C
-C j|/k\| / |/k\|l / C
-C / \ / / \ / C
-C / o / o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C 4/7/01 AL Component s1 was removed, because it pertains to the respective
-C energy moment and not to the cluster cumulant.
- iti=itortyp(itype(i))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-#ifdef MOMENT
- s1=dip(4,jj,i)*dip(4,kk,k)
-#endif
- call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
-cd & "sum",-(s2+s3+s4)
-#ifdef MOMENT
- eello6_graph3=-(s1+s2+s3+s4)
-#else
- eello6_graph3=-(s2+s3+s4)
-#endif
-c eello6_graph3=-s4
-C Derivatives in gamma(k-1)
- call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
-C Derivatives in gamma(l-1)
- call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
-C Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
- else
- s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
- & auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
-c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
- & auxvec1(2),auxmat1(2,2)
- logical swap
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ / \ /j\ C
-C / \ / \ / \ C
-C /| o |o o| o |\ C
-C \ j|/k\| \ |/k\|l C
-C \ / \ \ / \ C
-C o \ o \ C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C 4/7/01 AL Component s1 was removed, because it pertains to the respective
-C energy moment and not to the cluster cumulant.
-cd write (2,*) 'eello_graph4: wturn6',wturn6
- iti=itortyp(itype(i))
- itj=itortyp(itype(j))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k))
- if (k.lt.nres-1) then
- itk1=itortyp(itype(k+1))
- else
- itk1=ntortyp+1
- endif
- itl=itortyp(itype(l))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
-cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
-cd & ' itl',itl,' itl1',itl1
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dip(3,kk,k)
- else
- s1=dip(2,jj,j)*dip(2,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph4=-(s1+s2+s3+s4)
-#else
- eello6_graph4=-(s2+s3+s4)
-#endif
-C Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dipderg(2,jj,i)*dip(3,kk,k)
- else
- s1=dipderg(4,jj,j)*dip(2,kk,l)
- endif
-#endif
- s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-cd write (2,*) 'turn6 derivatives'
-#ifdef MOMENT
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
-#endif
- else
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
- endif
- endif
-C Derivatives in gamma(k-1)
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderg(2,kk,k)
- else
- s1=dip(2,jj,j)*dipderg(4,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
-#endif
- else
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
- endif
-C Derivatives in gamma(j-1) or gamma(l-1)
- if (l.eq.j+1 .and. l.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
- else if (j.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
- gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
- endif
- endif
-C Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- if (imat.eq.1) then
- s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
- else
- s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
- endif
- else
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
- else
- s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
- endif
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
- & auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
- & b1(1,itj1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
- else
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
- & b1(1,itl1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
- endif
- call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (swap) then
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
- & -(s1+s2+s4)
-#else
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
- & -(s2+s4)
-#endif
- derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
- else
-#ifdef MOMENT
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
-#endif
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
- else
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (l.eq.j+1) then
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- endif
- endif
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello_turn6(i,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
- & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
- & ggg1(3),ggg2(3)
- double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
- & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
-C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
-C the respective energy moment and not to the cluster cumulant.
- s1=0.0d0
- s8=0.0d0
- s13=0.0d0
-c
- eello_turn6=0.0d0
- j=i+4
- k=i+1
- l=i+3
- iti=itortyp(itype(i))
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
-cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
-cd write (2,*) 'i',i,' k',k,' j',j,' l',l
-cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-cd eello6=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
-cd call checkint_turn6(i,jj,kk,eel_turn6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx_turn(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
-cd eello6_5=0.0d0
-cd write (2,*) 'eello6_5',eello6_5
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
- ss1=scalar2(Ub2(1,i+2),b1(1,itl))
- s1 = (auxmat(1,1)+auxmat(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
- s2 = scalar2(b1(1,itk),vtemp1(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atemp(1,1))
- call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
- call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
- s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
- s12 = scalar2(Ub2(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
- call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
- call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
- ss13 = scalar2(b1(1,itk),vtemp4(1))
- s13 = (gtemp(1,1)+gtemp(2,2))*ss13
-#endif
-c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
-c s1=0.0d0
-c s2=0.0d0
-c s8=0.0d0
-c s12=0.0d0
-c s13=0.0d0
- eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
-C Derivatives in gamma(i+2)
- s1d =0.0d0
- s8d =0.0d0
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
- call transpose2(AEAderg(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
- gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
-C Derivatives in gamma(i+3)
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
-#endif
- call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
- s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
-#endif
- s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
- & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
- & -0.5d0*ekont*(s2d+s12d)
-#endif
-C Derivatives in gamma(i+4)
- call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-C s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
-#else
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
-#endif
-C Derivatives in gamma(i+5)
-#ifdef MOMENT
- call transpose2(AEAderg(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
- & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
- & -0.5d0*ekont*(s2d+s12d)
-#endif
-C Cartesian derivatives
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
- & vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*
- & scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
- & auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
- & - 0.5d0*(s1d+s2d)
-#else
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
- & - 0.5d0*s2d
-#endif
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
- & - 0.5d0*(s8d+s12d)
-#else
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
- & - 0.5d0*s12d
-#endif
- enddo
- enddo
- enddo
-#ifdef MOMENT
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
- & achuj_tempd(1,1))
- call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d=(gtempd(1,1)+gtempd(2,2))*ss13
- derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
- & vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
- derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
- enddo
- enddo
-#endif
-cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
-cd & 16*eel_turn6_num
-cd goto 1112
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
-cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
-cgrad ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
- gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
- gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
- & +ekont*derx_turn(ll,2,1)
- gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
- gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
- & +ekont*derx_turn(ll,4,1)
- gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
- gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
- gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
-cgrad ghalf=0.5d0*ggg2(ll)
-cd ghalf=0.0d0
- gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
- & +ekont*derx_turn(ll,2,2)
- gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
- gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
- & +ekont*derx_turn(ll,4,2)
- gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
- gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
- gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
- enddo
-cd goto 1112
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-cgrad1112 continue
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr6_loc(iii)
-cd enddo
- eello_turn6=ekont*eel_turn6
-cd write (2,*) 'ekont',ekont
-cd write (2,*) 'eel_turn6',ekont*eel_turn6
- return
- end
-
-C-----------------------------------------------------------------------------
- double precision function scalar(u,v)
-!DIR$ INLINEALWAYS scalar
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::scalar
-#endif
- implicit none
- double precision u(3),v(3)
-cd double precision sc
-cd integer i
-cd sc=0.0d0
-cd do i=1,3
-cd sc=sc+u(i)*v(i)
-cd enddo
-cd scalar=sc
-
- scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
- return
- end
-crc-------------------------------------------------
- SUBROUTINE MATVEC2(A1,V1,V2)
-!DIR$ INLINEALWAYS MATVEC2
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
-#endif
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A1(2,2),V1(2),V2(2)
-c DO 1 I=1,2
-c VI=0.0
-c DO 3 K=1,2
-c 3 VI=VI+A1(I,K)*V1(K)
-c Vaux(I)=VI
-c 1 CONTINUE
-
- vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
- vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
-
- v2(1)=vaux1
- v2(2)=vaux2
- END
-C---------------------------------------
- SUBROUTINE MATMAT2(A1,A2,A3)
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
-#endif
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A1(2,2),A2(2,2),A3(2,2)
-c DIMENSION AI3(2,2)
-c DO J=1,2
-c A3IJ=0.0
-c DO K=1,2
-c A3IJ=A3IJ+A1(I,K)*A2(K,J)
-c enddo
-c A3(I,J)=A3IJ
-c enddo
-c enddo
-
- ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
- ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
- ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
- ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
-
- A3(1,1)=AI3_11
- A3(2,1)=AI3_21
- A3(1,2)=AI3_12
- A3(2,2)=AI3_22
- END
-
-c-------------------------------------------------------------------------
- double precision function scalar2(u,v)
-!DIR$ INLINEALWAYS scalar2
- implicit none
- double precision u(2),v(2)
- double precision sc
- integer i
- scalar2=u(1)*v(1)+u(2)*v(2)
- return
- end
-
-C-----------------------------------------------------------------------------
-
- subroutine transpose2(a,at)
-!DIR$ INLINEALWAYS transpose2
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::transpose2
-#endif
- implicit none
- double precision a(2,2),at(2,2)
- at(1,1)=a(1,1)
- at(1,2)=a(2,1)
- at(2,1)=a(1,2)
- at(2,2)=a(2,2)
- return
- end
-c--------------------------------------------------------------------------
- subroutine transpose(n,a,at)
- implicit none
- integer n,i,j
- double precision a(n,n),at(n,n)
- do i=1,n
- do j=1,n
- at(j,i)=a(i,j)
- enddo
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine prodmat3(a1,a2,kk,transp,prod)
-!DIR$ INLINEALWAYS prodmat3
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
-#endif
- implicit none
- integer i,j
- double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
- logical transp
-crc double precision auxmat(2,2),prod_(2,2)
-
- if (transp) then
-crc call transpose2(kk(1,1),auxmat(1,1))
-crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
-crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
- & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
- & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
- & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
- & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
-
- else
-crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
-crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
- & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
- & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
- & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
- & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
-
- endif
-c call transpose2(a2(1,1),a2t(1,1))
-
-crc print *,transp
-crc print *,((prod_(i,j),i=1,2),j=1,2)
-crc print *,((prod(i,j),i=1,2),j=1,2)
-
- return
- end
-
subroutine etotal_long(energia)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
c
c Compute the long-range slow-varying contributions to the energy
#ifdef MPI
include "mpif.h"
double precision weights_(n_ene)
+ double precision time00,time_Bcast,time_BcastW
+ integer ierror,ierr
#endif
include 'COMMON.SETUP'
include 'COMMON.IOUNITS'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
include 'COMMON.LOCAL'
+ include 'COMMON.QRESTR'
include 'COMMON.MD'
include 'COMMON.CONTROL'
+ double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc,
+ & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr,
+ & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6,
+ & eliptran,Eafmforce,Etube,
+ & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet
+ integer i,n_corr,n_corr1
c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
if (modecalc.eq.12.or.modecalc.eq.14) then
#ifdef MPI
weights_(17)=wbond
weights_(18)=scal14
weights_(21)=wsccor
+ weights_(22)=wliptran
+ weights_(25)=wtube
weights_(26)=wsaxs
+ weights_(28)=wdfa_dist
+ weights_(29)=wdfa_tor
+ weights_(30)=wdfa_nei
+ weights_(31)=wdfa_beta
C FG Master broadcasts the WEIGHTS_ array
call MPI_Bcast(weights_(1),n_ene,
& MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
wbond=weights(17)
scal14=weights(18)
wsccor=weights(21)
+ wliptran=weights(22)
+ wtube=weights(25)
wsaxs=weights(26)
+ wdfa_dist=weights_(28)
+ wdfa_tor=weights_(29)
+ wdfa_nei=weights_(30)
+ wdfa_beta=weights_(31)
endif
call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,
& king,FG_COMM,IERR)
else
call escp_soft_sphere(evdw2,evdw2_14)
endif
+#ifdef FOURBODY
C
C 12/1/95 Multi-body terms
C
if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
endif
+#endif
C
C If performing constraint dynamics, call the constraint energy
C after the equilibration time
#ifdef MPI
include "mpif.h"
double precision weights_(n_ene)
+ double precision time00
+ integer ierror,ierr
#endif
include 'COMMON.SETUP'
include 'COMMON.IOUNITS'
include 'COMMON.VAR'
include 'COMMON.LOCAL'
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.TORCNSTR'
-
+ double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc,
+ & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr,
+ & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6,
+ & eliptran,Eafmforce,Etube,
+ & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet
+ integer i,n_corr,n_corr1
c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
c call flush(iout)
if (modecalc.eq.12.or.modecalc.eq.14) then
etors=0.0d0
endif
edihcnstr=0.0d0
+c Lipid transfer
+ if (wliptran.gt.0) then
+ call Eliptransfer(eliptran)
+ else
+ eliptran=0.0d0
+ endif
+
if (ndih_constr.gt.0) call etor_constr(edihcnstr)
c print *,"Processor",myrank," computed Utor"
C
subroutine gen_rand_conf(nstart,*)
C Generate random conformation or chain cut and regrowth.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
include 'COMMON.GEO'
include 'COMMON.CONTROL'
logical overlap,back,fail
+ integer nstart
+ integer i,j,k,it,it1,it2,nit,niter,nsi,maxsi,maxnit
+ double precision gen_theta,gen_phi,dist
cd print *,' CG Processor',me,' maxgen=',maxgen
maxsi=100
cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart
end
c-------------------------------------------------------------------------
logical function overlap(i)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
include 'COMMON.FFIELD'
- data redfac /0.5D0/
+ double precision redfac /0.5D0/
+ integer i,j,k,iti,itj,iteli,itelj
+ double precision rcomp
+ double precision dist
overlap=.false.
iti=iabs(itype(i))
if (iti.gt.ntyp) return
call chainbuild_extconf
call overlap_sc_list(ioverlap,ioverlap_last)
-c write (iout,*) 'Overlaping residues ',ioverlap_last,
-c & (ioverlap(j),j=1,ioverlap_last)
+ write (iout,*) 'Overlaping residues ',ioverlap_last,
+ & (ioverlap(j),j=1,ioverlap_last)
enddo
if (k.le.1000.and.ioverlap_last.eq.0) then
integer ioverlap(maxres),ioverlap_last
data redfac /0.5D0/
+ write (iout,*) "overlap_sc_list"
ioverlap_last=0
C Check for SC-SC overlaps and mark residues
c print *,'>>overlap_sc nnt=',nnt,' nct=',nct
ct if ( 1.0/rij .lt. redfac*rcomp .or.
ct & rij_shift.le.0.0D0 ) then
+c write (iout,'(a,i3,a,i3,a,f10.5,a,3f10.5)')
+c & 'overlap SC-SC: i=',i,' j=',j,
+c & ' dist=',dist(nres+i,nres+j),' rcomp=',
+c & rcomp,1.0/rij,rij_shift
if ( rij_shift.le.0.0D0 ) then
-cd write (iout,'(a,i3,a,i3,a,f10.5,a,3f10.5)')
-cd & 'overlap SC-SC: i=',i,' j=',j,
-cd & ' dist=',dist(nres+i,nres+j),' rcomp=',
-cd & rcomp,1.0/rij,rij_shift
ioverlap_last=ioverlap_last+1
ioverlap(ioverlap_last)=i
do k=1,ioverlap_last-1
subroutine pdbout(etot,tytul,iunit)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.HEADER'
include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
character*50 tytul
+ integer iunit
character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
- dimension ica(maxres)
+ integer ica(maxres)
+ integer i,j,k,iti,itj,itk,itl,iatom,ichain,ires
+ double precision etot
write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
cmodel write (iunit,'(a5,i6)') 'MODEL',1
if (nhfrag.gt.0) then
character*32 tytul,fd
character*3 zahl
character*6 res_num,pom,ucase
+ double precision etot
#ifdef AIX
call fdate_(fd)
#elif (defined CRAY)
end
c------------------------------------------------------------------------
subroutine intout
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.CHAIN'
include 'COMMON.NAMES'
include 'COMMON.GEO'
include 'COMMON.TORSION'
+ integer i,iti
write (iout,'(/a)') 'Geometry of the virtual chain.'
write (iout,'(7a)') ' Res ',' d',' Theta',
& ' Phi',' Dsc',' Alpha',' Omega'
end
c---------------------------------------------------------------------------
subroutine briefout(it,ener)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.CHAIN'
include 'COMMON.NAMES'
include 'COMMON.GEO'
include 'COMMON.SBRIDGE'
+ integer it,ener,i
c print '(a,i5)',intname,igeom
#if defined(AIX) || defined(PGI) || defined(CRAY)
open (igeom,file=intname,position='append')
#else
subroutine cartoutx(time)
#endif
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.HEADER'
include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
+ integer i,j,k
double precision time
#if defined(AIX) || defined(PGI) || defined(CRAY)
open(icart,file=cartname,position="append")
c-----------------------------------------------------------------
#ifndef NOXDR
subroutine cartout(time)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.IOUNITS'
include 'COMMON.HEADER'
include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
double precision time
integer iret,itmp
real xcoord(3,maxres2+2),prec
+ integer i,j,ixdrf
#ifdef AIX
call xdrfopen_(ixdrf,cartname, "a", iret)
include 'COMMON.IOUNITS'
include 'COMMON.HEADER'
include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.REMD'
include 'COMMON.SETUP'
integer itime
#endif
#endif
if (AFMlog.gt.0) then
- if (refstr) then
+ if (refstr) then
call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)')
& itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
& kinetic_T,t_bath,gyrate(),
& potEcomp(23),me
format1="a114"
- endif
+ endif
else if (selfguide.gt.0) then
distance=0.0
do j=1,3
distance=distance+(c(j,afmend)-c(j,afmbeg))**2
enddo
distance=dsqrt(distance)
- if (refstr) then
+ if (refstr) then
call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2,
& f9.3,i5,$)')
& distance,potEcomp(23),me
format1="a133"
C print *,"CHUJOWO"
- else
+ else
C print *,'A CHUJ',potEcomp(23)
write (line1,'(i10,f15.2,8f12.3,i5,$)')
& itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
format1="a114"
endif
else
- if (refstr) then
+ if (refstr) then
call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
& itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
& amax,kinetic_T,t_bath,gyrate(),me
format1="a114"
endif
- endif
- if(usampl.and.totT.gt.eq_time) then
+ endif
+ if(usampl.and.totT.gt.eq_time) then
if (loc_qlike) then
write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
& (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
& +21*nfrag_back
endif
- else
+ else
format2="a001"
line2=' '
- endif
- if (print_compon) then
+ endif
+ if (print_compon) then
if(itime.eq.0) then
write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
- & ",100a12)"
- write (istat,format) "#"," ",
+ & ",31a12)"
+ write (istat,format) "#","",
& (ename(print_order(i)),i=1,nprint_ene)
endif
write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
- & ",100f12.3)"
+ & ",31f12.3)"
write (istat,format) line1,line2,
& (potEcomp(print_order(i)),i=1,nprint_ene)
- else
+ else
write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
write (istat,format) line1,line2
- endif
+ endif
#if defined(AIX)
call flush(istat)
#else
end
c---------------------------------------------------------------
double precision function gyrate()
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.INTERACT'
include 'COMMON.CHAIN'
+ integer i,ii,j
double precision cen(3),rg
do j=1,3
+#ifndef LBFGS
subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
+ include 'COMMON.CONTROL'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.FFIELD'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.IOUNITS'
+ integer n,nf
+ double precision ufparm
external ufparm
integer uiparm(1)
double precision urparm(1)
- dimension x(n),g(n)
+ double precision x(n),g(n)
+ integer i,j,k,ind,ind1
+ double precision f,gthetai,gphii,galphai,gomegai
c
c This subroutine calculates total internal coordinate gradient.
c Depending on the number of function evaluations, either whole energy
if (nf.eq.0) return
goto 40
30 call var_to_geom(n,x)
- call chainbuild
+ call chainbuild_extconf
c write (iout,*) 'grad 30'
C
-C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-C
- 40 call cartder
-c write (iout,*) 'grad 40'
-c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
+C Transform the gradient to the gradient in angles.
C
-C Convert the Cartesian gradient into internal-coordinate gradient.
-C
- ind=0
- ind1=0
- do i=1,nres-2
- gthetai=0.0D0
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
-c ind=indmat(i,j)
-c print *,'GRAD: i=',i,' jc=',j,' ind=',ind
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- enddo
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- enddo
- enddo
- do j=i+1,nres-1
- ind1=ind1+1
-c ind1=indmat(i,j)
-c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
- do k=1,3
- gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
- gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
- enddo
- enddo
- if (i.gt.1) g(i-1)=gphii
- if (n.gt.nphi) g(nphi+i)=gthetai
- enddo
- if (n.le.nphi+ntheta) goto 10
- do i=2,nres-1
- if (itype(i).ne.10) then
- galphai=0.0D0
- gomegai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ialph(i,1))=galphai
- g(ialph(i,1)+nside)=gomegai
- endif
- enddo
+ 40 call cart2intgrad(n,g)
C
C Add the components corresponding to local energy terms.
C
end
C-------------------------------------------------------------------------
subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.FFIELD'
include 'COMMON.IOUNITS'
+ integer n,nf
+ double precision ufparm
external ufparm
integer uiparm(1)
double precision urparm(1)
- dimension x(maxvar),g(maxvar)
+ double precision x(maxvar),g(maxvar),gg(maxvar)
+ integer i,j,k,ig,ind,ij,igall
+ double precision f,gthetai,gphii,galphai,gomegai
icg=mod(nf,2)+1
if (nf-nfl+1) 20,30,40
C
C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
C
- 40 call cartder
+ 40 call cart2intgrad(n,gg)
C
C Convert the Cartesian gradient into internal-coordinate gradient.
C
ig=0
- ind=nres-2
+ ind=nres-2
do i=2,nres-2
- IF (mask_phi(i+2).eq.1) THEN
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
- enddo
- enddo
+ IF (mask_phi(i+2).eq.1) THEN
ig=ig+1
- g(ig)=gphii
- ELSE
- ind=ind+nres-1-i
+ g(ig)=gg(i-1)
ENDIF
enddo
- ind=0
do i=1,nres-2
IF (mask_theta(i+2).eq.1) THEN
ig=ig+1
- gthetai=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
- enddo
- enddo
- g(ig)=gthetai
- ELSE
- ind=ind+nres-1-i
+ g(ig)=gg(nphi+i)
ENDIF
enddo
do i=2,nres-1
- if (itype(i).ne.10) then
+ if (itype(i).ne.10) then
IF (mask_side(i).eq.1) THEN
ig=ig+1
- galphai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- g(ig)=galphai
+ g(ig)=gg(ialph(i,1))
ENDIF
endif
enddo
if (itype(i).ne.10) then
IF (mask_side(i).eq.1) THEN
ig=ig+1
- gomegai=0.0D0
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ig)=gomegai
+ g(ig)=gg(ialph(i,1)+nside)
ENDIF
endif
enddo
cd enddo
return
end
+#endif
C-------------------------------------------------------------------------
subroutine cartgrad
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
#endif
+ include 'COMMON.CONTROL'
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.FFIELD'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
+ integer i,j,kk
c
c This subrouting calculates total Cartesian coordinate gradient.
c The subroutine chainbuild_cart and energy MUST be called beforehand.
#endif
return
end
+c---------------------------------------------------------------------------
+#ifdef FIVEDIAG
+ subroutine grad_transform
+ implicit none
+ include 'DIMENSIONS'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.VAR'
+ include 'COMMON.INTERACT'
+ include 'COMMON.FFIELD'
+ include 'COMMON.MD'
+ include 'COMMON.QRESTR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.TIME1'
+ integer i,j,kk
+#ifdef DEBUG
+ write (iout,*)"Converting virtual-bond gradient to CA/SC gradient"
+ write (iout,*) "dC/dX gradient"
+ do i=0,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
+ & (gxcart(j,i),j=1,3)
+ enddo
+#endif
+ do i=nres,1,-1
+ do j=1,3
+ gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
+! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
+ enddo
+! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
+! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
+ enddo
+! Correction: dummy residues
+ do i=2,nres
+ if (itype(i-1).eq.ntyp1 .and. itype(i).ne.ntyp1) then
+ gcart(:,i)=gcart(:,i)+gcart(:,i-1)
+ else if (itype(i-1).ne.ntyp1 .and. itype(i).eq.ntyp1) then
+ gcart(:,i-1)=gcart(:,i-1)+gcart(:,i)
+ endif
+ enddo
+c if (nnt.gt.1) then
+c do j=1,3
+c gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
+c enddo
+c endif
+c if (nct.lt.nres) then
+c do j=1,3
+c! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
+c gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
+c enddo
+c endif
+#ifdef DEBUG
+ write (iout,*) "CA/SC gradient"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
+ & (gxcart(j,i),j=1,3)
+ enddo
+#endif
+ return
+ end
+#endif
C-------------------------------------------------------------------------
subroutine zerograd
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.DERIV'
include 'COMMON.CHAIN'
include 'COMMON.MD'
include 'COMMON.SCCOR'
include 'COMMON.SHIELD'
+ integer i,j,kk,intertyp,maxshieldlist
maxshieldlist=0
C
C Initialize Cartesian-coordinate gradient
do intertyp=1,3
gloc_sc(intertyp,i,icg)=0.0d0
enddo
+ enddo
+ enddo
#ifndef DFA
+ do i=1,nres
+ do j=1,3
gdfad(j,i)=0.0d0
gdfat(j,i)=0.0d0
gdfan(j,i)=0.0d0
gdfab(j,i)=0.0d0
-#endif
enddo
enddo
+#endif
C
C Initialize the gradient of local energy terms.
C
block data
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.MCM'
- include 'COMMON.MD'
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
data MovTypID
& /'pool','chain regrow','multi-bond','phi','theta','side chain',
& 'total'/
C
C Define constants and zero out tables.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.MINIM'
include 'COMMON.DERIV'
include 'COMMON.SPLITELE'
+ include 'COMMON.VAR'
c Common blocks from the diagonalization routines
+ integer IR,IW,IP,IJK,IPK,IDAF,NAV,IODA,KDIAG,ICORFL,IXDR
+ integer i,idumm,j,k,l,ichir1,ichir2,iblock,m
+ double precision rr
COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
COMMON /MACHSW/ KDIAG,ICORFL,IXDR
- logical mask_r
c real*8 text1 /'initial_i'/
mask_r=.false.
+ mask_theta=1
+ mask_phi=1
+ mask_side=1
#ifndef ISNAN
c NaNQ initialization
i=-1
C lipidic environment if lipid is implicite
C DNA input files for parameters range 80-99
-C Suger input files for parameters range 100-119
+C Sugar input files for parameters range 100-119
C All-atom input files for parameters range 120-149
C
C Set default weights of the energy terms.
C
- wlong=1.0D0
+ wsc=1.0D0
welec=1.0D0
wtor =1.0D0
wang =1.0D0
C
c maxfun=5000
c maxit=2000
- maxfun=500
- maxit=200
+ maxfun=1000
+ maxmin=500
tolf=1.0D-2
rtolf=5.0D-4
C
C
nfl=0
icg=1
+ sideonly=.false.
C
C Initialize constants used to split the energy into long- and short-range
C components
end
c-------------------------------------------------------------------------
block data nazwy
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.NAMES'
include 'COMMON.FFIELD'
end
c---------------------------------------------------------------------------
subroutine init_int_table
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
+ integer ierr,ierror
integer blocklengths(15),displs(15)
#endif
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.SETUP'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
include 'COMMON.TORCNSTR'
include 'COMMON.IOUNITS'
include 'COMMON.DERIV'
- include 'COMMON.CONTACTS'
+ include 'COMMON.CORRMAT'
+ integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
+ & iturn4_end_all,iatel_s_all,
+ & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all,
+ & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all,
+ & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old
common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
& iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
& iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
& itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
logical scheck,lprint,flag
+ integer i,j,k,ii,jj,iint,npept,nele_int_tot,ind_eleint,ind_scint,
+ & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw,
+ & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk,
+ & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde,
+ & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,
+ & iaux,ind_typ,ncheck_from,ncheck_to,ichunk
#ifdef MPI
integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
& my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
C... Determine the numbers of start and end SC-SC interaction
C... to deal with by current processor.
+#ifdef FOURBODY
do i=0,nfgtasks-1
itask_cont_from(i)=fg_rank
itask_cont_to(i)=fg_rank
enddo
+#endif
lprint=energy_dec
if (lprint)
&write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
enddo
call flush(iout)
endif
+#ifdef FOURBODY
ntask_cont_from=0
ntask_cont_to=0
itask_cont_from(0)=fg_rank
call MPI_Group_free(fg_group,ierr)
call MPI_Group_free(cont_from_group,ierr)
call MPI_Group_free(cont_to_group,ierr)
+#endif
call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
call MPI_Type_commit(MPI_UYZ,IERROR)
call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
end
c---------------------------------------------------------------------------
subroutine int_bounds(total_ints,lower_bound,upper_bound)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
include 'COMMON.SETUP'
integer total_ints,lower_bound,upper_bound
integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
+ integer i,nint,nexcess
nint=total_ints/nfgtasks
do i=1,nfgtasks
int4proc(i-1)=nint
end
c---------------------------------------------------------------------------
subroutine int_bounds1(total_ints,lower_bound,upper_bound)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
include 'COMMON.SETUP'
integer total_ints,lower_bound,upper_bound
integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
+ integer i,nint,nexcess
nint=total_ints/nfgtasks1
do i=1,nfgtasks1
int4proc(i-1)=nint
c---------------------------------------------------------------------------
subroutine int_partition(int_index,lower_index,upper_index,atom,
& at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
integer int_index,lower_index,upper_index,atom,at_start,at_end,
- & first_atom,last_atom,int_gr,jat_start,jat_end
+ & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
logical lprn
lprn=.false.
if (lprn) write (iout,*) 'int_index=',int_index
#endif
c------------------------------------------------------------------------------
subroutine hpb_partition
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
end
c------------------------------------------------------------------------------
subroutine homology_partition
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.IOUNITS'
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
- include 'COMMON.MD'
include 'COMMON.INTERACT'
+ include 'COMMON.HOMOLOGY'
cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
cd & " lim_dih",lim_dih
#ifdef MPI
end
c------------------------------------------------------------------------------
subroutine NMRpeak_partition
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
c This subroutine converts the energy derivatives from internal
c coordinates to cartesian coordinates
c-------------------------------------------------------------
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.SCCOR'
include 'COMMON.CONTROL'
+ integer i,j
c calculating dE/ddc1
C print *,"wchodze22",ialph(2,1)
if (nres.lt.3) go to 18
c
c Calculates the planar angle between atoms (i1), (i2), and (i3).
c
- implicit real*8 (a-h,o-z)
+ implicit none
+ integer i1,i2,i3
+ double precision x12,x23,y12,y23,z12,z23,vnorm,wnorm,scalar,angle
+ double precision arcos
+ external arcos
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.CHAIN'
z23=c(3,i3)-c(3,i2)
vnorm=dsqrt(x12*x12+y12*y12+z12*z12)
wnorm=dsqrt(x23*x23+y23*y23+z23*z23)
- if ((vnorm.eq.0.0).or.(wnorm.eq.0.0)) then
- scalar=1.0
+ if ((vnorm.eq.0.0d0).or.(wnorm.eq.0.0d0)) then
+ scalar=1.0d0
else
scalar=(x12*x23+y12*y23+z12*z23)/(vnorm*wnorm)
endif
c
c Calculates the dihedral angle between atoms (i1), (i2), (i3) and (i4)
c
- implicit real*8 (a-h,o-z)
+ implicit none
+ integer i1,i2,i3,i4
+ double precision x12,x23,x34,y12,y23,y34,z12,z23,z34,vnorm,wnorm,
+ & vx,vy,vz,wx,wy,wz,tx,ty,tz,scalar,angle
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.CHAIN'
c
c Calculates the distance between atoms (i1) and (i2).
c
- implicit real*8 (a-h,o-z)
+ implicit none
+ integer i1,i2
+ double precision x12,y12,z12
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.CHAIN'
+++ /dev/null
- subroutine integral(gamma1,gamma2,gamma3,gamma4,ity1,ity2,a1,a2,
- & si1,si2,si3,si4,transp,q)
- implicit none
- integer ity1,ity2
- integer ilam1,ilam2,ilam3,ilam4,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4
- logical transp
- double precision elocal,ele
- double precision delta,delta2,sum,ene,sumene,boltz
- double precision q,a1(2,2),a2(2,2),si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=20
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) gamma1,gamma2,ity1,ity2,a1,a2,si1,si2,si3,si4,transp
-
-cd do ilam1=-180,180,5
-cd do ilam2=-180,180,5
-cd lambda1=ilam1*conv+delta2
-cd lambda2=ilam2*conv+delta2
-cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2),
-cd & ele(lambda1,lambda2,a1,1.0d0,1.d00)
-cd enddo
-cd enddo
-cd stop
-
- sum=0.0d0
- sumene=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
-cd write (2,*) ilam1,ilam2,ilam3,ilam4
-cd write (2,*) lambda1,lambda2,lambda3,lambda4
- ene=
- & -elocal(ity1,lambda1,lambda2,.false.)*
- & elocal(ity2,lambda3,lambda4,transp)*
- & ele(si1*lambda1+gamma1,si3*lambda3+gamma3,a1)*
- & ele(si2*lambda2+gamma2,si4*lambda4+gamma4,a2)
-cd write (2,*) elocal(ity1,lambda1,gamma1-pi-lambda2),
-cd & elocal(ity2,lambda3,gamma2-pi-lambda4),
-cd & ele(lambda1,lambda2,a1,si1,si3),
-cd & ele(lambda3,lambda4,a2,si2,si4)
- sum=sum+ene
- enddo
- enddo
- enddo
- enddo
- q=sum/(2*pi)**4*delta**4
- write (2,* )'sum',sum,' q',q
- return
- end
-c---------------------------------------------------------------------------
- subroutine integral3(gamma1,gamma2,ity1,ity2,ity3,ity4,
- & a1,koniec,q1,q2,q3,q4)
- implicit none
- integer ity1,ity2,ity3,ity4
- integer ilam1,ilam2,ilam3,ilam4,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,lambda1,
- & lambda2,lambda3,lambda4
- logical koniec
- double precision elocal,ele
- double precision delta,delta2,sum1,sum2,sum3,sum4,
- & ene1,ene2,ene3,ene4,boltz
- double precision q1,q2,q3,q4,a1(2,2),a2(2,2)
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
- write(2,*) gamma1,gamma2,ity1,ity2,ity3,ity4,a1,koniec
-
-cd do ilam1=-180,180,5
-cd do ilam2=-180,180,5
-cd lambda1=ilam1*conv+delta2
-cd lambda2=ilam2*conv+delta2
-cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2),
-cd & ele(lambda1,lambda2,a1,1.0d0,1.d00)
-cd enddo
-cd enddo
-cd stop
-
- sum1=0.0d0
- sum2=0.0d0
- sum3=0.0d0
- sum4=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
-cd write (2,*) ilam1,ilam2,ilam3,ilam4
-cd write (2,*) lambda1,lambda2,lambda3,lambda4
- if (.not.koniec) then
- ene1=
- & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)*
- & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)*
- & ele(lambda2,lambda4,a1)
- else
- ene1=
- & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)*
- & elocal(ity3,lambda3,lambda4,.false.)*
- & ele(lambda2,-lambda4,a1)
- endif
- ene2=
- & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)*
- & elocal(ity4,lambda3,lambda4,.false.)*
- & ele(lambda2,lambda3,a1)
- if (.not.koniec) then
- ene3=
- & elocal(ity2,lambda1,lambda2,.false.)*
- & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)*
- & ele(lambda1,lambda4,a1)
- else
- ene3=
- & elocal(ity2,lambda1,lambda2,.false.)*
- & elocal(ity3,lambda3,lambda4,.false.)*
- & ele(lambda1,-lambda4,a1)
- endif
- ene4=
- & elocal(ity2,lambda1,lambda2,.false.)*
- & elocal(ity4,lambda3,lambda4,.false.)*
- & ele(lambda1,lambda3,a1)
- sum1=sum1+ene1
- sum2=sum2+ene2
- sum3=sum3+ene3
- sum4=sum4+ene4
- enddo
- enddo
- enddo
- enddo
- q1=sum1/(2*pi)**4*delta**4
- q2=sum2/(2*pi)**4*delta**4
- q3=sum3/(2*pi)**4*delta**4
- q4=sum4/(2*pi)**4*delta**4
- write (2,* )'sum',sum1,sum2,sum3,sum4,' q',q1,q2,q3,q4
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral5(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3,
- & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc5,eloc6,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,sum1,sum2,sum3,sum4,
- & a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
-cd & ' gamma3=',gamma3,' gamma4=',gamma4
-cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6
-cd write(2,*) 'a1=',a1
-cd write(2,*) 'a2=',a2
-cd write(2,*) si1,si2,si3,si4,transp
-
- sum1=0.0d0
- sum2=0.0d0
- sum3=0.0d0
- sum4=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- do ilam5=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- lambda5=ilam5*conv+delta2
- if (transp) then
- ele1=ele(lambda1,si4*lambda4,a1)
- ele2=ele(lambda2,lambda3,a2)
- else
- ele1=ele(lambda1,lambda3,a1)
- ele2=ele(lambda2,si4*lambda4,a2)
- endif
- eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.)
- eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.)
- pom=ele1*ele2*eloc2*eloc5
- if (si1.gt.0) then
- eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.)
- sum1=sum1+pom*eloc1
- endif
- eloc3=elocal(ity3,lambda2,lambda5,.false.)
- sum2=sum2+pom*eloc3
- eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.)
- sum3=sum3+pom*eloc4
- if (si4.gt.0) then
- eloc6=elocal(ity6,lambda4,lambda5,.false.)
- sum4=sum4+pom*eloc6
- endif
- enddo
- enddo
- enddo
- enddo
- enddo
- pom=1.0d0/(2*pi)**5*delta**5
- ene1=sum1*pom
- ene2=sum2*pom
- ene3=sum3*pom
- ene4=sum4*pom
-c write (2,* )'sum',sum1,sum2,sum3,sum4,' q',ene1,ene2,ene3,ene4
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral_turn6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,
- & ity3,ity4,ity5,ity6,a1,a2,ene_turn6)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom,ene5
- double precision ene_turn6,sum5,a1(2,2),a2(2,2)
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
- write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
- & ' gamma3=',gamma3,' gamma4=',gamma4
- write(2,*) ity1,ity2,ity3,ity4,ity5,ity6
- write(2,*) 'a1=',a1
- write(2,*) 'a2=',a2
-
- sum5=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- do ilam5=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- lambda5=ilam5*conv+delta2
- ele1=ele(lambda1,-lambda4,a1)
- ele2=ele(lambda2,lambda3,a2)
- eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.)
- eloc5=elocal(ity5,lambda3,lambda4,.false.)
- pom=ele1*ele2*eloc2*eloc5
- eloc3=elocal(ity3,lambda2,gamma3-pi-lambda5,.false.)
- eloc4=elocal(ity4,lambda5,gamma4-pi-lambda3,.false.)
- sum5=sum5+pom*eloc3*eloc4
- enddo
- enddo
- enddo
- enddo
- enddo
- pom=-1.0d0/(2*pi)**5*delta**5
- ene_turn6=sum5*pom
-c print *,'sum6',sum6,' ene6',ene6
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3,
- & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4,
- & ene5,ene6)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3,
- & sum4,sum5,sum6,a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
-cd & ' gamma3=',gamma3,' gamma4=',gamma4
-cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6
-cd write(2,*) 'a1=',a1
-cd write(2,*) 'a2=',a2
-cd write(2,*) si1,si2,si3,si4,transp
-
- sum1=0.0d0
- sum2=0.0d0
- sum3=0.0d0
- sum4=0.0d0
- sum5=0.0d0
- sum6=0.0d0
- eloc1=0.0d0
- eloc6=0.0d0
- eloc61=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- do ilam5=-180,179,iincr
- do ilam6=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- lambda5=ilam5*conv+delta2
- lambda6=ilam6*conv+delta2
- if (transp) then
- ele1=ele(lambda1,si4*lambda4,a1)
- ele2=ele(lambda2,lambda3,a2)
- else
- ele1=ele(lambda1,lambda3,a1)
- ele2=ele(lambda2,si4*lambda4,a2)
- endif
- eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.)
- eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.)
- pom=ele1*ele2*eloc2*eloc5
- if (si1.gt.0) then
- eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.)
- endif
- eloc3=elocal(ity3,lambda2,lambda6,.false.)
- sum1=sum1+pom*eloc1*eloc3
- eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.)
- if (si4.gt.0) then
- eloc6=elocal(ity6,lambda4,lambda6,.false.)
- eloc61=elocal(ity6,lambda4,lambda5,.false.)
- endif
- sum2=sum2+pom*eloc4*eloc6
- eloc41=elocal(ity4,lambda6,gamma3-pi-lambda3,.false.)
- sum3=sum3+pom*eloc1*eloc41
- sum4=sum4+pom*eloc1*eloc6
- sum5=sum5+pom*eloc3*eloc4
- sum6=sum6+pom*eloc3*eloc61
- enddo
- enddo
- enddo
- enddo
- enddo
- enddo
- pom=-1.0d0/(2*pi)**6*delta**6
- ene1=sum1*pom
- ene2=sum2*pom
- ene3=sum3*pom
- ene4=sum4*pom
- ene5=sum5*pom
- ene6=sum6*pom
-c print *,'sum6',sum6,' ene6',ene6
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral3a(gamma1,gamma2,ity1,ity2,a1,si1,ene1)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3,
- & sum4,sum5,sum6,a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2
-cd write(2,*) ity1,ity2
-cd write(2,*) 'a1=',a1
-cd write(2,*) si1,
-
- sum1=0.0d0
- eloc1=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- ele1=ele(lambda1,si1*lambda3,a1)
- eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)
- if (si1.gt.0) then
- eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.)
- else
- eloc2=elocal(ity2,lambda2,lambda3,.false.)
- endif
- sum1=sum1+ele1*eloc1*eloc2
- enddo
- enddo
- enddo
- pom=1.0d0/(2*pi)**3*delta**3
- ene1=sum1*pom
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral4a(gamma1,gamma2,gamma3,ity1,ity2,ity3,a1,si1,
- & ene1)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3,
- & sum4,sum5,sum6,a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
-cd & ' gamma3=',gamma3
-cd write(2,*) ity1,ity2,ity3
-cd write(2,*) 'a1=',a1
-cd write(2,*) 'si1=',si1
- sum1=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- ele1=ele(lambda1,si1*lambda4,a1)
- eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)
- eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.)
- if (si1.gt.0) then
- eloc3=elocal(ity3,lambda3,gamma3-pi-lambda4,.false.)
- else
- eloc3=elocal(ity3,lambda3,lambda4,.false.)
- endif
- sum1=sum1+ele1*eloc1*eloc2*eloc3
- enddo
- enddo
- enddo
- enddo
- pom=-1.0d0/(2*pi)**4*delta**4
- ene1=sum1*pom
- return
- end
-c-------------------------------------------------------------------------
- double precision function elocal(i,x,y,transp)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.TORSION'
- integer i
- double precision x,y,u(2),v(2),cu(2),dv(2),ev(2)
- double precision scalar2
- logical transp
- u(1)=dcos(x)
- u(2)=dsin(x)
- v(1)=dcos(y)
- v(2)=dsin(y)
- if (transp) then
- call matvec2(cc(1,1,i),v,cu)
- call matvec2(dd(1,1,i),u,dv)
- call matvec2(ee(1,1,i),u,ev)
- elocal=scalar2(b1(1,i),v)+scalar2(b2(1,i),u)+scalar2(cu,v)+
- & scalar2(dv,u)+scalar2(ev,v)
- else
- call matvec2(cc(1,1,i),u,cu)
- call matvec2(dd(1,1,i),v,dv)
- call matvec2(ee(1,1,i),v,ev)
- elocal=scalar2(b1(1,i),u)+scalar2(b2(1,i),v)+scalar2(cu,u)+
- & scalar2(dv,v)+scalar2(ev,u)
- endif
- return
- end
-c-------------------------------------------------------------------------
- double precision function ele(x,y,a)
- implicit none
- double precision x,y,a(2,2),si1,si2,u(2),v(2),av(2)
- double precision scalar2
- u(1)=-cos(x)
- u(2)= sin(x)
- v(1)=-cos(y)
- v(2)= sin(y)
- call matvec2(a,v,av)
- ele=scalar2(u,av)
- return
- end
+++ /dev/null
- subroutine kinetic(KE_total)
-c----------------------------------------------------------------
-c This subroutine calculates the total kinetic energy of the chain
-c-----------------------------------------------------------------
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- double precision KE_total
-
- integer i,j,k
- double precision KEt_p,KEt_sc,KEr_p,KEr_sc,incr(3),
- & mag1,mag2,v(3)
-
- KEt_p=0.0d0
- KEt_sc=0.0d0
-c write (iout,*) "ISC",(isc(itype(i)),i=1,nres)
-c The translational part for peptide virtual bonds
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct-1
-c write (iout,*) "Kinetic trp:",i,(incr(j),j=1,3)
- do j=1,3
- v(j)=incr(j)+0.5d0*d_t(j,i)
- enddo
- vtot(i)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3)
- KEt_p=KEt_p+(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- enddo
-c write(iout,*) 'KEt_p', KEt_p
-c The translational part for the side chain virtual bond
-c Only now we can initialize incr with zeros. It must be equal
-c to the velocities of the first Calpha.
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct
- iti=iabs(itype(i))
- if (itype(i).eq.10) then
- do j=1,3
- v(j)=incr(j)
- enddo
- else
- do j=1,3
- v(j)=incr(j)+d_t(j,nres+i)
- enddo
- endif
-c write (iout,*) "Kinetic trsc:",i,(incr(j),j=1,3)
-c write (iout,*) "i",i," msc",msc(iti)," v",(v(j),j=1,3)
- KEt_sc=KEt_sc+msc(iti)*(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))
- vtot(i+nres)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3)
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- enddo
-c goto 111
-c write(iout,*) 'KEt_sc', KEt_sc
-c The part due to stretching and rotation of the peptide groups
- KEr_p=0.0D0
- do i=nnt,nct-1
-c write (iout,*) "i",i
-c write (iout,*) "i",i," mag1",mag1," mag2",mag2
- do j=1,3
- incr(j)=d_t(j,i)
- enddo
-c write (iout,*) "Kinetic rotp:",i,(incr(j),j=1,3)
- KEr_p=KEr_p+(incr(1)*incr(1)+incr(2)*incr(2)
- & +incr(3)*incr(3))
- enddo
-c goto 111
-c write(iout,*) 'KEr_p', KEr_p
-c The rotational part of the side chain virtual bond
- KEr_sc=0.0D0
- do i=nnt,nct
- iti=iabs(itype(i))
- if (itype(i).ne.10) then
- do j=1,3
- incr(j)=d_t(j,nres+i)
- enddo
-c write (iout,*) "Kinetic rotsc:",i,(incr(j),j=1,3)
- KEr_sc=KEr_sc+Isc(iti)*(incr(1)*incr(1)+incr(2)*incr(2)+
- & incr(3)*incr(3))
- endif
- enddo
-c The total kinetic energy
- 111 continue
-c write(iout,*) 'KEr_sc', KEr_sc
- KE_total=0.5d0*(mp*KEt_p+KEt_sc+0.25d0*Ip*KEr_p+KEr_sc)
-c write (iout,*) "KE_total",KE_total
- return
- end
-
-
-
-
c are obtained. For numerical gradient checking, the derivetive of the
c lagrangian in the velocities and coordinates are calculated seperately
c-------------------------------------------------------------------------
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
+ integer time00
#endif
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
include 'COMMON.MUCA'
integer i,j,ind
double precision zapas(MAXRES6),muca_factor
logical lprn /.false./
+ integer itime
common /cipiszcze/ itime
+#ifdef FIVEDIAG
+ double precision rs(maxres2_chain),xsolv(maxres2_chain),ip4
+ double precision aaux(3)
+ integer nind,innt,inct,inct_prev,ichain,n,mark
+#ifdef CHECK5DSOL
+ double precision rscheck(maxres2_chain),rsold(maxres2_chain)
+#endif
+#endif
#ifdef TIMING
time00=MPI_Wtime()
#endif
+#ifdef FIVEDIAG
+ call grad_transform
+ d_a=0.0d0
+ if (lprn) then
+ write (iout,*) "Potential forces backbone"
+ do i=1,nres
+ write (iout,'(i5,3e15.5,5x,3e15.5)')i,(-gcart(j,i),j=1,3)
+ enddo
+ write (iout,*) "Potential forces sidechain"
+ do i=nnt,nct
+! if (itype(i).ne.10 .and. itype(i).ne.ntyp1) &
+ write (iout,'(i5,3e15.5,5x,3e15.5)') i,(-gxcart(j,i),j=1,3)
+ enddo
+ endif
+ do ichain=1,nchain
+ n=dimen_chain(ichain)
+ innt=iposd_chain(ichain)
+ do j=1,3
+ ind=1
+ do i=chain_border(1,ichain),chain_border(2,ichain)
+ if (itype(i).eq.10)then
+ rs(ind)=-gcart(j,i)-gxcart(j,i)
+ ind=ind+1
+ else
+ rs(ind)=-gcart(j,i)
+ rs(ind+1)=-gxcart(j,i)
+ ind=ind+2
+ end if
+ enddo
+#ifdef CHECK5DSOL
+ rsold=rs
+#endif
+ if (lprn) then
+ write(iout,*)
+ & "RHS of the 5-diag equations system, chain",ichain," j",j
+ do i=1,n
+ write(iout,'(i5,f10.5)') i,rs(i)
+ enddo
+ endif
+ call FDISYS (n,DM(innt),DU1(innt),DU2(innt),rs,xsolv)
+ if (lprn) then
+ write (iout,*) "Solution of the 5-diagonal equations system"
+ do i=1,n
+ write (iout,'(i5,f10.5)') i,xsolv(i)
+ enddo
+ endif
+#ifdef CHECK5DSOL
+! Check the solution
+ call fivediagmult(n,DMorig(innt),DU1orig(innt),DU2orig(innt),
+ & xsolv,rscheck)
+ do i=1,n
+ write(iout,*) "i",i,"rsold",rsold(i),"rscheck",rscheck(i),
+ & "ratio",rscheck(i)/rsold(i)
+ enddo
+! end check
+#endif
+#undef CHECK5DSOL
+ ind=1
+ do i=chain_border(1,ichain),chain_border(2,ichain)
+ if (itype(i).eq.10) then
+ d_a(j,i)=xsolv(ind)
+ ind=ind+1
+ else
+ d_a(j,i)=xsolv(ind)
+ d_a(j,i+nres)=xsolv(ind+1)
+ ind=ind+2
+ end if
+ enddo
+ enddo ! j
+ enddo ! ichain
+ if (lprn) then
+ write (iout,*) "Acceleration in CA and SC oordinates"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(d_a(j,i),j=1,3)
+ enddo
+ do i=nnt,nct
+ write (iout,'(i3,3f10.5)') i,(d_a(j,i+nres),j=1,3)
+ enddo
+ endif
+C Conevert d_a to virtual-bon-vector basis
+#define WLOS
+#ifdef WLOS
+c write (iout,*) "WLOS"
+ if (nnt.eq.1) then
+ d_a(:,0)=d_a(:,1)
+ endif
+ do i=1,nres
+ if (itype(i).eq.10 .or. itype(i).eq.ntyp1) then
+ do j=1,3
+ d_a(j,i)=d_a(j,i+1)-d_a(j,i)
+ enddo
+ else
+ do j=1,3
+ d_a(j,i+nres)=d_a(j,i+nres)-d_a(j,i)
+ d_a(j,i)=d_a(j,i+1)-d_a(j,i)
+ enddo
+ end if
+ enddo
+ d_a(:,nres)=0.0d0
+ d_a(:,nct)=0.0d0
+ d_a(:,2*nres)=0.0d0
+c d_a(:,0)=d_a(:,1)
+c d_a(:,1)=0.0d0
+c write (iout,*) "Shifting accelerations"
+ if (nnt.gt.1) then
+ d_a(:,0)=d_a(:,1)
+ d_a(:,1)=0.0d0
+ endif
+#define CHUJ
+#ifdef CHUJ
+ do ichain=2,nchain
+c write (iout,*) "ichain",chain_border1(1,ichain)-1,
+c & chain_border1(1,ichain)
+ d_a(:,chain_border1(1,ichain)-1)=d_a(:,chain_border1(1,ichain))
+ d_a(:,chain_border1(1,ichain))=0.0d0
+ enddo
+c write (iout,*) "Adding accelerations"
+ do ichain=2,nchain
+c write (iout,*) "chain",ichain,chain_border1(1,ichain)-1,
+c & chain_border(2,ichain-1)
+ d_a(:,chain_border1(1,ichain)-1)=
+ & d_a(:,chain_border1(1,ichain)-1)+d_a(:,chain_border(2,ichain-1))
+ d_a(:,chain_border(2,ichain-1))=0.0d0
+ enddo
+#endif
+#else
+ inct_prev=0
+ do j=1,3
+ aaux(j)=0.0d0
+ enddo
+ do ichain=1,nchain
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ do j=1,3
+ d_a(j,inct_prev)=d_a(j,innt)-aaux(j)
+ enddo
+ inct_prev=inct+1
+ do i=innt,inct
+ if (itype(i).ne.10) then
+ do j=1,3
+ d_a(j,i+nres)=d_a(j,i+nres)-d_a(j,i)
+ enddo
+ endif
+ enddo
+ do j=1,3
+ aaux(j)=d_a(j,inct)
+ enddo
+ do i=innt,inct
+ do j=1,3
+ d_a(j,i)=d_a(j,i+1)-d_a(j,i)
+ enddo
+ enddo
+ enddo
+#endif
+ if (lprn) then
+ write(iout,*) 'acceleration 3D FIVEDIAG in dC and dX'
+ do i=0,nres
+ write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3)
+ enddo
+ do i=nnt,nct
+ write (iout,'(i3,3f10.5,3x,3f10.5)')
+ & i,(d_a(j,i+nres),j=1,3)
+ enddo
+ endif
+#else
do j=1,3
zapas(j)=-gcart(j,0)
enddo
& i+nres,(d_a(j,i+nres),j=1,3)
enddo
endif
+#endif
#ifdef TIMING
time_lagrangian=time_lagrangian+MPI_Wtime()-time00
#endif
return
- end
+ end
c------------------------------------------------------------------
subroutine setup_MD_matrices
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
- integer ierror
+ integer ierror,ierr
+ double precision time00
#endif
+ include 'COMMON.CONTROL'
include 'COMMON.SETUP'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
- integer i,j
+ integer i,j,k,m,m1,ind,ind1,ii,iti,ii1,jj
+ double precision coeff
logical lprn /.false./
logical osob
- double precision dtdi,massvec(maxres2),Gcopy(maxres2,maxres2),
- & Ghalf(mmaxres2),sqreig(maxres2)
+ double precision dtdi,massvec(maxres2)
+#ifdef FIVEDIAG
+ integer ichain,innt,inct,nind,mark,n
+ double precision ip4
+#else
+ double precision Gcopy(maxres2,maxres2),Ghalf(mmaxres2),
+ & sqreig(maxres2)
double precision work(8*maxres6)
integer iwork(maxres6)
common /przechowalnia/ Gcopy,Ghalf
+#endif
c
c Set up the matrix of the (dC,dX)-->(C,X) transformation (A), the
c inertia matrix (Gmat) and the inverse of the inertia matrix (Ginv)
c
c Determine the number of degrees of freedom (dimen) and the number of
c sites (dimen1)
+#ifdef FIVEDIAG
+ dimen=0
+ dimen1=0
+ do ichain=1,nchain
+ dimen=dimen+chain_length(ichain)
+ dimen1=dimen1+2*chain_length(ichain)-1
+ dimenp=dimenp+chain_length(ichain)-1
+ enddo
+ write (iout,*) "Number of Calphas",dimen
+ write (iout,*) "Number of sidechains",nside
+ write (iout,*) "Number of peptide groups",dimenp
+ dimen=dimen+nside ! number of centers
+ dimen3=3*dimen ! degrees of freedom
+ write (iout,*) "Number of centers",dimen
+ write (iout,*) "Degrees of freedom:",dimen3
+ ip4=ip/4
+ ind=1
+ do ichain=1,nchain
+ iposd_chain(ichain)=ind
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ DM(ind)=mp/4+ip4
+ if (iabs(itype(innt)).eq.10) then
+ DM(ind)=DM(ind)+msc(10)
+ ind=ind+1
+ nind=1
+ else
+ DM(ind)=DM(ind)+isc(iabs(itype(innt)))
+ DM(ind+1)=msc(iabs(itype(innt)))+isc(iabs(itype(innt)))
+ ind=ind+2
+ nind=2
+ endif
+ write (iout,*) "ind",ind," nind",nind
+ do i=innt+1,inct-1
+! if (iabs(itype(i)).eq.ntyp1) cycle
+ DM(ind)=2*ip4+mp/2
+ if (iabs(itype(i)).eq.10) then
+ if (iabs(itype(i)).eq.10) DM(ind)=DM(ind)+msc(10)
+ ind=ind+1
+ nind=nind+1
+ else
+ DM(ind)=DM(ind)+isc(iabs(itype(i)))
+ DM(ind+1)=msc(iabs(itype(i)))+isc(iabs(itype(i)))
+ ind=ind+2
+ nind=nind+2
+ endif
+ write (iout,*) "i",i," ind",ind," nind",nind
+ enddo
+ if (inct.gt.innt) then
+ DM(ind)=ip4+mp/4
+ if (iabs(itype(inct)).eq.10) then
+ DM(ind)=DM(ind)+msc(10)
+ ind=ind+1
+ nind=nind+1
+ else
+ DM(ind)=DM(ind)+isc(iabs(itype(inct)))
+ DM(ind+1)=msc(iabs(itype(inct)))+isc(iabs(itype(inct)))
+ ind=ind+2
+ nind=nind+2
+ endif
+ endif
+ write (iout,*) "ind",ind," nind",nind
+ dimen_chain(ichain)=nind
+ enddo
+
+ do ichain=1,nchain
+ ind=iposd_chain(ichain)
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ do i=innt,inct
+ if (iabs(itype(i)).ne.10 .and.iabs(itype((i))).ne.ntyp1) then
+ DU1(ind)=-isc(iabs(itype(i)))
+ DU1(ind+1)=0.0d0
+ ind=ind+2
+ else
+ DU1(ind)=mp/4-ip4
+ ind=ind+1
+ endif
+ enddo
+ enddo
+
+ do ichain=1,nchain
+ ind=iposd_chain(ichain)
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ do i=innt,inct-1
+! if (iabs(itype(i)).eq.ntyp1) cycle
+c write (iout,*) "i",i," itype",itype(i),ntyp1
+ if (iabs(itype(i)).ne.10 .and. iabs(itype(i)).ne.ntyp1) then
+ DU2(ind)=mp/4-ip4
+ DU2(ind+1)=0.0d0
+ ind=ind+2
+ else
+ DU2(ind)=0.0d0
+ DU2(ind+1)=0.0d0
+ ind=ind+1
+ endif
+ enddo
+ enddo
+ DMorig=DM
+ DU1orig=DU1
+ DU2orig=DU2
+ if (gmatout) then
+ write (iout,*)"The upper part of the five-diagonal inertia matrix"
+ endif
+ do ichain=1,nchain
+ if (gmatout) write (iout,'(a,i5)') 'Chain',ichain
+ n=dimen_chain(ichain)
+ innt=iposd_chain(ichain)
+ inct=iposd_chain(ichain)+dimen_chain(ichain)-1
+ if (gmatout) then
+ do i=innt,inct
+ if (i.lt.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DM(i),DU1(i),DU2(i)
+ else if (i.eq.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DM(i),DU1(i)
+ else
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DM(i)
+ endif
+ enddo
+ endif
+ call FDISYP (n, DM(innt:inct), DU1(innt:inct-1),
+ & DU2(innt:inct-1), MARK)
+
+ if (mark.eq.-1) then
+ write(iout,*)
+ & "ERROR: the inertia matrix is not positive definite for chain",
+ & ichain
+#ifdef MPI
+ call MPI_Finalize(ierr)
+#endif
+ stop
+ else if (mark.eq.0) then
+ write (iout,*)
+ & "ERROR: the inertia matrix is singular for chain",ichain
+#ifdef MPI
+ call MPI_Finalize(ierr)
+#endif
+ else if (mark.eq.1) then
+ if (gmatout) then
+ write (iout,*) "The transformed five-diagonal inertia matrix"
+ write (iout,'(a,i5)') 'Chain',ichain
+ do i=innt,inct
+ if (i.lt.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DM(i),DU1(i),DU2(i)
+ else if (i.eq.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DM(i),DU1(i)
+ else
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DM(i)
+ endif
+ enddo
+ endif
+ endif
+ enddo
+! Diagonalization of the pentadiagonal matrix
+#ifdef TIMING
+ time00=MPI_Wtime()
+#endif
+#else
dimen=(nct-nnt+1)+nside
dimen1=(nct-nnt)+(nct-nnt+1)
dimen3=dimen*3
+ write (iout,*) "Degrees_of_freedom",dimen3
#ifdef MPI
if (nfgtasks.gt.1) then
time00=MPI_Wtime()
A(k+ii,jj)=1.0d0
enddo
enddo
- if (lprn) then
+ if (gmatout) then
write (iout,*)
write (iout,*) "Vector massvec"
do i=1,dimen1
enddo
enddo
- if (lprn) then
+ if (gmatout) then
write (iout,'(//a)') "Gmat"
call matout(dimen,dimen,maxres2,maxres2,Gmat)
endif
enddo
c Invert the G matrix
call MATINVERT(dimen,maxres2,Gcopy,Ginv,osob)
- if (lprn) then
+ if (gmatout) then
write (iout,'(//a)') "Ginv"
call matout(dimen,dimen,maxres2,maxres2,Ginv)
endif
enddo
call gldiag(maxres2,dimen,dimen,Ghalf,work,Geigen,Gvec,
& ierr,iwork)
- if (lprn) then
+ if (gmatout) then
write (iout,'(//a)')
& "Eigenvectors and eigenvalues of the G matrix"
call eigout(dimen,dimen,maxres2,maxres2,Gvec,Geigen)
enddo
enddo
endif
+#endif
return
end
c-------------------------------------------------------------------------------
SUBROUTINE EIGOUT(NC,NR,LM2,LM3,A,B)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
double precision A(LM2,LM3),B(LM2)
+ integer nc,nr,lm2,lm3,ka,kb,kc,n,i,j
KA=1
KC=6
1 KB=MIN0(KC,NC)
END
c-------------------------------------------------------------------------------
SUBROUTINE MATOUT(NC,NR,LM2,LM3,A)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
double precision A(LM2,LM3)
+ integer nc,nr,lm2,lm3,n,ka,kb,kc,i,j
KA=1
KC=6
1 KB=MIN0(KC,NC)
END
c-------------------------------------------------------------------------------
SUBROUTINE MATOUT1(NC,NR,LM2,LM3,A)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
double precision A(LM2,LM3)
+ integer nc,nr,lm2,lm3,n,ka,kb,kc,i,j
KA=1
KC=21
1 KB=MIN0(KC,NC)
END
c-------------------------------------------------------------------------------
SUBROUTINE MATOUT2(NC,NR,LM2,LM3,A)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
double precision A(LM2,LM3)
+ integer nc,nr,lm2,lm3,ka,kb,kc,i,j,n
KA=1
KC=12
1 KB=MIN0(KC,NC)
603 FORMAT (I5,4(3F9.3,2x))
604 FORMAT (1H1)
END
+c-----------------------------------------------------------------------------
+ SUBROUTINE MATOUTR(N,A)
+c Prints the lower fragment of a symmetric matix
+ implicit none
+ integer n
+ double precision a(n*(n+1)/2)
+ integer i,j,k,nlim,jlim,jlim1
+ CHARACTER*6 LINE6 / '------' /
+ CHARACTER*12 LINE12 / '------------' /
+ double precision B(10)
+ include 'COMMON.IOUNITS'
+ DO 1 I=1,N,10
+ NLIM=MIN0(I+9,N)
+ WRITE (IOUT,1000) (K,K=I,NLIM)
+ WRITE (IOUT,1020) LINE6,(LINE12,K=I,NLIM)
+ 1000 FORMAT (/7X,10(I5,2X))
+ 1020 FORMAT (A6,10A7)
+ DO 2 J=I,N
+ JLIM=MIN0(J,NLIM)
+ JLIM1=JLIM-I+1
+ DO 3 K=I,JLIM
+ 3 B(K-I+1)=A(J*(J-1)/2+K)
+ WRITE (IOUT,1010) J,(B(K),K=1,JLIM1)
+ 2 CONTINUE
+ 1 CONTINUE
+ 1010 FORMAT (I3,3X,10(F7.2))
+ RETURN
+ END
+#ifdef FIVEDIAG
+c---------------------------------------------------------------------------
+ subroutine fivediagmult(n,DM,DU1,DU2,x,y)
+ implicit none
+ integer n
+ double precision DM(n),DU1(n),DU2(n),x(n),y(n)
+ integer i
+ y(1)=DM(1)*x(1)+DU1(1)*x(2)+DU2(1)*x(3)
+ y(2)=DU1(1)*x(1)+DM(2)*x(2)+DU1(2)*x(3)+DU2(2)*x(4)
+ do i=3,n-2
+ y(i)=DU2(i-2)*x(i-2)+DU1(i-1)*x(i-1)+DM(i)*x(i)
+ & +DU1(i)*x(i+1)+DU2(i)*x(i+2)
+ enddo
+ y(n-1)=DU2(n-3)*x(n-3)+DU1(n-2)*x(n-2)+DM(n-1)*x(n-1)
+ & +DU1(n-1)*x(n)
+ y(n)=DU2(n-2)*x(n-2)+DU1(n-1)*x(n-1)+DM(n)*x(n)
+ return
+ end
+c---------------------------------------------------------------------------
+ subroutine fivediaginv_mult(ndim,forces,d_a_vec)
+ implicit none
+ include 'DIMENSIONS'
+ include 'COMMON.CHAIN'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.LAGRANGE.5diag'
+ include 'COMMON.INTERACT'
+ integer ndim
+ double precision forces(3*ndim),accel(3,0:maxres2),rs(ndim),
+ & xsolv(ndim),d_a_vec(6*nres)
+ integer i,j,ind,ichain,n,iposc,innt,inct,inct_prev
+ do j=1,3
+Compute accelerations in Calpha and SC
+ do ichain=1,nchain
+ n=dimen_chain(ichain)
+ iposc=iposd_chain(ichain)
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ do i=iposc,iposc+n-1
+ rs(i)=forces(3*(i-1)+j)
+ enddo
+ call FDISYS (n,DM(iposc),DU1(iposc),DU2(iposc),rs,xsolv)
+ ind=1
+ do i=innt,inct
+ if (itype(i).eq.10)then
+ accel(j,i)=xsolv(ind)
+ ind=ind+1
+ else
+ accel(j,i)=xsolv(ind)
+ accel(j,i+nres)=xsolv(ind+1)
+ ind=ind+2
+ end if
+ enddo
+ enddo
+ enddo
+C Conevert d_a to virtual-bon-vector basis
+#ifdef DEBUG
+ write (iout,*) "accel in CA-SC basis"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(accel(j,i),j=1,3),
+ & (accel(j,i+nres),j=1,3)
+ enddo
+ write (iout,*) "nnt",nnt
+#endif
+ if (nnt.eq.1) then
+ accel(:,0)=accel(:,1)
+ endif
+ do i=1,nres
+ if (itype(i).eq.10 .or. itype(i).eq.ntyp1) then
+ do j=1,3
+ accel(j,i)=accel(j,i+1)-accel(j,i)
+ enddo
+ else
+ do j=1,3
+ accel(j,i+nres)=accel(j,i+nres)-accel(j,i)
+ accel(j,i)=accel(j,i+1)-accel(j,i)
+ enddo
+ end if
+ enddo
+ accel(:,nres)=0.0d0
+ accel(:,2*nres)=0.0d0
+ if (nnt.gt.1) then
+ accel(:,0)=accel(:,1)
+ accel(:,1)=0.0d0
+ endif
+ do ichain=2,nchain
+ accel(:,chain_border1(1,ichain)-1)=
+ & accel(:,chain_border1(1,ichain))
+ accel(:,chain_border1(1,ichain))=0.0d0
+ enddo
+ do ichain=2,nchain
+ accel(:,chain_border1(1,ichain)-1)=
+ & accel(:,chain_border1(1,ichain)-1)
+ & +accel(:,chain_border(2,ichain-1))
+ accel(:,chain_border(2,ichain-1))=0.0d0
+ enddo
+#ifdef DEBUG
+ write (iout,*) "accel in fivediaginv_mult: 1"
+ do i=0,2*nres
+ write(iout,'(i5,3f10.5)') i,(accel(j,i),j=1,3)
+ enddo
+#endif
+ do j=1,3
+ d_a_vec(j)=accel(j,0)
+ enddo
+ ind=3
+ do i=nnt,nct-1
+ do j=1,3
+ d_a_vec(ind+j)=accel(j,i)
+ enddo
+ ind=ind+3
+ enddo
+ do i=nnt,nct
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ do j=1,3
+ d_a_vec(ind+j)=accel(j,i+nres)
+ enddo
+ ind=ind+3
+ endif
+ enddo
+#ifdef DEBUG
+ write (iout,*) "d_a_vec"
+ write (iout,'(3f10.5)') (d_a_vec(j),j=1,dimen3)
+#endif
+ return
+ end
+#else
c---------------------------------------------------------------------------
SUBROUTINE ginv_mult(z,d_a_tmp)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
- integer ierr
+ integer ierr,ierror
#endif
include 'COMMON.SETUP'
include 'COMMON.TIME1'
include 'COMMON.MD'
+ include 'COMMON.LAGRANGE'
double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00
&,time01,zcopy(dimen3)
+ integer i,j,k,ind
#ifdef MPI
if (nfgtasks.gt.1) then
if (fg_rank.eq.0) then
c---------------------------------------------------------------------------
#ifdef GINV_MULT
SUBROUTINE ginv_mult_test(z,d_a_tmp)
+ implicit none
include 'DIMENSIONS'
- integer dimen
-c include 'COMMON.MD'
+ include 'COMMON.LAGRANGE'
double precision z(dimen),d_a_tmp(dimen)
double precision ztmp(dimen/3),dtmp(dimen/3)
integer IERROR
#endif
include 'COMMON.MD'
+ include 'COMMON.LAGRANGE'
include 'COMMON.IOUNITS'
include 'COMMON.SETUP'
include 'COMMON.TIME1'
c enddo
return
end
+#endif
+++ /dev/null
- subroutine map
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MAP'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.CONTROL'
- include 'COMMON.TORCNSTR'
- double precision energia(0:n_ene)
- character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/
- double precision ang_list(10)
- double precision g(maxvar),x(maxvar)
- integer nn(10)
- write (iout,'(a,i3,a)')'Energy map constructed in the following ',
- & nmap,' groups of variables:'
- do i=1,nmap
- write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ',
- & res1(i),' to ',res2(i)
- enddo
- nmax=nstep(1)
- do i=2,nmap
- if (nmax.lt.nstep(i)) nmax=nstep(i)
- enddo
- ntot=nmax**nmap
- iii=0
- write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap),
- & (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM"
- do i=0,ntot-1
- ii=i
- do j=1,nmap
- nn(j)=mod(ii,nmax)+1
- ii=ii/nmax
- enddo
- do j=1,nmap
- if (nn(j).gt.nstep(j)) goto 10
- enddo
- iii=iii+1
-Cd write (iout,*) i,iii,(nn(j),j=1,nmap)
- do j=1,nmap
- ang_list(j)=ang_from(j)
- & +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j)
- do k=res1(j),res2(j)
- goto (1,2,3,4), kang(j)
- 1 phi(k)=deg2rad*ang_list(j)
- if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j)
- goto 5
- 2 theta(k)=deg2rad*ang_list(j)
- goto 5
- 3 alph(k)=deg2rad*ang_list(j)
- goto 5
- 4 omeg(k)=deg2rad*ang_list(j)
- 5 continue
- enddo ! k
- enddo ! j
- call chainbuild
- if (minim) then
- call geom_to_var(nvar,x)
- call minimize(etot,x,iretcode,nfun)
- print *,'SUMSL return code is',iretcode,' eval ',nfun
-c call intout
- else
- call zerograd
- call geom_to_var(nvar,x)
- endif
- call etotal(energia(0))
- etot = energia(0)
- nf=1
- nfl=3
- call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
- gnorm=0.0d0
- do k=1,nvar
- gnorm=gnorm+g(k)**2
- enddo
- etot=energia(0)
-
- gnorm=dsqrt(gnorm)
-c write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm
- write (istat,'(30e15.5)') (ang_list(k),k=1,nmap),
- & (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm
-c write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap)
-c call intout
-c call enerprint(energia)
- 10 continue
- enddo ! i
- return
- end
SUBROUTINE MATMULT(A1,A2,A3)
- implicit real*8 (a-h,o-z)
+ IMPLICIT NONE
include 'DIMENSIONS'
- DIMENSION A1(3,3),A2(3,3),A3(3,3)
- DIMENSION AI3(3,3)
+ DOUBLE PRECISION A1(3,3),A2(3,3),A3(3,3)
+ DOUBLE PRECISION AI3(3,3),A3IJ
+ integer I,J,K
DO 1 I=1,3
DO 2 J=1,3
- A3IJ=0.0
+ A3IJ=0.0D0
DO 3 K=1,3
3 A3IJ=A3IJ+A1(I,K)*A2(K,J)
AI3(I,J)=A3IJ
subroutine minim_jlee
+#ifdef LBFGS
+ use minima
+ use inform
+ use output
+ use iounit
+ use scales
+#endif
c controls minimization and sorting routines
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
- parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+#ifndef LBFGS
+ integer liv,lv
+ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+#endif
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.MINIM'
include 'COMMON.CONTROL'
+#ifdef LBFGS
+ common /gacia/ nfun
+ double precision grdmin
+ external funcgrad
+ external optsave
+#else
external func,gradient,fdum
+ dimension iv(liv)
+ double precision v(1:lv+1)
+ common /przechowalnia/ v
+#endif
real ran1,ran2,ran3
#ifdef MPI
include 'mpif.h'
dimension var(maxvar),erg(mxch*(mxch+1)/2+1)
dimension var2(maxvar)
integer iffr(maxres),ihpbt(maxdim),jhpbt(maxdim)
- double precision d(maxvar),v(1:lv+1),garbage(maxvar)
+ double precision d(maxvar),garbage(maxvar),g(maxvar)
double precision energia(0:n_ene),time0s,time1s
dimension indx(9),info(12)
- dimension iv(liv)
dimension idum(1),rdum(1)
dimension icont(2,maxcont)
logical check_var,fail
integer iloop(2)
- common /przechowalnia/ v
data rad /1.745329252d-2/
c receive # of start
! print *,'Processor',me,' calling MINIM_JLEE maxfun',maxfun,
! & ' maxmin',maxmin,' tolf',tolf,' rtolf',rtolf
+#ifdef LBFGS
+ maxiter=maxmin
+ coordtype='RIGIDBODY'
+ grdmin=tolf
+ jout=iout
+ jprint=print_min_stat
+ iwrite=0
+ if (.not. allocated(scale)) allocate (scale(nvar))
+c
+c set scaling parameter for function and derivative values;
+c use square root of median eigenvalue of typical Hessian
+c
+ set_scale = .true.
+c nvar = 0
+ do i = 1, nvar
+c if (use(i)) then
+c do j = 1, 3
+c nvar = nvar + 1
+ scale(i) = 12.0d0
+c end do
+c end if
+ end do
+#endif
nhpb0=nhpb
10 continue
time0s=MPI_WTIME()
nfun=nfun+1
write (iout,'(a,1pe14.5)')'#OVERLAP evdw after',energia(1)
else
+#ifdef LBFGS
+ etot=1.0d20
+ nfun=-1
+#else
v(10)=1.0d20
iv(1)=-1
+#endif
goto 201
endif
endif
endif
if (check_var(var,info)) then
+#ifdef LBFGS
+ etot=1.0d21
+#else
v(10)=1.0d21
iv(1)=6
+#endif
goto 201
endif
! write (*,*) 'MINIM_JLEE: Processor',me,' received nvar',nvar
! write (*,'(8f10.4)') (var(i),i=1,nvar)
- do i=1,nvar
- garbage(i)=var(i)
- enddo
+ do i=1,nvar
+ garbage(i)=var(i)
+ enddo
+#ifdef LBFGS
+ eee=funcgrad(var,g)
+ nfun=nfun+1
+ if(eee.ge.1.0d20) then
+c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
+c print *,' energy before SUMSL =',eee
+c print *,' aborting local minimization'
+ go to 201
+ endif
+ call lbfgs (nvar,var,etot,grdmin,funcgrad,optsave)
+ deallocate(scale)
+#else
call deflt(2,iv,liv,lv,v)
* 12 means fresh start, dont call deflt
iv(1)=12
c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
c print *,' energy before SUMSL =',eee
c print *,' aborting local minimization'
+#ifdef LBFGS
+ etot=eee
+#else
iv(1)=-1
v(10)=eee
+#endif
go to 201
endif
c find which conformation was returned from sumsl
nfun=nfun+iv(7)
+#endif
! print *,'Processor',me,' iv(17)',iv(17),' iv(18)',iv(18),' nf',nf,
! & ' retcode',iv(1),' energy',v(10),' tolf',v(31),' rtolf',v(32)
c if (iv(1).ne.4 .or. nf.le.1) then
201 continue
indx(1)=n
c return code: 6-gradient 9-number of ftn evaluation, etc
+#ifdef LBFGS
+ indx(2)=nfun
+#else
indx(2)=iv(1)
+#endif
c total # of ftn evaluations (for iwf=0, it includes all minimizations).
indx(3)=nfun
indx(4)=info(2)
c send back energies
c al & cc
c calculate contact order
+#ifdef LBFGS
+#ifdef CO_BIAS
+ call contact(.false.,ncont,icont,co)
+ erg(1)=etot-1.0d2*co
+#else
+ erg(1)=etot
+#endif
+#else
#ifdef CO_BIAS
call contact(.false.,ncont,icont,co)
erg(1)=v(10)-1.0d2*co
#else
erg(1)=v(10)
#endif
+#endif
j=1
call mpi_send(erg,j,mpi_double_precision,king,idreal,
* CG_COMM,ierr)
subroutine minim_mcmf
+#ifdef LBFGS
+ use minima
+ use inform
+ use output
+ use iounit
+ use scales
+#endif
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
+#ifndef LBFGS
parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+#endif
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.MINIM'
include 'mpif.h'
+#ifdef LBFGS
+ double precision grdmin
+ external funcgrad
+ external optsave
+#else
+ double precision v(1:lv+1)
+ common /przechowalnia/ v
external func,gradient,fdum
+ dimension iv(liv)
+#endif
+ common /gacia/ nf
real ran1,ran2,ran3
include 'COMMON.SETUP'
include 'COMMON.GEO'
include 'COMMON.FFIELD'
dimension muster(mpi_status_size)
dimension var(maxvar),erg(mxch*(mxch+1)/2+1)
- double precision d(maxvar),v(1:lv+1),garbage(maxvar)
+ double precision d(maxvar),garbage(maxvar)
dimension indx(6)
- dimension iv(liv)
dimension idum(1),rdum(1)
double precision przes(3),obrot(3,3)
logical non_conv
data rad /1.745329252d-2/
- common /przechowalnia/ v
ichuj=0
10 continue
* king,idreal,CG_COMM,muster,ierr)
c print *, 'worker ',me,' var read '
-
+#ifdef LBFGS
+ maxiter=maxmin
+ coordtype='RIGIDBODY'
+ grdmin=tolf
+ jout=iout
+ jprint=print_min_stat
+ iwrite=0
+ if (.not. allocated(scale)) allocate (scale(nvar))
+c
+c set scaling parameter for function and derivative values;
+c use square root of median eigenvalue of typical Hessian
+c
+ set_scale = .true.
+c nvar = 0
+ do i = 1, nvar
+c if (use(i)) then
+c do j = 1, 3
+c nvar = nvar + 1
+ scale(i) = 12.0d0
+c end do
+c end if
+ end do
+ eee=funcgrad(var,g)
+ if(eee.gt.1.0d18) then
+c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
+c print *,' energy before SUMSL =',eee
+c print *,' aborting local minimization'
+ nf=-1
+ go to 201
+ endif
+c write (iout,*) "Calling lbfgs"
+ call lbfgs (nvar,x,eee,grdmin,funcgrad,optsave)
+ nf=nf+1
+ deallocate(scale)
+#else
call deflt(2,iv,liv,lv,v)
* 12 means fresh start, dont call deflt
iv(1)=12
call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
c find which conformation was returned from sumsl
nf=iv(7)+1
+#endif
201 continue
c total # of ftn evaluations (for iwf=0, it includes all minimizations).
indx(4)=nf
+#ifdef LBFGS
+ indx(5)=0
+#else
indx(5)=iv(1)
eee=v(10)
+#endif
call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM,
* ierr)
subroutine minimize(etot,x,iretcode,nfun)
- implicit real*8 (a-h,o-z)
+#ifdef LBFGS
+ use minima
+ use inform
+ use output
+ use iounit
+ use scales
+#endif
+ implicit none
include 'DIMENSIONS'
+#ifndef LBFGS
+ integer liv,lv
parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+#endif
*********************************************************************
* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for *
* the calling subprogram. *
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.MINIM'
+ integer icall
common /srutu/ icall
- dimension iv(liv)
- double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar)
- double precision energia(0:n_ene)
+#ifdef LBFGS
+ double precision grdmin
+ external funcgrad
+ external optsave
+#else
+ integer iv(liv)
+ double precision v(1:lv)
+ common /przechowalnia/ v
+ integer idum
+ double precision rdum
+ double precision fdum
external func,gradient,fdum
external func_restr,grad_restr
logical not_done,change,reduce
+#endif
+ double precision x(maxvar),d(maxvar),xx(maxvar)
+ double precision energia(0:n_ene)
+ integer i,nvar_restr,nfun,iretcode
+ double precision etot
c common /przechowalnia/ v
+#ifdef LBFGS
+ maxiter=maxmin
+ coordtype='RIGIDBODY'
+ grdmin=tolf
+ jout=iout
+ jprint=print_min_stat
+ iwrite=0
+ if (.not. allocated(scale)) allocate (scale(nvar))
+c
+c set scaling parameter for function and derivative values;
+c use square root of median eigenvalue of typical Hessian
+c
+ set_scale = .true.
+c nvar = 0
+ do i = 1, nvar
+c if (use(i)) then
+c do j = 1, 3
+c nvar = nvar + 1
+ scale(i) = 12.0d0
+c end do
+c end if
+ end do
+c write (iout,*) "Calling lbfgs"
+ write (iout,*) 'Calling LBFGS, minimization in angles'
+ call var_to_geom(nvar,x)
+ call chainbuild_extconf
+ call etotal(energia(0))
+ call enerprint(energia(0))
+ call lbfgs (nvar,x,etot,grdmin,funcgrad,optsave)
+ deallocate(scale)
+ write (iout,*) "Minimized energy",etot
+#else
icall = 1
NOT_DONE=.TRUE.
do i=nphi+1,nvar
d(i)=1.0D-1
enddo
-cd print *,'Calling SUMSL'
-c call var_to_geom(nvar,x)
-c call chainbuild
-c call etotal(energia(0))
+ write (iout,*) 'Calling SUMSL'
+ call var_to_geom(nvar,x)
+ call chainbuild_extconf
+ call intout
+ call etotal(energia(0))
+ call enerprint(energia(0))
c etot = energia(0)
IF (mask_r) THEN
call x2xx(x,xx,nvar_restr)
c else
c not_done=.false.
c endif
- call chainbuild
+ call chainbuild_extconf
c call etotal(energia(0))
c etot=energia(0)
c call enerprint(energia(0))
c write (*,*) 'Processor',MyID,' leaves MINIMIZE.'
c ENDDO ! NOT_DONE
-
+#endif
return
end
#ifdef MPI
c----------------------------------------------------------------------------
subroutine ergastulum
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
+ double precision time00
+ integer ierr,ierror
#endif
include 'COMMON.SETUP'
include 'COMMON.DERIV'
include 'COMMON.FFIELD'
include 'COMMON.INTERACT'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.TIME1'
double precision z(maxres6),d_a_tmp(maxres6)
double precision edum(0:n_ene),time_order(0:10)
double precision Gcopy(maxres2,maxres2)
common /przechowalnia/ Gcopy
integer icall /0/
+ integer i,j,iorder
C Workers wait for variables and NF, and NFL from the boss
iorder=0
do while (iorder.ge.0)
call sum_gradient
c write (2,*) "After sum_gradient"
c write (2,*) "dimen",dimen," dimen3",dimen3
-c call flush(2)
+c call flush(2
+#ifndef FIVEDIAG
else if (iorder.eq.4) then
call ginv_mult(z,d_a_tmp)
else if (iorder.eq.5) then
c call flush(2)
c write (iout,*) "My chunk of ginv_block"
c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block)
+#endif
else if (iorder.eq.6) then
call int_from_cart1(.false.)
else if (iorder.eq.7) then
call chainbuild_cart
else if (iorder.eq.8) then
call intcartderiv
+#ifndef FIVEDIAG
else if (iorder.eq.9) then
call fricmat_mult(z,d_a_tmp)
+#endif
else if (iorder.eq.10) then
call setup_fricmat
endif
end
#endif
************************************************************************
+#ifdef LBFGS
+ double precision function funcgrad(x,g)
+ implicit none
+ include 'DIMENSIONS'
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.VAR'
+ include 'COMMON.INTERACT'
+ include 'COMMON.FFIELD'
+ include 'COMMON.MD'
+ include 'COMMON.QRESTR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ double precision energia(0:n_ene)
+ double precision x(nvar),g(nvar)
+ integer i
+c if (jjj.gt.0) then
+c write (iout,*) "in func x"
+c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
+c endif
+ call var_to_geom(nvar,x)
+ call zerograd
+ call chainbuild_extconf
+ call etotal(energia(0))
+ call sum_gradient
+ funcgrad=energia(0)
+ call cart2intgrad(nvar,g)
+C
+C Add the components corresponding to local energy terms.
+C
+c Add the usampl contributions
+ if (usampl) then
+ do i=1,nres-3
+ gloc(i,icg)=gloc(i,icg)+dugamma(i)
+ enddo
+ do i=1,nres-2
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
+ enddo
+ endif
+ do i=1,nvar
+cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
+ g(i)=g(i)+gloc(i,icg)
+ enddo
+ return
+ end
+#else
subroutine func(n,x,nf,f,uiparm,urparm,ufparm)
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
return
end
c-------------------------------------------------------
+#endif
subroutine x2xx(x,xx,n)
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
double precision xx(maxvar),x(maxvar)
+c write (iout,*) "nvar",nvar
do i=1,nvar
varall(i)=x(i)
enddo
- ig=0
- igall=0
- do i=4,nres
- igall=igall+1
- if (mask_phi(i).eq.1) then
- ig=ig+1
+ ig=0
+ igall=0
+ do i=4,nres
+ igall=igall+1
+ if (mask_phi(i).eq.1) then
+ ig=ig+1
xx(ig)=x(igall)
- endif
- enddo
-
- do i=3,nres
- igall=igall+1
- if (mask_theta(i).eq.1) then
- ig=ig+1
+ endif
+ enddo
+
+ do i=3,nres
+ igall=igall+1
+ if (mask_theta(i).eq.1) then
+ ig=ig+1
xx(ig)=x(igall)
- endif
+ endif
enddo
- do ij=1,2
- do i=2,nres-1
- if (itype(i).ne.10) then
- igall=igall+1
- if (mask_side(i).eq.1) then
- ig=ig+1
+ do ij=1,2
+ do i=2,nres-1
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ igall=igall+1
+ if (mask_side(i).eq.1) then
+ ig=ig+1
xx(ig)=x(igall)
- endif
- endif
- enddo
+c write (iout,*) "ij",ij," i",i," ig",ig," igall",igall
+c write (iout,*) "x",x(igall)," xx",xx(ig)
+ endif
+ endif
+ enddo
enddo
n=ig
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
double precision xx(maxvar),x(maxvar)
do i=1,nvar
x(i)=varall(i)
enddo
- ig=0
- igall=0
- do i=4,nres
- igall=igall+1
- if (mask_phi(i).eq.1) then
- ig=ig+1
+ ig=0
+ igall=0
+ do i=4,nres
+ igall=igall+1
+ if (mask_phi(i).eq.1) then
+ ig=ig+1
x(igall)=xx(ig)
- endif
- enddo
-
- do i=3,nres
- igall=igall+1
- if (mask_theta(i).eq.1) then
- ig=ig+1
+ endif
+ enddo
+
+ do i=3,nres
+ igall=igall+1
+ if (mask_theta(i).eq.1) then
+ ig=ig+1
x(igall)=xx(ig)
- endif
+ endif
enddo
- do ij=1,2
- do i=2,nres-1
- if (itype(i).ne.10) then
- igall=igall+1
- if (mask_side(i).eq.1) then
- ig=ig+1
+ do ij=1,2
+ do i=2,nres-1
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ igall=igall+1
+ if (mask_side(i).eq.1) then
+ ig=ig+1
x(igall)=xx(ig)
- endif
- endif
- enddo
+c write (iout,*) "ij",ij," i",i," ig",ig," igall",igall
+c write (iout,*) "x",x(igall)," xx",xx(ig)
+ endif
+ endif
+ enddo
enddo
return
c----------------------------------------------------------
subroutine minim_dc(etot,iretcode,nfun)
+#ifdef LBFGS
+ use minima
+ use inform
+ use output
+ use iounit
+ use scales
+#endif
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
+#ifndef LBFGS
parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+#endif
#ifdef MPI
include 'mpif.h'
#endif
include 'COMMON.GEO'
include 'COMMON.MINIM'
include 'COMMON.CHAIN'
+ double precision minval,x(maxvar),d(maxvar),xx(maxvar)
+#ifdef LBFGS
+ double precision grdmin
+ double precision funcgrad_dc
+ external funcgrad_dc,optsave
+#else
dimension iv(liv)
- double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar)
+ double precision v(1:lv)
common /przechowalnia/ v
-
- double precision energia(0:n_ene)
external func_dc,grad_dc,fdum
- logical not_done,change,reduce
+#endif
double precision g(maxvar),f1
-
+ integer nvarx
+ double precision energia(0:n_ene)
+#ifdef LBFGS
+ maxiter=maxmin
+ coordtype='CARTESIAN'
+ grdmin=tolf
+ jout=iout
+ jprint=print_min_stat
+ iwrite=0
+#else
call deflt(2,iv,liv,lv,v)
* 12 means fresh start, dont call deflt
iv(1)=12
do i=1,6*nres
d(i)=1.0D-1
enddo
-
+#endif
k=0
do i=1,nres-1
do j=1,3
enddo
endif
enddo
+ nvarx=k
+ write (iout,*) "Variables set up nvarx",nvarx
+ write (iout,*) "Before energy minimization"
+ call etotal(energia(0))
+ call enerprint(energia(0))
+#ifdef LBFGS
+c
+c From tinker
+c
+c perform dynamic allocation of some global arrays
+c
+ if (.not. allocated(scale)) allocate (scale(nvarx))
+c
+c set scaling parameter for function and derivative values;
+c use square root of median eigenvalue of typical Hessian
+c
+ set_scale = .true.
+c nvar = 0
+ do i = 1, nvarx
+c if (use(i)) then
+c do j = 1, 3
+c nvar = nvar + 1
+ scale(i) = 12.0d0
+c end do
+c end if
+ end do
+c write (iout,*) "minim_dc Calling lbfgs"
+ call lbfgs (nvarx,x,etot,grdmin,funcgrad_dc,optsave)
+ deallocate(scale)
+c write (iout,*) "minim_dc After lbfgs"
+#else
c-----
c write (iout,*) "checkgrad before SUMSL"
c icheckgrad=1
c write (iout,*) "checkgrad after SUMSL"
c call exec_checkgrad
c-----
-
+#endif
k=0
do i=1,nres-1
do j=1,3
cd x(i)=x(i)-1.0D-5
cd print '(i5,2f15.5)',i,g(i),(f1-f)/1.0D-5
cd enddo
-
+#ifndef LBFGS
etot=v(10)
iretcode=iv(1)
nfun=iv(6)
+#endif
return
end
+#ifdef LBFGS
+ double precision function funcgrad_dc(x,g)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ include 'COMMON.SETUP'
+ include 'COMMON.CHAIN'
+ include 'COMMON.DERIV'
+ include 'COMMON.VAR'
+ include 'COMMON.INTERACT'
+ include 'COMMON.FFIELD'
+ include 'COMMON.MD'
+ include 'COMMON.IOUNITS'
+ integer k
+ dimension x(maxvar),g(maxvar)
+ double precision energia(0:n_ene)
+ common /gacia/ nf
+c
+ nf=nf+1
+ k=0
+ do i=1,nres-1
+ do j=1,3
+ k=k+1
+ dc(j,i)=x(k)
+ enddo
+ enddo
+ do i=2,nres-1
+ if (ialph(i,1).gt.0) then
+ do j=1,3
+ k=k+1
+ dc(j,i+nres)=x(k)
+ enddo
+ endif
+ enddo
+ call chainbuild_cart
+ call zerograd
+ call etotal(energia(0))
+c write (iout,*) "energia",energia(0)
+ funcgrad_dc=energia(0)
+C
+C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
+C
+ call cartgrad
+ k=0
+ do i=1,nres-1
+ do j=1,3
+ k=k+1
+ g(k)=gcart(j,i)
+ enddo
+ enddo
+ do i=2,nres-1
+ if (ialph(i,1).gt.0) then
+ do j=1,3
+ k=k+1
+ g(k)=gxcart(j,i)
+ enddo
+ endif
+ enddo
+ return
+ end
+#else
subroutine func_dc(n,x,nf,f,uiparm,urparm,ufparm)
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
double precision ufparm
external ufparm
integer uiparm(1)
- real*8 urparm(1)
+ real*8 urparm(1)
dimension x(maxvar)
nfl=nf
cbad icg=mod(nf,2)+1
return
end
+#endif
C
C
logical function find_arg(ipos,line,errflag)
+ implicit none
+ integer maxlen
parameter (maxlen=80)
+ integer ipos
character*80 line
character*1 empty /' '/,equal /'='/
logical errflag
return
end
logical function find_group(iunit,jout,key1)
+ implicit none
+ integer iunit,jout
+ integer ll
character*(*) key1
character*80 karta,ucase
integer ilen
return
end
logical function iblnk(charc)
+ implicit none
character*1 charc
integer n
n = ichar(charc)
return
end
integer function ilen(string)
+ implicit none
character*(*) string
logical iblnk
return
end
integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset)
+ implicit none
+ integer nkey
character*16 keywd,keywdset(1:nkey,0:nkey)
character*16 ucase
+ integer i,ikey,narg
do i=1,narg
if (ucase(keywd).eq.keywdset(i,ikey)) then
* Match found
return
end
character*(*) function lcase(string)
+ implicit none
integer i, k, idiff
character*(*) string
character*1 c
return
end
logical function lcom(ipos,karta)
+ implicit none
+ integer ipos,i
character*80 karta
character koment(2) /'!','#'/
lcom=.false.
return
end
subroutine mykey(line,keywd,ipos,blankline,errflag)
+ implicit none
* This subroutine seeks a non-empty substring keywd in the string LINE.
* The substring begins with the first character different from blank and
* "=" encountered right to the pointer IPOS (inclusively) and terminates
* only separators or the maximum length of the data line (80) has been reached.
* The logical variable ERRFLAG is set at .TRUE. if the string
* consists only from a "=".
+ integer maxlen
parameter (maxlen=80)
character*1 empty /' '/,equal /'='/,comma /','/
character*(*) keywd
character*80 line
logical blankline,errflag,lcom
+ integer ipos,istart,iend
errflag=.false.
do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen))
ipos=ipos+1
return
end
subroutine numstr(inum,numm)
+ implicit none
+ integer inum,inum1,inum2,inumm
character*10 huj /'0123456789'/
character*(*) numm
inumm=inum
return
end
character*(*) function ucase(string)
+ implicit none
integer i, k, idiff
character*(*) string
character*1 c
+++ /dev/null
- subroutine inertia_tensor
-c Calculating the intertia tensor for the entire protein in order to
-c remove the perpendicular components of velocity matrix which cause
-c the molecule to rotate.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision Im(3,3),Imcp(3,3),cm(3),pr(3),M_SC,
- & eigvec(3,3),Id(3,3),eigval(3),L(3),vp(3),vrot(3),
- & vpp(3,0:MAXRES),vs_p(3),pr1(3,3),
- & pr2(3,3),pp(3),incr(3),v(3),mag,mag2
- common /gucio/ cm
- integer iti,inres
- do i=1,3
- do j=1,3
- Im(i,j)=0.0d0
- pr1(i,j)=0.0d0
- pr2(i,j)=0.0d0
- enddo
- L(i)=0.0d0
- cm(i)=0.0d0
- vrot(i)=0.0d0
- enddo
-c calculating the center of the mass of the protein
- do i=nnt,nct-1
- do j=1,3
- cm(j)=cm(j)+c(j,i)+0.5d0*dc(j,i)
- enddo
- enddo
- do j=1,3
- cm(j)=mp*cm(j)
- enddo
- M_SC=0.0d0
- do i=nnt,nct
- iti=iabs(itype(i))
- M_SC=M_SC+msc(iabs(iti))
- inres=i+nres
- do j=1,3
- cm(j)=cm(j)+msc(iabs(iti))*c(j,inres)
- enddo
- enddo
- do j=1,3
- cm(j)=cm(j)/(M_SC+(nct-nnt)*mp)
- enddo
-
- do i=nnt,nct-1
- do j=1,3
- pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j)
- enddo
- Im(1,1)=Im(1,1)+mp*(pr(2)*pr(2)+pr(3)*pr(3))
- Im(1,2)=Im(1,2)-mp*pr(1)*pr(2)
- Im(1,3)=Im(1,3)-mp*pr(1)*pr(3)
- Im(2,3)=Im(2,3)-mp*pr(2)*pr(3)
- Im(2,2)=Im(2,2)+mp*(pr(3)*pr(3)+pr(1)*pr(1))
- Im(3,3)=Im(3,3)+mp*(pr(1)*pr(1)+pr(2)*pr(2))
- enddo
-
- do i=nnt,nct
- iti=iabs(itype(i))
- inres=i+nres
- do j=1,3
- pr(j)=c(j,inres)-cm(j)
- enddo
- Im(1,1)=Im(1,1)+msc(iabs(iti))*(pr(2)*pr(2)+pr(3)*pr(3))
- Im(1,2)=Im(1,2)-msc(iabs(iti))*pr(1)*pr(2)
- Im(1,3)=Im(1,3)-msc(iabs(iti))*pr(1)*pr(3)
- Im(2,3)=Im(2,3)-msc(iabs(iti))*pr(2)*pr(3)
- Im(2,2)=Im(2,2)+msc(iabs(iti))*(pr(3)*pr(3)+pr(1)*pr(1))
- Im(3,3)=Im(3,3)+msc(iabs(iti))*(pr(1)*pr(1)+pr(2)*pr(2))
- enddo
-
- do i=nnt,nct-1
- Im(1,1)=Im(1,1)+Ip*(1-dc_norm(1,i)*dc_norm(1,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(1,2)=Im(1,2)+Ip*(-dc_norm(1,i)*dc_norm(2,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(1,3)=Im(1,3)+Ip*(-dc_norm(1,i)*dc_norm(3,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(2,3)=Im(2,3)+Ip*(-dc_norm(2,i)*dc_norm(3,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(2,2)=Im(2,2)+Ip*(1-dc_norm(2,i)*dc_norm(2,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(3,3)=Im(3,3)+Ip*(1-dc_norm(3,i)*dc_norm(3,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- enddo
-
-
- do i=nnt,nct
- if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
- iti=iabs(itype(i))
- inres=i+nres
- Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)*
- & dc_norm(1,inres))*vbld(inres)*vbld(inres)
- Im(1,2)=Im(1,2)-Isc(iti)*(dc_norm(1,inres)*
- & dc_norm(2,inres))*vbld(inres)*vbld(inres)
- Im(1,3)=Im(1,3)-Isc(iti)*(dc_norm(1,inres)*
- & dc_norm(3,inres))*vbld(inres)*vbld(inres)
- Im(2,3)=Im(2,3)-Isc(iti)*(dc_norm(2,inres)*
- & dc_norm(3,inres))*vbld(inres)*vbld(inres)
- Im(2,2)=Im(2,2)+Isc(iti)*(1-dc_norm(2,inres)*
- & dc_norm(2,inres))*vbld(inres)*vbld(inres)
- Im(3,3)=Im(3,3)+Isc(iti)*(1-dc_norm(3,inres)*
- & dc_norm(3,inres))*vbld(inres)*vbld(inres)
- endif
- enddo
-
- call angmom(cm,L)
-c write(iout,*) "The angular momentum before adjustment:"
-c write(iout,*) (L(j),j=1,3)
-
- Im(2,1)=Im(1,2)
- Im(3,1)=Im(1,3)
- Im(3,2)=Im(2,3)
-
-c Copying the Im matrix for the djacob subroutine
- do i=1,3
- do j=1,3
- Imcp(i,j)=Im(i,j)
- Id(i,j)=0.0d0
- enddo
- enddo
-
-c Finding the eigenvectors and eignvalues of the inertia tensor
- call djacob(3,3,10000,1.0d-10,Imcp,eigvec,eigval)
-c write (iout,*) "Eigenvalues & Eigenvectors"
-c write (iout,'(5x,3f10.5)') (eigval(i),i=1,3)
-c write (iout,*)
-c do i=1,3
-c write (iout,'(i5,3f10.5)') i,(eigvec(i,j),j=1,3)
-c enddo
-c Constructing the diagonalized matrix
- do i=1,3
- if (dabs(eigval(i)).gt.1.0d-15) then
- Id(i,i)=1.0d0/eigval(i)
- else
- Id(i,i)=0.0d0
- endif
- enddo
- do i=1,3
- do j=1,3
- Imcp(i,j)=eigvec(j,i)
- enddo
- enddo
- do i=1,3
- do j=1,3
- do k=1,3
- pr1(i,j)=pr1(i,j)+Id(i,k)*Imcp(k,j)
- enddo
- enddo
- enddo
- do i=1,3
- do j=1,3
- do k=1,3
- pr2(i,j)=pr2(i,j)+eigvec(i,k)*pr1(k,j)
- enddo
- enddo
- enddo
-c Calculating the total rotational velocity of the molecule
- do i=1,3
- do j=1,3
- vrot(i)=vrot(i)+pr2(i,j)*L(j)
- enddo
- enddo
-c Resetting the velocities
- do i=nnt,nct-1
- call vecpr(vrot(1),dc(1,i),vp)
- do j=1,3
- d_t(j,i)=d_t(j,i)-vp(j)
- enddo
- enddo
- do i=nnt,nct
- if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
- inres=i+nres
- call vecpr(vrot(1),dc(1,inres),vp)
- do j=1,3
- d_t(j,inres)=d_t(j,inres)-vp(j)
- enddo
- endif
- enddo
- call angmom(cm,L)
-c write(iout,*) "The angular momentum after adjustment:"
-c write(iout,*) (L(j),j=1,3)
- return
- end
-c----------------------------------------------------------------------------
- subroutine angmom(cm,L)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision L(3),cm(3),pr(3),vp(3),vrot(3),incr(3),v(3),
- & pp(3)
- integer iti,inres
-c Calculate the angular momentum
- do j=1,3
- L(j)=0.0d0
- enddo
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct-1
- do j=1,3
- pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j)
- enddo
- do j=1,3
- v(j)=incr(j)+0.5d0*d_t(j,i)
- enddo
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- call vecpr(pr(1),v(1),vp)
- do j=1,3
- L(j)=L(j)+mp*vp(j)
- enddo
- do j=1,3
- pr(j)=0.5d0*dc(j,i)
- pp(j)=0.5d0*d_t(j,i)
- enddo
- call vecpr(pr(1),pp(1),vp)
- do j=1,3
- L(j)=L(j)+Ip*vp(j)
- enddo
- enddo
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct
- iti=iabs(itype(i))
- inres=i+nres
- do j=1,3
- pr(j)=c(j,inres)-cm(j)
- enddo
- if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
- do j=1,3
- v(j)=incr(j)+d_t(j,inres)
- enddo
- else
- do j=1,3
- v(j)=incr(j)
- enddo
- endif
- call vecpr(pr(1),v(1),vp)
-c write (iout,*) "i",i," iti",iti," pr",(pr(j),j=1,3),
-c & " v",(v(j),j=1,3)," vp",(vp(j),j=1,3)
- do j=1,3
- L(j)=L(j)+msc(iabs(iti))*vp(j)
- enddo
-c write (iout,*) "L",(l(j),j=1,3)
- if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
- do j=1,3
- v(j)=incr(j)+d_t(j,inres)
- enddo
- call vecpr(dc(1,inres),d_t(1,inres),vp)
- do j=1,3
- L(j)=L(j)+Isc(iti)*vp(j)
- enddo
- endif
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine vcm_vel(vcm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- double precision vcm(3),vv(3),summas,amas
- do j=1,3
- vcm(j)=0.0d0
- vv(j)=d_t(j,0)
- enddo
- summas=0.0d0
- do i=nnt,nct
- if (i.lt.nct) then
- summas=summas+mp
- do j=1,3
- vcm(j)=vcm(j)+mp*(vv(j)+0.5d0*d_t(j,i))
- enddo
- endif
- amas=msc(iabs(itype(i)))
- summas=summas+amas
- if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
- do j=1,3
- vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres))
- enddo
- else
- do j=1,3
- vcm(j)=vcm(j)+amas*vv(j)
- enddo
- endif
- do j=1,3
- vv(j)=vv(j)+d_t(j,i)
- enddo
- enddo
-c write (iout,*) "vcm",(vcm(j),j=1,3)," summas",summas
- do j=1,3
- vcm(j)=vcm(j)/summas
- enddo
- return
- end
+++ /dev/null
- subroutine muca_delta(remd_t_bath,remd_ene,i,iex,delta)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- double precision remd_t_bath(maxprocs)
- double precision remd_ene(maxprocs)
- double precision muca_ene
- double precision betai,betaiex,delta
-
- betai=1.0/(Rb*remd_t_bath(i))
- betaiex=1.0/(Rb*remd_t_bath(iex))
-
- delta=betai*(muca_ene(remd_ene(iex),i,remd_t_bath)-
- & muca_ene(remd_ene(i),i,remd_t_bath))
- & -betaiex*(muca_ene(remd_ene(iex),iex,remd_t_bath)-
- & muca_ene(remd_ene(i),iex,remd_t_bath))
-
- return
- end
-
- double precision function muca_ene(energy,i,remd_t_bath)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- double precision y,yp,energy
- double precision remd_t_bath(maxprocs)
- integer i
-
- if (energy.lt.elowi(i)) then
- call splint(emuca,nemuca,nemuca2,nmuca,elowi(i),y,yp)
- muca_ene=remd_t_bath(i)*Rb*(yp*(energy-elowi(i))+y)
- elseif (energy.gt.ehighi(i)) then
- call splint(emuca,nemuca,nemuca2,nmuca,ehighi(i),y,yp)
- muca_ene=remd_t_bath(i)*Rb*(yp*(energy-ehighi(i))+y)
- else
- call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp)
- muca_ene=remd_t_bath(i)*Rb*y
- endif
- return
- end
-
- subroutine read_muca
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.CONTROL'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision yp1,ypn,yp,x,muca_factor,y,muca_ene
- imtime=0
- do i=1,4*maxres
- hist(i)=0
- enddo
- if (modecalc.eq.14.and..not.remd_tlist) then
- print *,"MUCAREMD works only with TLIST"
- stop
- endif
- open(89,file='muca.input')
- read(89,*)
- read(89,*)
- if (modecalc.eq.14) then
- read(89,*) (elowi(i),ehighi(i),i=1,nrep)
- if (remd_mlist) then
- k=0
- do i=1,nrep
- do j=1,remd_m(i)
- i2rep(k)=i
- k=k+1
- enddo
- enddo
- elow=elowi(i2rep(me))
- ehigh=ehighi(i2rep(me))
- elowi(me+1)=elow
- ehighi(me+1)=ehigh
- else
- elow=elowi(me+1)
- ehigh=ehighi(me+1)
- endif
- else
- read(89,*) elow,ehigh
- elowi(1)=elow
- ehighi(1)=ehigh
- endif
- i=0
- do while(.true.)
- i=i+1
- read(89,*,end=100) emuca(i),nemuca(i)
-cd nemuca(i)=nemuca(i)*remd_t(me+1)*Rb
- enddo
- 100 continue
- nmuca=i-1
- hbin=emuca(nmuca)-emuca(nmuca-1)
- write (iout,*) 'hbin',hbin
- write (iout,*) me,'elow,ehigh',elow,ehigh
- yp1=0
- ypn=0
- call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2)
- factor_min=0.0d0
- factor_min=muca_factor(ehigh)
- call print_muca
- return
- end
-
-
- subroutine print_muca
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.CONTROL'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision yp1,ypn,yp,x,muca_factor,y,muca_ene
- double precision dummy(maxprocs)
-
- if (remd_mlist) then
- k=0
- do i=1,nrep
- do j=1,remd_m(i)
- i2rep(k)=i
- k=k+1
- enddo
- enddo
- endif
-
- do i=1,nmuca
-c print *,'nemuca ',emuca(i),nemuca(i)
- do j=0,4
- x=emuca(i)+hbin/5*j
- if (modecalc.eq.14) then
- if (remd_mlist) then
- yp=muca_factor(x)*remd_t(i2rep(me))*Rb
- dummy(me+1)=remd_t(i2rep(me))
- y=muca_ene(x,me+1,dummy)
- else
- yp=muca_factor(x)*remd_t(me+1)*Rb
- y=muca_ene(x,me+1,remd_t)
- endif
- write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime,
- & 'muca factor ',x,yp,' muca ene',y
- else
- yp=muca_factor(x)*t_bath*Rb
- dummy(1)=t_bath
- y=muca_ene(x,1,dummy)
- write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime,
- & 'muca factor ',x,yp,' muca ene',y
- endif
- enddo
- enddo
- if(mucadyn.gt.0) then
- do i=1,nmuca
- write(iout,'(a13,i8,2f12.5)') 'nemuca after ',
- & imtime,emuca(i),nemuca(i)
- enddo
- endif
- return
- end
-
- subroutine muca_update(energy)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.CONTROL'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energy
- double precision yp1,ypn
- integer k
- logical lnotend
-
- k=int((energy-emuca(1))/hbin)+1
-
- IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN
- if(energy.ge.ehigh)
- & write (iout,*) 'MUCA reject',energy,emuca(k)
- if(energy.ge.ehigh.and.(energy-ehigh).lt.hbin) then
- write (iout,*) 'MUCA ehigh',energy,emuca(k)
- do i=k,nmuca
- hist(i)=hist(i)+1
- enddo
- endif
- if(k.gt.0.and.energy.lt.ehigh) hist(k)=hist(k)+1
- ELSE
- if(k.gt.0.and.k.lt.4*maxres) hist(k)=hist(k)+1
- ENDIF
- if(mod(imtime,mucadyn).eq.0) then
-
- do i=1,nmuca
- IF(muca_smooth.eq.2.or.muca_smooth.eq.3) THEN
- nemuca(i)=nemuca(i)+dlog(hist(i)+1)
- ELSE
- if (hist(i).gt.0) hist(i)=dlog(hist(i))
- nemuca(i)=nemuca(i)+hist(i)
- ENDIF
- hist(i)=0
- write(iout,'(a24,i8,2f12.5)')'nemuca before smoothing ',
- & imtime,emuca(i),nemuca(i)
- enddo
-
-
- lnotend=.true.
- ismooth=0
- ist=2
- ien=nmuca-1
- IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN
-c lnotend=.false.
-c do i=1,nmuca-1
-c do j=i+1,nmuca
-c if(nemuca(j).lt.nemuca(i)) lnotend=.true.
-c enddo
-c enddo
- do while(lnotend)
- ismooth=ismooth+1
- write (iout,*) 'MUCA update smoothing',ist,ien
- do i=ist,ien
- nemuca(i)=(nemuca(i-1)+nemuca(i)+nemuca(i+1))/3
- enddo
- lnotend=.false.
- ist=0
- ien=0
- do i=1,nmuca-1
- do j=i+1,nmuca
- if(nemuca(j).lt.nemuca(i)) then
- lnotend=.true.
- if(ist.eq.0) ist=i-1
- if(ien.lt.j+1) ien=j+1
- endif
- enddo
- enddo
- enddo
- ENDIF
-
- write (iout,*) 'MUCA update ',imtime,' smooth= ',ismooth
- yp1=0
- ypn=0
- call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2)
- call print_muca
-
- endif
- return
- end
-
- double precision function muca_factor(energy)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- double precision y,yp,energy
-
- if (energy.lt.elow) then
- call splint(emuca,nemuca,nemuca2,nmuca,elow,y,yp)
- elseif (energy.gt.ehigh) then
- call splint(emuca,nemuca,nemuca2,nmuca,ehigh,y,yp)
- else
- call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp)
- endif
-
- if(yp.ge.factor_min) then
- muca_factor=yp
- else
- muca_factor=factor_min
- endif
-cd print *,'energy, muca_factor',energy,muca_factor
- return
- end
-
-
- SUBROUTINE spline(x,y,n,yp1,ypn,y2)
- INTEGER n,NMAX
- REAL*8 yp1,ypn,x(n),y(n),y2(n)
- PARAMETER (NMAX=500)
- INTEGER i,k
- REAL*8 p,qn,sig,un,u(NMAX)
- if (yp1.gt..99e30) then
- y2(1)=0.
- u(1)=0.
- else
- y2(1)=-0.5
- u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
- endif
- do i=2,n-1
- sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
- p=sig*y2(i-1)+2.
- y2(i)=(sig-1.)/p
- u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
- * /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
- enddo
- if (ypn.gt..99e30) then
- qn=0.
- un=0.
- else
- qn=0.5
- un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
- endif
- y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
- do k=n-1,1,-1
- y2(k)=y2(k)*y2(k+1)+u(k)
- enddo
- return
- END
-
-
- SUBROUTINE splint(xa,ya,y2a,n,x,y,yp)
- INTEGER n
- REAL*8 x,y,xa(n),y2a(n),ya(n),yp
- INTEGER k,khi,klo
- REAL*8 a,b,h
- klo=1
- khi=n
- 1 if (khi-klo.gt.1) then
- k=(khi+klo)/2
- if (xa(k).gt.x) then
- khi=k
- else
- klo=k
- endif
- goto 1
- endif
- h=xa(khi)-xa(klo)
- if (h.eq.0.) pause 'bad xa input in splint'
- a=(xa(khi)-x)/h
- b=(x-xa(klo))/h
- y=a*ya(klo)+b*ya(khi)+
- * ((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h**2)/6.
- yp=-ya(klo)/h+ya(khi)/h-3*(a**2)*y2a(klo)*h/6.
- + +(3*(b**2)-1)*y2a(khi)*h/6.
- return
- END
include 'COMMON.INTERACT'
include 'COMMON.HAIRPIN'
include 'COMMON.VAR'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.GEO'
include 'COMMON.CONTROL'
logical nicht_getan,nicht_getan1,fail,lfound
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.HAIRPIN'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
character*50 linia
integer isec(maxres)
C main input file instead, because NO defaults have yet been set for these
C parameters.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.NAMES'
include 'COMMON.SBRIDGE'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
include 'COMMON.SHIELD'
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)
+ double precision blower(3,3,maxlob)
character*3 string
-C dimension b(13)
character*3 lancuch,ucase
character*1000 weightcard
+ character*4 res1
+ integer i,ii,j,jj,k,kk,l,ll,lll,llll,m,mm,n,iblock,junk,ijunk,
+ & nkcctyp,maxinter
+ double precision akl,v0ij,si,rri,epsij,v0ijsccor,epsijlip,rjunk,
+ & sigt2sq,sigt1sq,sigii1,sigii2,ratsig1,ratsig2,rsum_max,r_augm,
+ & rrij,sigeps
+ double precision dwa16
C
C For printing parameters after they are read set the following in the UNRES
C C-shell script:
c write (iout,*) "nloctyp",nloctyp,
c & " iloctyp",(iloctyp(i),i=0,nloctyp)
#ifdef NEWCORR
+ bnew1=0.0d0
+ bnew2=0.0d0
+ ccnew=0.0d0
+ ddnew=0.0d0
+ eenew=0.0d0
+ e0new=0.0d0
do i=0,nloctyp-1
c write (iout,*) "NEWCORR",i
read (ifourier,*,end=115,err=115)
enddo
if (lprint) then
write (iout,'(a)') "Coefficients of the multibody terms"
- do i=-nloctyp+1,nloctyp-1
+c do i=-nloctyp+1,nloctyp-1
+ do i=-nloctyp,nloctyp
write (iout,*) "Type: ",onelet(iloctyp(i))
write (iout,*) "Coefficients of the expansion of B1"
do j=1,2
EEold(2,2,-i)=-b(10,i)+b(11,i)
EEold(2,1,-i)=-b(12,i)+b(13,i)
EEold(1,2,-i)=-b(12,i)-b(13,i)
-c write(iout,*) "TU DOCHODZE"
-c print *,"JESTEM"
+ write(iout,*) "TU DOCHODZE"
+ print *,"JESTEM"
c ee(1,1,i)=1.0d0
c ee(2,2,i)=1.0d0
c ee(2,1,i)=0.0d0
C main input file instead, because NO defaults have yet been set for these
C parameters.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.CONTROL'
include 'COMMON.SHIELD'
character*1000 weightcard
+ integer i,j
+ double precision scalscp,wlong
c
c READ energy-term weights
c
call rescale_weights(t_bath)
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
+ & wtor_d,wstrain,wel_loc,
+#ifdef FOURBODY
+ & wcorr,wcorr5,wcorr6,
+#endif
+ & wsccor,wturn3,
+#ifdef FOURBODY
+ & wturn4,
+#endif
+ & wturn6
22 format (/'Energy-term weights (scaled):'//
& 'WSCC= ',f10.6,' (SC-SC)'/
& 'WSCP= ',f10.6,' (SC-p)'/
& 'WTORD= ',f10.6,' (double torsional)'/
& 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/
& 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/
+#ifdef FOURBODY
& 'WCORR4= ',f10.6,' (multi-body 4th order)'/
& 'WCORR5= ',f10.6,' (multi-body 5th order)'/
& 'WCORR6= ',f10.6,' (multi-body 6th order)'/
- & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/
+#endif
+ & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/
& 'WTURN3= ',f10.6,' (turns, 3rd order)'/
& 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
+#ifdef FOURBODY
+ & 'WTURN6= ',f10.6,' (turns, 6th order)'
+#endif
+ & )
if(me.eq.king.or..not.out1file)
& write (iout,*) "Reference temperature for weights calculation:",
& temp0
double precision function pinorm(x)
- implicit real*8 (a-h,o-z)
+ implicit none
+ double precision x
c
c this function takes an angle (in radians) and puts it in the range of
c -pi to +pi.
subroutine printmat(ldim,m,n,iout,key,a)
+ implicit none
+ integer ldim,m,n,nlim,iout,i,j,k
character*3 key(n)
double precision a(ldim,n)
do 1 i=1,n,8
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
include 'COMMON.VAR'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
integer i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,
& secseg
integer nsep /3/
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
include 'COMMON.VAR'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg
integer nsep /3/
double precision dist,qm
include 'COMMON.INTERACT'
include 'COMMON.VAR'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
integer seg1,seg2,seg3,seg4
logical flag
double precision qwolan(3,0:maxres),cdummy(3,0:maxres2),
subroutine rattle1
c RATTLE algorithm for velocity Verlet - step 1, UNRES
c AL 9/24/04
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
+ include 'COMMON.IOUNITS'
#ifdef RATTLE
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
include 'COMMON.TIME1'
double precision gginv(maxres2,maxres2),
subroutine rattle2
c RATTLE algorithm for velocity Verlet - step 2, UNRES
c AL 9/24/04
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
+ include 'COMMON.IOUNITS'
#ifdef RATTLE
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
subroutine readpdb
C Read the PDB file and convert the peptide geometry into virtual-chain
C geometry.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.LOCAL'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.NAMES'
include 'COMMON.CONTROL'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.SETUP'
include 'COMMON.SBRIDGE'
character*3 seq,atom,res
character*80 card
- dimension sccor(3,50)
+ double precision sccor(3,50)
double precision e1(3),e2(3),e3(3)
integer rescode,iterter(maxres),cou
logical fail
+ integer i,j,iii,ires,ires_old,ishift,ibeg
+ double precision dcj
bfac=0.0d0
do i=1,maxres
iterter(i)=0
end
c---------------------------------------------------------------------------
subroutine int_from_cart(lside,lprn)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.NAMES'
include 'COMMON.CONTROL'
include 'COMMON.SETUP'
+ double precision dist,alpha,beta
character*3 seq,atom,res
character*80 card
- dimension sccor(3,50)
+ double precision sccor(3,50)
integer rescode
logical lside,lprn
+ integer i,j,iti
+ double precision di,cosfac2,sinfac2,cosfac,sinfac
#ifdef MPI
if(me.eq.king.or..not.out1file)then
#endif
end
c-------------------------------------------------------------------------------
subroutine sc_loc_geom(lprn)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.SETUP'
double precision x_prime(3),y_prime(3),z_prime(3)
logical lprn
+ integer i,j,it
+ double precision xx,yy,zz,cosfac,cosfac2,sinfac,sinfac2
do i=1,nres-1
do j=1,3
dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i))
end
c---------------------------------------------------------------------------
subroutine sccenter(ires,nscat,sccor)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
- dimension sccor(3,50)
+ integer i,j,ires,nscat
+ double precision sccor(3,50)
+ double precision sccmj
do j=1,3
sccmj=0.0D0
do i=1,nscat
end
c---------------------------------------------------------------------------
subroutine bond_regular
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.LOCAL'
- include 'COMMON.CALC'
include 'COMMON.INTERACT'
include 'COMMON.CHAIN'
+ integer i,i1,i2
do i=1,nres-1
vbld(i+1)=vbl
vbld_inv(i+1)=vblinv
subroutine readpdb_template(k)
C Read the PDB file for read_constr_homology with read2sigma
C and convert the peptide geometry into virtual-chain geometry.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.LOCAL'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.NAMES'
include 'COMMON.CONTROL'
- include 'COMMON.DISTFIT'
+ include 'COMMON.FRAG'
include 'COMMON.SETUP'
- integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity,
- & ishift_pdb
+ integer i,j,k,ibeg,ishift1,ires,iii,ires_old,ishift,ity,
+ & ishift_pdb,ires_ca
logical lprn /.false./,fail
double precision e1(3),e2(3),e3(3)
double precision dcj,efree_temp
subroutine readrtns
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.SBRIDGE'
include 'COMMON.IOUNITS'
include 'COMMON.SPLITELE'
+ integer i,j
logical file_exist
C Read job setup parameters
call read_control
C
C Read contorl data
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MP
include 'mpif.h'
logical OKRandom, prng_restart
- real*8 r1
+ double precision r1
#endif
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
include 'COMMON.THREAD'
include 'COMMON.SBRIDGE'
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.MCM'
include 'COMMON.MAP'
include 'COMMON.HEADER'
include 'COMMON.SPLITELE'
include 'COMMON.SHIELD'
include 'COMMON.GEO'
+ integer i
+ integer KDIAG,ICORFL,IXDR
COMMON /MACHSW/ KDIAG,ICORFL,IXDR
character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/
character*80 ucase
character*320 controlcard
+ double precision seed
nglob_csa=0
eglob_csa=1d99
call random_init(seed)
C Set up the time limit (caution! The time must be input in minutes!)
read_cart=index(controlcard,'READ_CART').gt.0
+ out_cart=index(controlcard,'OUT_CART').gt.0
+ out_int=index(controlcard,'OUT_INT').gt.0
+ gmatout=index(controlcard,'GMATOUT').gt.0
call readi(controlcard,'CONSTR_DIST',constr_dist,0)
C this variable with_theta_constr is the variable which allow to read and execute the
C constrains on theta angles WITH_THETA_CONSTR is the keyword
call reada(controlcard,'TIMLIM',timlim,2800.0D0) ! default 16 hours
unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes
- call reada(controlcard,'RMSDBC',rmsdbc,3.0D0)
- call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0)
- call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0)
- call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0)
- call reada(controlcard,'DRMS',drms,0.1D0)
- if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
- write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc
- write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1
- write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max
- write (iout,'(a,f10.1)')'DRMS = ',drms
- write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm
- write (iout,'(a,f10.1)') 'Time limit (min):',timlim
- endif
+c call reada(controlcard,'RMSDBC',rmsdbc,3.0D0)
+c call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0)
+c call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0)
+c call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0)
+c call reada(controlcard,'DRMS',drms,0.1D0)
+c if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+c write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc
+c write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1
+c write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max
+c write (iout,'(a,f10.1)')'DRMS = ',drms
+cc write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm
+c write (iout,'(a,f10.1)') 'Time limit (min):',timlim
+c endif
call readi(controlcard,'NZ_START',nz_start,0)
call readi(controlcard,'NZ_END',nz_end,0)
c call readi(controlcard,'IZ_SC',iz_sc,0)
timlim=60.0D0*timlim
safety = 60.0d0*safety
- timem=timlim
modecalc=0
call reada(controlcard,"T_BATH",t_bath,300.0d0)
minim=(index(controlcard,'MINIMIZE').gt.0)
call reada(controlcard,'BOXX',boxxsize,100.0d0)
call reada(controlcard,'BOXY',boxysize,100.0d0)
call reada(controlcard,'BOXZ',boxzsize,100.0d0)
+ write(iout,*) "Periodic box dimensions",boxxsize,boxysize,boxzsize
c Cutoff range for interactions
- call reada(controlcard,"R_CUT",r_cut,15.0d0)
+ call reada(controlcard,"R_CUT_INT",r_cut_int,25.0d0)
+ call reada(controlcard,"R_CUT_RESPA",r_cut_respa,2.0d0)
call reada(controlcard,"LAMBDA",rlamb,0.3d0)
+ write (iout,*) "Cutoff on interactions",r_cut_int
+ write (iout,*)
+ & "Cutoff in switching short and long range interactions in RESPA",
+ & r_cut_respa
+ write (iout,*) "lambda in switch function",rlamb
call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
if (lipthick.gt.0.0d0) then
buftubebot=bordtubebot+tubebufthick
buftubetop=bordtubetop-tubebufthick
endif
-c if (shield_mode.gt.0) then
-c pi=3.141592d0
-C VSolvSphere the volume of solving sphere
-C print *,pi,"pi"
-C rpp(1,1) is the energy r0 for peptide group contact and will be used for it
-C there will be no distinction between proline peptide group and normal peptide
-C group in case of shielding parameters
-c write (iout,*) "rpp(1,1)",rpp(1,1)," pi",pi
-c VSolvSphere=4.0/3.0*pi*rpp(1,1)**3
-c VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3
-c write (iout,*) "VSolvSphere",VSolvSphere,"VSolvSphere_div",
-c & VSolvSphere_div
-C long axis of side chain
-c do i=1,ntyp
-c long_r_sidechain(i)=vbldsc0(1,i)
-c short_r_sidechain(i)=sigma0(i)
-c enddo
-c buff_shield=1.0d0
-c endif
if (me.eq.king .or. .not.out1file )
& write (iout,*) "DISTCHAINMAX",distchainmax
C
C Read REMD settings
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.INTERACT'
include 'COMMON.NAMES'
include 'COMMON.GEO'
character*80 ucase
character*320 controlcard
character*3200 controlcard1
- integer iremd_m_total
+ integer iremd_m_total,i
if(me.eq.king.or..not.out1file)
& write (iout,*) "REMD setup"
C
C Read MD settings
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.INTERACT'
include 'COMMON.NAMES'
include 'COMMON.GEO'
include 'COMMON.FFIELD'
character*80 ucase
character*320 controlcard
+ integer i
+ double precision eta
call card_concat(controlcard)
call readi(controlcard,"NSTEP",n_timestep,1000000)
& "A-MTS algorithm used; initial time step for fast-varying",
& " short-range forces split into",ntime_split," steps."
write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff",
- & r_cut," lambda",rlamb
+ & r_cut_respa," lambda",rlamb
endif
write (iout,'(2a,f10.5)')
& "Maximum acceleration threshold to reduce the time step",
C
C Read molecular data.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
- integer error_msg
+ integer error_msg,ierror,ierr,ierrcode
#endif
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.SBRIDGE'
include 'COMMON.HEADER'
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.DBASE'
include 'COMMON.THREAD'
include 'COMMON.CONTACTS'
character*256 pdbfile
character*400 weightcard
character*80 weightcard_t,ucase
- dimension itype_pdb(maxres)
+ integer itype_pdb(maxres)
common /pizda/ itype_pdb
logical seq_comp,fail
double precision energia(0:n_ene)
double precision secprob(3,maxdih_constr)
+ double precision co
+ double precision phihel,phibet,sigmahel,sigmabet
+ integer iti,nsi,maxsi
integer ilen
external ilen
- integer tperm
+ integer iperm,tperm
+ integer i,j,ii,k,l,itrial,itmp,i1,i2,it1,it2
+ double precision sumv
C
C Read PDB structure if applicable
C
do i=1,nres
itype(i)=rescode(i,sequence(i),iscode)
enddo
-C Assign initial virtual bond lengths
-c do i=2,nres
-c vbld(i)=vbl
-c vbld_inv(i)=vblinv
-c enddo
-c if (itype(1).eq.ntyp1) then
-c vbld(2)=vbld(2)/2
-c vbld_inv(2)=vbld_inv(2)*2
-c endif
-c if (itype(nres).eq.ntyp1) then
-c vbld(nres)=vbld(nres)/2
-c vbld_inv(nres)=vbld_inv(nres)*2
-c endif
-c do i=2,nres-1
-c vbld(i+nres)=dsc(iabs(itype(i)))
-c vbld_inv(i+nres)=dsc_inv(iabs(itype(i)))
-c write (iout,*) "i",i," itype",itype(i),
-c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres)
-c enddo
endif
c print *,nres
c print '(20i4)',(itype(i),i=1,nres)
cd print *,'NNT=',NNT,' NCT=',NCT
call seq2chains(nres,itype,nchain,chain_length,chain_border,
& ireschain)
+ chain_border1(1,1)=1
+ chain_border1(2,1)=chain_border(2,1)+1
+ do i=2,nchain-1
+ chain_border1(1,i)=chain_border(1,i)-1
+ chain_border1(2,i)=chain_border(2,i)+1
+ enddo
+ chain_border1(1,nchain)=chain_border(1,nchain)-1
+ chain_border1(2,nchain)=nres
write(iout,*) "nres",nres," nchain",nchain
do i=1,nchain
write(iout,*)"chain",i,chain_length(i),chain_border(1,i),
- & chain_border(2,i)
+ & chain_border(2,i),chain_border1(1,i),chain_border1(2,i)
enddo
call chain_symmetry(nchain,nres,itype,chain_border,
& chain_length,npermchain,tabpermchain)
do i=1,nres
write(iout,*) i,(iperm(i,ii),ii=1,npermchain)
enddo
+ call flush(iout)
if (itype(1).eq.ntyp1) nnt=2
if (itype(nres).eq.ntyp1) nct=nct-1
+ write (iout,*) "nnt",nnt," nct",nct
+ call flush(iout)
#ifdef DFA
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
c-----------------------------------------------------------------------------
subroutine read_bridge
C Read information about disulfide bridges.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
+ integer ierror
#endif
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.THREAD'
include 'COMMON.TIME1'
include 'COMMON.SETUP'
+ integer i,j
C Read bridging residues.
read (inp,*) ns,(iss(i),i=1,ns)
print *,'ns=',ns
enddo
write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.'
20 continue
- dhpb(i)=dbr
- forcon(i)=fbr
+c dhpb(i)=dbr
+c forcon(i)=fbr
enddo
do i=1,nss
ihpb(i)=ihpb(i)+nres
end
c----------------------------------------------------------------------------
subroutine read_x(kanal,*)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.CONTROL'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
+ integer i,j,k,l,kanal
c Read coordinates from input
c
read(kanal,'(8f10.5)',end=10,err=10)
end
c----------------------------------------------------------------------------
subroutine read_threadbase
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.DBASE'
include 'COMMON.THREAD'
include 'COMMON.TIME1'
+ integer i,j,k
+ double precision dist
C Read pattern database for threading.
read (icbase,*) nseq
do i=1,nseq
end
c------------------------------------------------------------------------------
subroutine setup_var
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.DBASE'
include 'COMMON.THREAD'
include 'COMMON.TIME1'
+ integer i
C Set up variable list.
ntheta=nres-2
nphi=nres-3
nvar=ntheta+nphi
nside=0
- write (iout,*) "SETUP_VAR ialph"
do i=2,nres-1
if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
- nside=nside+1
+ nside=nside+1
ialph(i,1)=nvar+nside
- ialph(nside,2)=i
+ ialph(nside,2)=i
endif
enddo
if (indphi.gt.0) then
else
nvar=nvar+2*nside
endif
- write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1)
return
end
c----------------------------------------------------------------------------
subroutine gen_dist_constr
C Generate CA distance constraints.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.DBASE'
include 'COMMON.THREAD'
include 'COMMON.TIME1'
- dimension itype_pdb(maxres)
+ integer i,j,itype_pdb(maxres)
common /pizda/ itype_pdb
+ double precision dist
character*2 iden
cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct
cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct,
end
c----------------------------------------------------------------------------
subroutine map_read
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.MAP'
include 'COMMON.IOUNITS'
+ integer imap
character*3 angid(4) /'THE','PHI','ALP','OME'/
character*80 mapcard,ucase
do imap=1,nmap
end
c----------------------------------------------------------------------------
subroutine csaread
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
return
end
c----------------------------------------------------------------------------
-cfmc subroutine mcmfread
-cfmc implicit real*8 (a-h,o-z)
-cfmc include 'DIMENSIONS'
-cfmc include 'COMMON.MCMF'
-cfmc include 'COMMON.IOUNITS'
-cfmc include 'COMMON.GEO'
-cfmc character*80 ucase
-cfmc character*620 mcmcard
-cfmc call card_concat(mcmcard)
-cfmc
-cfmc call readi(mcmcard,'MAXRANT',maxrant,1000)
-cfmc write(iout,*)'MAXRANT=',maxrant
-cfmc call readi(mcmcard,'MAXFAM',maxfam,maxfam_p)
-cfmc write(iout,*)'MAXFAM=',maxfam
-cfmc call readi(mcmcard,'NNET1',nnet1,5)
-cfmc write(iout,*)'NNET1=',nnet1
-cfmc call readi(mcmcard,'NNET2',nnet2,4)
-cfmc write(iout,*)'NNET2=',nnet2
-cfmc call readi(mcmcard,'NNET3',nnet3,4)
-cfmc write(iout,*)'NNET3=',nnet3
-cfmc call readi(mcmcard,'ILASTT',ilastt,0)
-cfmc write(iout,*)'ILASTT=',ilastt
-cfmc call readi(mcmcard,'MAXSTR',maxstr,maxstr_mcmf)
-cfmc write(iout,*)'MAXSTR=',maxstr
-cfmc maxstr_f=maxstr/maxfam
-cfmc write(iout,*)'MAXSTR_F=',maxstr_f
-cfmc call readi(mcmcard,'NMCMF',nmcmf,10)
-cfmc write(iout,*)'NMCMF=',nmcmf
-cfmc call readi(mcmcard,'IFOCUS',ifocus,nmcmf)
-cfmc write(iout,*)'IFOCUS=',ifocus
-cfmc call readi(mcmcard,'NLOCMCMF',nlocmcmf,1000)
-cfmc write(iout,*)'NLOCMCMF=',nlocmcmf
-cfmc call readi(mcmcard,'INTPRT',intprt,1000)
-cfmc write(iout,*)'INTPRT=',intprt
-cfmc call readi(mcmcard,'IPRT',iprt,100)
-cfmc write(iout,*)'IPRT=',iprt
-cfmc call readi(mcmcard,'IMAXTR',imaxtr,100)
-cfmc write(iout,*)'IMAXTR=',imaxtr
-cfmc call readi(mcmcard,'MAXEVEN',maxeven,1000)
-cfmc write(iout,*)'MAXEVEN=',maxeven
-cfmc call readi(mcmcard,'MAXEVEN1',maxeven1,3)
-cfmc write(iout,*)'MAXEVEN1=',maxeven1
-cfmc call readi(mcmcard,'INIMIN',inimin,200)
-cfmc write(iout,*)'INIMIN=',inimin
-cfmc call readi(mcmcard,'NSTEPMCMF',nstepmcmf,10)
-cfmc write(iout,*)'NSTEPMCMF=',nstepmcmf
-cfmc call readi(mcmcard,'NTHREAD',nthread,5)
-cfmc write(iout,*)'NTHREAD=',nthread
-cfmc call readi(mcmcard,'MAXSTEPMCMF',maxstepmcmf,2500)
-cfmc write(iout,*)'MAXSTEPMCMF=',maxstepmcmf
-cfmc call readi(mcmcard,'MAXPERT',maxpert,9)
-cfmc write(iout,*)'MAXPERT=',maxpert
-cfmc call readi(mcmcard,'IRMSD',irmsd,1)
-cfmc write(iout,*)'IRMSD=',irmsd
-cfmc call reada(mcmcard,'DENEMIN',denemin,0.01D0)
-cfmc write(iout,*)'DENEMIN=',denemin
-cfmc call reada(mcmcard,'RCUT1S',rcut1s,3.5D0)
-cfmc write(iout,*)'RCUT1S=',rcut1s
-cfmc call reada(mcmcard,'RCUT1E',rcut1e,2.0D0)
-cfmc write(iout,*)'RCUT1E=',rcut1e
-cfmc call reada(mcmcard,'RCUT2S',rcut2s,0.5D0)
-cfmc write(iout,*)'RCUT2S=',rcut2s
-cfmc call reada(mcmcard,'RCUT2E',rcut2e,0.1D0)
-cfmc write(iout,*)'RCUT2E=',rcut2e
-cfmc call reada(mcmcard,'DPERT1',d_pert1,180.0D0)
-cfmc write(iout,*)'DPERT1=',d_pert1
-cfmc call reada(mcmcard,'DPERT1A',d_pert1a,180.0D0)
-cfmc write(iout,*)'DPERT1A=',d_pert1a
-cfmc call reada(mcmcard,'DPERT2',d_pert2,90.0D0)
-cfmc write(iout,*)'DPERT2=',d_pert2
-cfmc call reada(mcmcard,'DPERT2A',d_pert2a,45.0D0)
-cfmc write(iout,*)'DPERT2A=',d_pert2a
-cfmc call reada(mcmcard,'DPERT2B',d_pert2b,90.0D0)
-cfmc write(iout,*)'DPERT2B=',d_pert2b
-cfmc call reada(mcmcard,'DPERT2C',d_pert2c,60.0D0)
-cfmc write(iout,*)'DPERT2C=',d_pert2c
-cfmc d_pert1=deg2rad*d_pert1
-cfmc d_pert1a=deg2rad*d_pert1a
-cfmc d_pert2=deg2rad*d_pert2
-cfmc d_pert2a=deg2rad*d_pert2a
-cfmc d_pert2b=deg2rad*d_pert2b
-cfmc d_pert2c=deg2rad*d_pert2c
-cfmc call reada(mcmcard,'KT_MCMF1',kt_mcmf1,1.0D0)
-cfmc write(iout,*)'KT_MCMF1=',kt_mcmf1
-cfmc call reada(mcmcard,'KT_MCMF2',kt_mcmf2,1.0D0)
-cfmc write(iout,*)'KT_MCMF2=',kt_mcmf2
-cfmc call reada(mcmcard,'DKT_MCMF1',dkt_mcmf1,10.0D0)
-cfmc write(iout,*)'DKT_MCMF1=',dkt_mcmf1
-cfmc call reada(mcmcard,'DKT_MCMF2',dkt_mcmf2,1.0D0)
-cfmc write(iout,*)'DKT_MCMF2=',dkt_mcmf2
-cfmc call reada(mcmcard,'RCUTINI',rcutini,3.5D0)
-cfmc write(iout,*)'RCUTINI=',rcutini
-cfmc call reada(mcmcard,'GRAT',grat,0.5D0)
-cfmc write(iout,*)'GRAT=',grat
-cfmc call reada(mcmcard,'BIAS_MCMF',bias_mcmf,0.0D0)
-cfmc write(iout,*)'BIAS_MCMF=',bias_mcmf
-cfmc
-cfmc return
-cfmc end
-c----------------------------------------------------------------------------
subroutine mcmread
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.MCM'
include 'COMMON.MCE'
include 'COMMON.IOUNITS'
character*80 ucase
character*320 mcmcard
+ integer i
call card_concat(mcmcard)
call readi(mcmcard,'MAXACC',maxacc,100)
call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000)
end
c----------------------------------------------------------------------------
subroutine read_minim
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.MINIM'
include 'COMMON.IOUNITS'
end
c----------------------------------------------------------------------------
subroutine read_angles(kanal,*)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
+ integer i,kanal
c Read angles from input
c
read (kanal,*,err=10,end=10) (theta(i),i=3,nres)
end
c----------------------------------------------------------------------------
subroutine openunits
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
+ integer ierror
character*16 form,nodename
integer nodelen
#endif
include 'COMMON.IOUNITS'
include 'COMMON.MD'
include 'COMMON.CONTROL'
- integer lenpre,lenpot,ilen,lentmp
+ integer lenpre,lenpot,ilen,lentmp,npos
external ilen
character*3 out1file_text,ucase
character*3 ll
card=card(:ilen(card)+1)//karta
return
end
-c----------------------------------------------------------------------------------
+c------------------------------------------------------------------------------
subroutine readrst
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
+ include 'COMMON.CONTROL'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
+ integer i,j
open(irest2,file=rest2name,status='unknown')
read(irest2,*) totT,EK,potE,totE,t_bath
totTafm=totT
close(irest2)
return
end
-c---------------------------------------------------------------------------------
+c------------------------------------------------------------------------------
subroutine read_fragments
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.CONTROL'
+ integer i
read(inp,*) nset,nfrag,npair,nfrag_back
loc_qlike=(nfrag_back.lt.0)
nfrag_back=iabs(nfrag_back)
end
C---------------------------------------------------------------------------
subroutine read_afminp
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.IOUNITS'
include 'COMMON.SBRIDGE'
character*320 afmcard
- print *, "wchodze"
+ integer i
+c print *, "wchodze"
call card_concat(afmcard)
call readi(afmcard,"BEG",afmbeg,0)
call readi(afmcard,"END",afmend,0)
distafminit=(c(i,afmend)-c(i,afmbeg))**2+distafminit
enddo
distafminit=dsqrt(distafminit)
- print *,'initdist',distafminit
+c print *,'initdist',distafminit
return
end
c-------------------------------------------------------------------------------
subroutine read_saxs_constr
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
#endif
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.SBRIDGE'
- double precision cm(3)
+ double precision cm(3),cnorm
+ integer i,j
c read(inp,*) nsaxs
write (iout,*) "Calling read_saxs nsaxs",nsaxs
call flush(iout)
c-------------------------------------------------------------------------------
subroutine read_dist_constr
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.IOUNITS'
include 'COMMON.SBRIDGE'
include 'COMMON.INTERACT'
- integer ifrag_(2,100),ipair_(2,1000)
+ integer i,j,k,ii,jj,itemp,link_type,iiend,jjend,kk
+ integer nfrag_,npair_,ndist_,ifrag_(2,100),ipair_(2,1000)
double precision wfrag_(100),wpair_(1000)
+ double precision ddjk,dist,dist_cut,fordepthmax
character*5000 controlcard
logical normalize,next
integer restr_type
end
c-------------------------------------------------------------------------------
subroutine read_constr_homology
-
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
#endif
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
+ include 'COMMON.HOMOLOGY'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.GEO'
include 'COMMON.INTERACT'
include 'COMMON.NAMES'
character*2 kic2
character*24 model_ki_dist, model_ki_angle
character*500 controlcard
- integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp
+ integer ki,i,ii,j,k,l,ii_in_use(maxdim),i_tmp,idomain_tmp,irec,
+ & ik,iistart,iishift
integer ilen
external ilen
logical liiflag
double precision, dimension (max_template,maxres) :: rescore
double precision, dimension (max_template,maxres) :: rescore2
double precision, dimension (max_template,maxres) :: rescore3
+ double precision distal
character*24 pdbfile,tpl_k_rescore
c -----------------------------------------------------------------
c Reading multiple PDB ref structures and calculation of retraints
#endif
c------------------------------------------------------------------------------
subroutine copy_to_tmp(source)
+ implicit none
include "DIMENSIONS"
include "COMMON.IOUNITS"
character*(*) source
end
c------------------------------------------------------------------------------
subroutine move_from_tmp(source)
+ implicit none
include "DIMENSIONS"
include "COMMON.IOUNITS"
character*(*) source
C
C Initialize random number generator
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
logical OKRandom, prng_restart
real*8 r1
integer iseed_array(4)
+ integer error_msg,ierr
#endif
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
include 'COMMON.MD'
include 'COMMON.FFIELD'
include 'COMMON.SETUP'
+ integer i,iseed
+ double precision seed,ran_number
iseed=-dint(dabs(seed))
if (iseed.eq.0) then
write (iout,'(/80(1h*)/20x,a/80(1h*))')
end
c----------------------------------------------------------------------
subroutine read_klapaucjusz
-
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
#endif
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
+ include 'COMMON.HOMOLOGY'
include 'COMMON.CHAIN'
include 'COMMON.IOUNITS'
include 'COMMON.MD'
include 'COMMON.NAMES'
character*256 fragfile
integer ninclust(maxclust),inclust(max_template,maxclust),
- & nresclust(maxclust),iresclust(maxres,maxclust)
+ & nresclust(maxclust),iresclust(maxres,maxclust),nclust
character*2 kic2
character*24 model_ki_dist, model_ki_angle
character*500 controlcard
- integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp
+ integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp,
+ & ik,ll,ii,kk,iistart,iishift,lim_xx
+ double precision distal
logical lprn /.true./
integer ilen
external ilen
enddo
enddo
call int_from_cart(.true.,.false.)
- call sc_loc_geom(.true.)
+ call sc_loc_geom(.false.)
do i=1,nres
thetaref(i)=theta(i)
phiref(i)=phi(i)
integer function rescode(iseq,nam,itype)
- implicit real*8 (a-h,o-z)
+ implicit none
+ integer iseq,itype,i
include 'DIMENSIONS'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
double precision orig_w(n_ene)
double precision wtime
-
+ sideonly=.true.
c Set non side-chain weights to zero (minimization is faster)
c NOTE: e(2) does not actually depend on the side-chain, only CA
orig_w(2)=wscp
wtor=orig_w(13)
wtor_d=orig_w(14)
wvdwpp=orig_w(15)
-
+ sideonly=.false.
+ mask_side=1
crc n_fun=n_fun+1
ct write (iout,*) 'sc_local time= ',MPI_WTIME()-wtime
return
nres_moved=0
do i=2,nres-1
c Don't do glycine (itype(j)==10)
- if (itype(i).ne.10) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
sc_dist=dist(nres+i,nres+res_pick)
else
sc_dist=sc_dist_cutoff
endif
enddo
- call chainbuild
+ call chainbuild_extconf
call egb1(evdw)
call esc(escloc)
e_sc=wsc*evdw+wscloc*escloc
+c write (iout,*) "sc_move: e_sc",e_sc
cd call etotal(energy)
cd print *,'new ',(energy(k),k=0,n_ene)
orig_e=e_sc
crc enddo
call minimize_sc1(e_sc,var,iretcode,loc_nfun)
-
+c write (iout,*) "n_try",n_try
+c write (iout,*) "sc_move after minimze_sc1 e_sc",e_sc
cv write(*,'(2i3,2f12.5,2i3)')
cv & res_pick,nres_moved,orig_e,e_sc-cur_e,
cv & iretcode,loc_nfun
return
end
-
-c-------------------------------------------------------------
-
- subroutine sc_minimize(etot,iretcode,nfun)
-c Minimizes side-chains only, leaving backbone frozen
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
-
-c Output arguments
- double precision etot
- integer iretcode,nfun
-
-c Local variables
- integer i
- double precision orig_w(n_ene),energy(0:n_ene)
- double precision var(maxvar)
-
-
-c Set non side-chain weights to zero (minimization is faster)
-c NOTE: e(2) does not actually depend on the side-chain, only CA
- orig_w(2)=wscp
- orig_w(3)=welec
- orig_w(4)=wcorr
- orig_w(5)=wcorr5
- orig_w(6)=wcorr6
- orig_w(7)=wel_loc
- orig_w(8)=wturn3
- orig_w(9)=wturn4
- orig_w(10)=wturn6
- orig_w(11)=wang
- orig_w(13)=wtor
- orig_w(14)=wtor_d
-
- wscp=0.D0
- welec=0.D0
- wcorr=0.D0
- wcorr5=0.D0
- wcorr6=0.D0
- wel_loc=0.D0
- wturn3=0.D0
- wturn4=0.D0
- wturn6=0.D0
- wang=0.D0
- wtor=0.D0
- wtor_d=0.D0
-
-c Prepare to freeze backbone
- do i=1,nres
- mask_phi(i)=0
- mask_theta(i)=0
- mask_side(i)=1
- enddo
-
-c Minimize the side-chains
- mask_r=.true.
- call geom_to_var(nvar,var)
- call minimize(etot,var,iretcode,nfun)
- call var_to_geom(nvar,var)
- mask_r=.false.
-
-c Put the original weights back and calculate the full energy
- wscp=orig_w(2)
- welec=orig_w(3)
- wcorr=orig_w(4)
- wcorr5=orig_w(5)
- wcorr6=orig_w(6)
- wel_loc=orig_w(7)
- wturn3=orig_w(8)
- wturn4=orig_w(9)
- wturn6=orig_w(10)
- wang=orig_w(11)
- wtor=orig_w(13)
- wtor_d=orig_w(14)
-
- call chainbuild
- call etotal(energy)
- etot=energy(0)
-
- return
- end
-
c-------------------------------------------------------------
subroutine minimize_sc1(etot,x,iretcode,nfun)
+#ifdef LBFGS_SC
+ use minima
+ use inform
+ use output
+ use iounit
+ use scales
+#endif
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
- parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+#ifndef LBFGS_SC
+c parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+ parameter(max_sc_move=10)
+ parameter (liv=60,lv=(77+2*max_sc_move*(2*max_sc_move+17)/2))
+#endif
include 'COMMON.IOUNITS'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.MINIM'
common /srutu/ icall
- dimension iv(liv)
- double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar)
+ double precision x(maxvar),d(maxvar),xx(maxvar)
double precision energia(0:n_ene)
+#ifdef LBFGS_SC
+ integer nvar_restr
+ common /zmienne/ nvar_restr
+ double precision grdmin
+ double precision funcgrad_restr1
+ external funcgrad_restr1
+ external optsave
+#else
external func,gradient,fdum
external func_restr1,grad_restr1
logical not_done,change,reduce
+ dimension iv(liv)
+ double precision v(1:lv)
common /przechowalnia/ v
-
+#endif
+#ifdef LBFGS_SC
+ maxiter=7
+ coordtype='RIGIDBODY'
+ grdmin=tolf
+ jout=iout
+c jprint=print_min_stat
+ jprint=0
+ iwrite=0
+ if (.not. allocated(scale)) allocate (scale(nvar))
+c
+c set scaling parameter for function and derivative values;
+c use square root of median eigenvalue of typical Hessian
+c
+ call x2xx(x,xx,nvar_restr)
+ set_scale = .true.
+c nvar = 0
+ do i = 1, nvar_restr
+c if (use(i)) then
+c do j = 1, 3
+c nvar = nvar + 1
+ scale(i) = 12.0d0
+c end do
+c end if
+ end do
+c write (iout,*) "Calling lbfgs"
+ call lbfgs (nvar_restr,xx,etot,grdmin,funcgrad_restr1,optsave)
+ deallocate(scale)
+c write (iout,*) "After lbfgs"
+ call xx2x(x,xx)
+#else
call deflt(2,iv,liv,lv,v)
* 12 means fresh start, dont call deflt
iv(1)=12
* controls output
iv(19)=2
* selects output unit
-c iv(21)=iout
iv(21)=0
+c iv(21)=0
* 1 means to print out result
iv(22)=0
* 1 means to print out summary stats
& iv,liv,lv,v,idum,rdum,fdum)
call xx2x(x,xx)
ELSE
- call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
+c call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
ENDIF
etot=v(10)
iretcode=iv(1)
nfun=iv(6)
-
+#endif
return
end
+#ifdef LBFGS_SC
+ double precision function funcgrad_restr1(x,g)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.DERIV'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.FFIELD'
+ include 'COMMON.INTERACT'
+ include 'COMMON.TIME1'
+ include 'COMMON.CHAIN'
+ include 'COMMON.VAR'
+ integer nvar_restr
+ common /zmienne/ nvar_restr
+ double precision energia(0:n_ene),evdw,escloc
+ double precision ufparm,e1,e2
+ dimension x(maxvar),g(maxvar),gg(maxvar)
+#ifdef OSF
+c Intercept NaNs in the coordinates, before calling etotal
+ x_sum=0.D0
+ do i=1,nvar_restr
+ x_sum=x_sum+x(i)
+ enddo
+ FOUND_NAN=.false.
+ if (x_sum.ne.x_sum) then
+ write(iout,*)" *** func_restr1 : Found NaN in coordinates"
+ f=1.0D+73
+ FOUND_NAN=.true.
+ return
+ endif
+#else
+ FOUND_NAN=.false.
+ do i=1,nvar_restr
+ if (isnan(x(i))) then
+ FOUND_NAN=.true.
+ f=1.0D+73
+ funcgrad_restr1=f
+ write (iout,*) "NaN in coordinates"
+ return
+ endif
+ enddo
+#endif
+
+c write (iout,*) "nvar_restr",nvar_restr
+c write (iout,*) "x",(x(i),i=1,nvar_restr)
+ call var_to_geom_restr(nvar_restr,x)
+ call zerograd
+ call chainbuild_extconf
+cd write (iout,*) 'ETOTAL called from FUNC'
+ call egb1(evdw)
+ call esc(escloc)
+ f=wsc*evdw+wscloc*escloc
+c write (iout,*) "evdw",evdw," escloc",escloc
+ if (isnan(f)) then
+ f=1.0d20
+ funcgrad_restr1=f
+ return
+ endif
+ funcgrad_restr1=f
+c write (iout,*) "f",f
+cd call etotal(energia(0))
+cd f=wsc*energia(1)+wscloc*energia(12)
+cd print *,f,evdw,escloc,energia(0)
+C
+C Sum up the components of the Cartesian gradient.
+C
+ do i=1,nct
+ do j=1,3
+ gradx(j,i,icg)=wsc*gvdwx(j,i)+wscloc*gsclocx(j,i)
+ enddo
+ enddo
+
+C
+C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
+C
+ call cart2intgrad(nvar,gg)
+C
+C Convert the Cartesian gradient into internal-coordinate gradient.
+C
+
+ ig=0
+ do i=2,nres-1
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ IF (mask_side(i).eq.1) THEN
+ ig=ig+1
+ g(ig)=gg(ialph(i,1))
+c write (iout,*) "i",i," ig",ig," ialph",ialph(i,1)
+c write (iout,*) "g",g(ig)," gg",gg(ialph(i,1))
+ ENDIF
+ endif
+ enddo
+ do i=2,nres-1
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ IF (mask_side(i).eq.1) THEN
+ ig=ig+1
+ g(ig)=gg(ialph(i,1)+nside)
+c write (iout,*) "i",i," ig",ig," ialph",ialph(i,1)+nside
+c write (iout,*) "g",g(ig)," gg",gg(ialph(i,1)+nside)
+ ENDIF
+ endif
+ enddo
+
+C
+C Add the components corresponding to local energy terms.
+C
+
+ ig=0
+ igall=0
+ do i=4,nres
+ igall=igall+1
+ if (mask_phi(i).eq.1) then
+ ig=ig+1
+ g(ig)=g(ig)+gloc(igall,icg)
+ endif
+ enddo
+
+ do i=3,nres
+ igall=igall+1
+ if (mask_theta(i).eq.1) then
+ ig=ig+1
+ g(ig)=g(ig)+gloc(igall,icg)
+ endif
+ enddo
+
+ do ij=1,2
+ do i=2,nres-1
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+ igall=igall+1
+ if (mask_side(i).eq.1) then
+ ig=ig+1
+ g(ig)=g(ig)+gloc(igall,icg)
+c write (iout,*) "ij",ij," i",i," ig",ig," igall",igall
+c write (iout,*) "gloc",gloc(igall,icg)," g",g(ig)
+ endif
+ endif
+ enddo
+ enddo
+
+cd do i=1,ig
+cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
+cd enddo
+ return
+ end
+#else
************************************************************************
subroutine func_restr1(n,x,nf,f,uiparm,urparm,ufparm)
implicit real*8 (a-h,o-z)
include 'COMMON.FFIELD'
include 'COMMON.INTERACT'
include 'COMMON.TIME1'
- common /chuju/ jjj
double precision energia(0:n_ene),evdw,escloc
- integer jjj
double precision ufparm,e1,e2
external ufparm
integer uiparm(1)
call var_to_geom_restr(n,x)
call zerograd
- call chainbuild
+ call chainbuild_extconf
cd write (iout,*) 'ETOTAL called from FUNC'
call egb1(evdw)
call esc(escloc)
f=wsc*evdw+wscloc*escloc
+c write (iout,*) "f",f
cd call etotal(energia(0))
cd f=wsc*energia(1)+wscloc*energia(12)
cd print *,f,evdw,escloc,energia(0)
C
do i=1,nct
do j=1,3
- gradx(j,i,icg)=wsc*gvdwx(j,i)
+ gradx(j,i,icg)=wsc*gvdwx(j,i)+wscloc*gsclocx(j,i)
enddo
enddo
external ufparm
integer uiparm(1)
double precision urparm(1)
- dimension x(maxvar),g(maxvar)
+ dimension x(maxvar),g(maxvar),gg(maxvar)
icg=mod(nf,2)+1
if (nf-nfl+1) 20,30,40
if (nf.eq.0) return
goto 40
30 call var_to_geom_restr(n,x)
- call chainbuild
+ call chainbuild_extconf
C
C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
C
- 40 call cartder
+ 40 call cart2intgrad(nvar,gg)
C
C Convert the Cartesian gradient into internal-coordinate gradient.
C
ig=0
- ind=nres-2
+ ind=nres-2
do i=2,nres-2
- IF (mask_phi(i+2).eq.1) THEN
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
- enddo
- enddo
+ IF (mask_phi(i+2).eq.1) THEN
ig=ig+1
- g(ig)=gphii
- ELSE
- ind=ind+nres-1-i
+ g(ig)=gg(i-1)
ENDIF
enddo
- ind=0
do i=1,nres-2
IF (mask_theta(i+2).eq.1) THEN
ig=ig+1
- gthetai=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
- enddo
- enddo
- g(ig)=gthetai
- ELSE
- ind=ind+nres-1-i
+ g(ig)=gg(nphi+i)
ENDIF
enddo
do i=2,nres-1
- if (itype(i).ne.10) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
IF (mask_side(i).eq.1) THEN
ig=ig+1
- galphai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- g(ig)=galphai
+ g(ig)=gg(ialph(i,1))
+c write (iout,*) "i",i," ig",ig," ialph",ialph(i,1)
+c write (iout,*) "g",g(ig)," gg",gg(ialph(i,1))
ENDIF
endif
enddo
do i=2,nres-1
- if (itype(i).ne.10) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
IF (mask_side(i).eq.1) THEN
ig=ig+1
- gomegai=0.0D0
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ig)=gomegai
+ g(ig)=gg(ialph(i,1)+nside)
+c write (iout,*) "i",i," ig",ig," ialph",ialph(i,1)+nside
+c write (iout,*) "g",g(ig)," gg",gg(ialph(i,1)+nside)
ENDIF
endif
enddo
do ij=1,2
do i=2,nres-1
- if (itype(i).ne.10) then
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
igall=igall+1
if (mask_side(i).eq.1) then
ig=ig+1
g(ig)=g(ig)+gloc(igall,icg)
+c write (iout,*) "ij",ij," i",i," ig",ig," igall",igall
+c write (iout,*) "gloc",gloc(igall,icg)," g",g(ig)
endif
endif
enddo
cd enddo
return
end
+#endif
C-----------------------------------------------------------------------------
subroutine egb1(evdw)
C
lprn=.false.
c if (icall.eq.0) lprn=.true.
ind=0
- do i=iatsc_s,iatsc_e
+c do i=iatsc_s,iatsc_e
+ do i=nnt,nct
itypi=iabs(itype(i))
- if (itypi.eq.ntyp1) cycle
+ if (itypi.eq.ntyp1 .or. mask_side(i).eq.0) cycle
itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
C
C Calculate SC interaction energy.
C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+c do iint=1,nint_gr(i)
+c do j=istart(i,iint),iend(i,iint)
+ do j=i+1,nct
IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
ind=ind+1
itypj=iabs(itype(j))
call sc_grad
ENDIF
enddo ! j
- enddo ! iint
+c enddo ! iint
enddo ! i
end
C-----------------------------------------------------------------------------
subroutine friction_force
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.IOUNITS'
+#ifdef FIVEDIAG
+ integer iposc,ichain,n,innt,inct
+ double precision v_work(3,maxres2),vvec(maxres2_chain),rs(maxres2)
+#else
double precision gamvec(MAXRES6)
common /syfek/ gamvec
double precision vv(3),vvtot(3,maxres),v_work(MAXRES6),
& ginvfric(maxres2,maxres2)
common /przechowalnia/ ginvfric
+#endif
+ integer i,j,k,ind
logical lprn /.false./, checkmode /.false./
-
+#ifdef FIVEDIAG
+c Here accelerations due to friction forces are computed right after forces.
+ d_t_work=0.0d0
+ do j=1,3
+ v_work(j,1)=d_t(j,0)
+ v_work(j,nnt)=d_t(j,0)
+ enddo
+ do i=nnt+1,nct
+ do j=1,3
+ v_work(j,i)=v_work(j,i-1)+d_t(j,i-1)
+ enddo
+ enddo
+ do i=nnt,nct
+ if (iabs(itype(i)).ne.10 .and. iabs(itype(i)).ne.ntyp1) then
+ do j=1,3
+ v_work(j,i+nres)=v_work(j,i)+d_t(j,i+nres)
+ enddo
+ endif
+ enddo
+#ifdef DEBUG
+ write (iout,*) "v_work"
+ do i=1,2*nres
+ write (iout,'(i5,3f10.5)') i,(v_work(j,i),j=1,3)
+ enddo
+#endif
+ do j=1,3
+ ind=0
+ do ichain=1,nchain
+ n=dimen_chain(ichain)
+ iposc=iposd_chain(ichain)
+c write (iout,*) "friction_force j",j," ichain",ichain,
+c & " n",n," iposc",iposc,iposc+n-1
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ do i=innt,inct
+ vvec(ind+1)=v_work(j,i)
+ ind=ind+1
+ if (iabs(itype(i)).ne.10) then
+ vvec(ind+1)=v_work(j,i+nres)
+ ind=ind+1
+ endif
+ enddo
+#ifdef DEBUG
+ write (iout,*) "vvec ind",ind
+ write (iout,'(f10.5)') (vvec(i),i=iposc,ind)
+#endif
+c write (iout,*) "chain",i," ind",ind," n",n
+ call fivediagmult(n,DMfric(iposc),DU1fric(iposc),
+ & DU2fric(iposc),vvec,rs)
+ do i=iposc,iposc+n-1
+ fric_work(3*(i-1)+j)=-rs(i)
+ enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "Vector fric_work"
+ write (iout,'(3f10.5)') (fric_work(j),j=1,dimen3)
+#endif
+#else
do i=0,MAXRES2
do j=1,3
friction(j,i)=0.0d0
enddo
enddo
endif
+#endif
return
end
c-----------------------------------------------------
subroutine stochastic_force(stochforcvec)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
+ double precision time00
#endif
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.TIME1'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.IOUNITS'
double precision x,sig,lowb,highb,
& ff(3),force(3,0:MAXRES2),zeta2,lowb2,
& highb2,sig2,forcvec(MAXRES6),stochforcvec(MAXRES6)
logical lprn /.false./
+ integer i,j,ind,ii,iti
+ double precision anorm_distr
+#ifdef FIVEDIAG
+ integer ichain,innt,inct,iposc
+#endif
+
do i=0,MAXRES2
do j=1,3
stochforc(j,i)=0.0d0
enddo
enddo
- x=0.0d0
+ x=0.0d0
#ifdef MPI
time00=MPI_Wtime()
force(j,i+nres)=anorm_distr(x,sig2,lowb2,highb2)
enddo
enddo
+#ifdef DEBUG
+ write (iout,*) "Stochastic forces on sites"
+ do i=1,nres
+ write (iout,'(i5,2(3f10.5,5x))') i,(force(j,i),j=1,3),
+ & (force(j,i+nres),j=1,3)
+ enddo
+#endif
#ifdef MPI
time_fsample=time_fsample+MPI_Wtime()-time00
#else
time_fsample=time_fsample+tcpu()-time00
#endif
+#ifdef FIVEDIAG
+ ind=0
+ do ichain=1,nchain
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ iposc=iposd_chain(ichain)
+c write (iout,*)"stochastic_force ichain=",ichain," innt",innt,
+c & " inct",inct," iposc",iposc
+ do j=1,3
+ stochforcvec(ind+j)=0.5d0*force(j,innt)
+ enddo
+ if (iabs(itype(innt)).eq.10) then
+ do j=1,3
+ stochforcvec(ind+j)=stochforcvec(ind+j)+force(j,innt+nres)
+ enddo
+ ind=ind+3
+ else
+ ind=ind+3
+ do j=1,3
+ stochforcvec(ind+j)=force(j,innt+nres)
+ enddo
+ ind=ind+3
+ endif
+ do i=innt+1,inct-1
+ do j=1,3
+ stochforcvec(ind+j)=0.5d0*(force(j,i)+force(j,i-1))
+ enddo
+ if (iabs(itype(i)).eq.10) then
+ do j=1,3
+ stochforcvec(ind+j)=stochforcvec(ind+j)+force(j,i+nres)
+ enddo
+ ind=ind+3
+ else
+ ind=ind+3
+ do j=1,3
+ stochforcvec(ind+j)=force(j,i+nres)
+ enddo
+ ind=ind+3
+ endif
+ enddo
+ do j=1,3
+ stochforcvec(ind+j)=0.5d0*force(j,inct-1)
+ enddo
+ if (iabs(itype(inct)).eq.10) then
+ do j=1,3
+ stochforcvec(ind+j)=stochforcvec(ind+j)+force(j,inct+nres)
+ enddo
+ ind=ind+3
+ else
+ ind=ind+3
+ do j=1,3
+ stochforcvec(ind+j)=force(j,inct+nres)
+ enddo
+ ind=ind+3
+ endif
+c write (iout,*) "chain",ichain," ind",ind
+ enddo
+#ifdef DEBUG
+ write (iout,*) "stochforcvec"
+ write (iout,'(3f10.5)') (stochforcvec(j),j=1,ind)
+#endif
+#else
c Compute the stochastic forces acting on virtual-bond vectors.
do j=1,3
ff(j)=0.0d0
enddo
endif
enddo
-
do j=1,3
stochforcvec(j)=stochforc(j,0)
enddo
ind=ind+3
endif
enddo
+#endif
if (lprn) then
write (iout,*) "stochforcvec"
do i=1,3*dimen
enddo
endif
-
return
end
c------------------------------------------------------------------
subroutine setup_fricmat
- implicit real*8 (a-h,o-z)
+ implicit none
#ifdef MPI
include 'mpif.h'
+ integer ierr
+ double precision time00
#endif
include 'DIMENSIONS'
include 'COMMON.VAR'
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.MD'
+#ifdef FIVEDIAG
+ include 'COMMON.LAGRANGE.5diag'
+#else
+ include 'COMMON.LAGRANGE'
+#endif
include 'COMMON.SETUP'
include 'COMMON.TIME1'
c integer licznik /0/
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.IOUNITS'
integer IERROR
- integer i,j,ind,ind1,m
+ integer i,j,k,l,ind,ind1,m,ii,iti,it,nzero,innt,inct
+ integer ichain,nind
logical lprn /.false./
- double precision dtdi,gamvec(MAXRES2),
- & ginvfric(maxres2,maxres2),Ghalf(mmaxres2),fcopy(maxres2,maxres2)
+ double precision dtdi,gamvec(MAXRES2)
common /syfek/ gamvec
+#ifndef FIVEDIAG
+ double precision ginvfric(maxres2,maxres2),Ghalf(mmaxres2),
+ & fcopy(maxres2,maxres2)
double precision work(8*maxres2)
integer iwork(maxres2)
common /przechowalnia/ ginvfric,Ghalf,fcopy
+#endif
+
#ifdef MPI
if (fg_rank.ne.king) goto 10
#endif
-c Zeroing out fricmat
- do i=1,dimen
- do j=1,dimen
- fricmat(i,j)=0.0d0
- enddo
- enddo
-c Load the friction coefficients corresponding to peptide groups
ind1=0
do i=nnt,nct-1
ind1=ind1+1
enddo
c Load the friction coefficients corresponding to side chains
m=nct-nnt
+ if (lprn) write (iout,*) "m",m
ind=0
C gamsc(ntyp1)=1.0d0
do i=nnt,nct
gamvec(ii)=gamsc(iabs(iti))
enddo
if (surfarea) call sdarea(gamvec)
-c if (lprn) then
-c write (iout,*) "Matrix A and vector gamma"
-c do i=1,dimen1
-c write (iout,'(i2,$)') i
-c do j=1,dimen
-c write (iout,'(f4.1,$)') A(i,j)
-c enddo
-c write (iout,'(f8.3)') gamvec(i)
-c enddo
-c endif
if (lprn) then
write (iout,*) "Vector gamvec"
do i=1,dimen1
write (iout,'(i5,f10.5)') i, gamvec(i)
enddo
endif
-
+#ifdef FIVEDIAG
+ DMfric=0.0d0
+ DU1fric=0.0d0
+ DU2fric=0.0d0
+ ind=1
+ do ichain=1,nchain
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+c write (iout,*) "ichain",ichain," innt",innt," inct",inct
+c DMfric part
+ DMfric(ind)=gamvec(innt-nnt+1)/4
+ if (iabs(itype(innt)).eq.10) then
+ DMfric(ind)=DMfric(ind)+gamvec(m+innt-nnt+1)
+ ind=ind+1
+ else
+ DMfric(ind+1)=gamvec(m+innt-nnt+1)
+ ind=ind+2
+ endif
+c write (iout,*) "DMfric init ind",ind
+c DMfric
+ do i=innt+1,inct-1
+ DMfric(ind)=gamvec(i-nnt+1)/2
+ if (iabs(itype(i)).eq.10) then
+ DMfric(ind)=DMfric(ind)+gamvec(m+i-nnt+1)
+ ind=ind+1
+ else
+ DMfric(ind+1)=gamvec(m+i-nnt+1)
+ ind=ind+2
+ endif
+ enddo
+c write (iout,*) "DMfric endloop ind",ind
+ if (inct.gt.innt) then
+ DMfric(ind)=gamvec(inct-1-nnt+1)/4
+ if (iabs(itype(inct)).eq.10) then
+ DMfric(ind)=DMfric(ind)+gamvec(inct+m-nnt+1)
+ ind=ind+1
+ else
+ DMfric(ind+1)=gamvec(inct+m-nnt+1)
+ ind=ind+2
+ endif
+ endif
+c write (iout,*) "DMfric end ind",ind
+ enddo
+c DU1fric part
+ do ichain=1,nchain
+ ind=iposd_chain(ichain)
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ do i=innt,inct
+ if (iabs(itype(i)).ne.10) then
+ ind=ind+2
+ else
+ DU1fric(ind)=gamvec(i-nnt+1)/4
+ ind=ind+1
+ endif
+ enddo
+ enddo
+c DU2fric part
+ do ichain=1,nchain
+ ind=iposd_chain(ichain)
+ innt=chain_border(1,ichain)
+ inct=chain_border(2,ichain)
+ do i=innt,inct-1
+ if (iabs(itype(i)).ne.10) then
+ DU2fric(ind)=gamvec(i-nnt+1)/4
+ DU2fric(ind+1)=0.0d0
+ ind=ind+2
+ else
+ DU2fric(ind)=0.0d0
+ ind=ind+1
+ endif
+ enddo
+ enddo
+ if (lprn) then
+ write(iout,*)"The upper part of the five-diagonal friction matrix"
+ do ichain=1,nchain
+ write (iout,'(a,i5)') 'Chain',ichain
+ innt=iposd_chain(ichain)
+ inct=iposd_chain(ichain)+dimen_chain(ichain)-1
+ do i=innt,inct
+ if (i.lt.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DMfric(i),DU1fric(i),
+ & DU2fric(i)
+ else if (i.eq.inct-1) then
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DMfric(i),DU1fric(i)
+ else
+ write (iout,'(2i3,3f10.5)') i,i-innt+1,DMfric(i)
+ endif
+ enddo
+ enddo
+ endif
+ 10 continue
+#else
c The friction matrix
do k=1,dimen
do i=1,dimen
c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,fcopy)
endif
#endif
+#endif
return
end
c-------------------------------------------------------------------------------
c Code adapted from TINKER
c AL 9/3/04
c
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CONTROL'
include 'COMMON.VAR'
#ifndef LANG0
include 'COMMON.LANGEVIN'
#else
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
include 'COMMON.LANGEVIN.lang0'
#endif
+#endif
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.GEO'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
double precision radius(maxres2),gamvec(maxres2)
+ double precision twosix
parameter (twosix=1.122462048309372981d0)
logical lprn /.false./
+ integer i,j,iti,ind
+ double precision probe,area,ratio
c
c determine new friction coefficients every few SD steps
c
c Load side chain radii
do i=nnt,nct
iti=itype(i)
- radius(i+nres)=restok(iti)
+ if (iti.ne.ntyp1) radius(i+nres)=restok(iti)
enddo
c do i=1,2*nres
c write (iout,*) "i",i," radius",radius(i)
+++ /dev/null
-Usage: tau_compiler.sh
- -optVerbose Turn on verbose debugging message
- -optDetectMemoryLeaks Track mallocs/frees using TAU's memory wrapper
- -optPdtDir="" PDT architecture directory. Typically $(PDTDIR)/$(PDTARCHDIR)
- -optPdtF95Opts="" Options for Fortran parser in PDT (f95parse)
- -optPdtF95Reset="" Reset options to the Fortran parser to the given list
- -optPdtCOpts="" Options for C parser in PDT (cparse). Typically $(TAU_MPI_INCLUDE) $(TAU_INCLUDE) $(TAU_DEFS)
- -optPdtCReset="" Reset options to the C parser to the given list
- -optPdtCxxOpts="" Options for C++ parser in PDT (cxxparse). Typically $(TAU_MPI_INCLUDE) $(TAU_INCLUDE) $(TAU_DEFS)
- -optPdtCxxReset="" Reset options to the C++ parser to the given list
- -optPdtF90Parser="" Specify a different Fortran parser. For e.g., f90parse instead of f95parse
- -optPdtGnuFortranParser Specify the GNU gfortran PDT parser gfparse instead of f95parse
- -optPdtUser="" Optional arguments for parsing source code
- -optTauInstr="" Specify location of tau_instrumentor. Typically $(TAUROOT)/$(CONFIG_ARCH)/bin/tau_instrumentor
- -optPreProcess Preprocess the source code before parsing. Uses /usr/bin/cpp -P by default.
- -optCPP="" Specify an alternative preprocessor and pre-process the sources.
- -optCPPOpts="" Specify additional options to the C pre-processor.
- -optCPPReset="" Reset C preprocessor options to the specified list.
- -optTauSelectFile="" Specify selective instrumentation file for tau_instrumentor
- -optPDBFile="" Specify PDB file for tau_instrumentor. Skips parsing stage.
- -optTau="" Specify options for tau_instrumentor
- -optCompile="" Options passed to the compiler by the user.
- -optTauDefs="" Options passed to the compiler by TAU. Typically $(TAU_DEFS)
- -optTauIncludes="" Options passed to the compiler by TAU. Typically $(TAU_MPI_INCLUDE) $(TAU_INCLUDE)
- -optIncludeMemory="" Flags for replacement of malloc/free. Typically -I$(TAU_DIR)/include/Memory
- -optReset="" Reset options to the compiler to the given list
- -optLinking="" Options passed to the linker. Typically $(TAU_MPI_FLIBS) $(TAU_LIBS) $(TAU_CXXLIBS)
- -optLinkReset="" Reset options to the linker to the given list
- -optTauCC="<cc>" Specifies the C compiler used by TAU
- -optOpariTool="<path/opari>" Specifies the location of the Opari tool
- -optOpariDir="<path>" Specifies the location of the Opari directory
- -optOpariOpts="" Specifies optional arguments to the Opari tool
- -optOpariReset="" Resets options passed to the Opari tool
- -optNoMpi Removes -l*mpi* libraries during linking (default)
- -optMpi Does not remove -l*mpi* libraries during linking
- -optNoRevert Exit on error. Does not revert to the original compilation rule on error.
- -optRevert Revert to the original compilation rule on error (default).
- -optKeepFiles Does not remove intermediate .pdb and .inst.* files
- -optAppCC="<cc>" Specifies the fallback C compiler.
- -optAppCXX="<cxx>" Specifies the fallback C++ compiler.
- -optAppF90="<f90>" Specifies the fallback F90 compiler.
return
end
c-----------------------------------------------------------
- subroutine contact_cp(var,var2,iff,ieval,in_pdb)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.MINIM'
-
- character*50 linia
- integer nf,ij(4)
- double precision energy(0:n_ene)
- double precision var(maxvar),var2(maxvar)
- double precision time0,time1
- integer iff(maxres),ieval
- double precision theta1(maxres),phi1(maxres),alph1(maxres),
- & omeg1(maxres)
- logical debug
-
- debug=.false.
-c debug=.true.
- if (ieval.eq.-1) debug=.true.
-
-
-c
-c store selected dist. constrains from 1st structure
-c
-#ifdef OSF
-c Intercept NaNs in the coordinates
-c write(iout,*) (var(i),i=1,nvar)
- x_sum=0.D0
- do i=1,nvar
- x_sum=x_sum+var(i)
- enddo
- if (x_sum.ne.x_sum) then
- write(iout,*)" *** contact_cp : Found NaN in coordinates"
- call flush(iout)
- print *," *** contact_cp : Found NaN in coordinates"
- return
- endif
-#endif
-
-
- call var_to_geom(nvar,var)
- call chainbuild
- nhpb0=nhpb
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- enddo
- enddo
- call hpb_partition
-
- do i=1,nres
- theta1(i)=theta(i)
- phi1(i)=phi(i)
- alph1(i)=alph(i)
- omeg1(i)=omeg(i)
- enddo
-
-c
-c freeze sec.elements from 2nd structure
-c
- do i=1,nres
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- enddo
-
- call var_to_geom(nvar,var2)
- call secondary2(debug)
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- enddo
- mask_r=.true.
-
-c
-c copy selected res from 1st to 2nd structure
-c
-
- do i=1,nres
- if ( iff(i).eq.1 ) then
- theta(i)=theta1(i)
- phi(i)=phi1(i)
- alph(i)=alph1(i)
- omeg(i)=omeg1(i)
- endif
- enddo
-
- if(debug) then
-c
-c prepare description in linia variable
-c
- iwsk=0
- nf=0
- if (iff(1).eq.1) then
- iwsk=1
- nf=nf+1
- ij(nf)=1
- endif
- do i=2,nres
- if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
- iwsk=1
- nf=nf+1
- ij(nf)=i
- endif
- if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
- iwsk=0
- nf=nf+1
- ij(nf)=i-1
- endif
- enddo
- if (iff(nres).eq.1) then
- nf=nf+1
- ij(nf)=nres
- endif
-
- write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
- & "SELECT",ij(1)-1,"-",ij(2)-1,
- & ",",ij(3)-1,"-",ij(4)-1
-
- endif
-c
-c run optimization
-c
- call contact_cp_min(var,ieval,in_pdb,linia,debug)
-
- return
- end
-
- subroutine contact_cp_min(var,ieval,in_pdb,linia,debug)
-c
-c input : theta,phi,alph,omeg,in_pdb,linia,debug
-c output : var,ieval
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.MINIM'
-
- character*50 linia
- integer nf,ij(4)
- double precision energy(0:n_ene)
- double precision var(maxvar)
- double precision time0,time1
- integer ieval,info(3)
- logical debug,fail,check_var,reduce,change
-
- write(iout,'(a20,i6,a20)')
- & '------------------',in_pdb,'-------------------'
-
- if (debug) then
- call chainbuild
- call write_pdb(1000+in_pdb,'combined structure',0d0)
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- endif
-
-c
-c run optimization of distances
-c
-c uses d0(),w() and mask() for frozen 2D
-c
-ctest---------------------------------------------
-ctest NX=NRES-3
-ctest NY=((NRES-4)*(NRES-5))/2
-ctest call distfit(debug,5000)
-
- do i=1,nres
- mask_side(i)=0
- enddo
-
- ipot01=ipot
- maxmin01=maxmin
- maxfun01=maxfun
-c wstrain01=wstrain
- wsc01=wsc
- wscp01=wscp
- welec01=welec
- wvdwpp01=wvdwpp
-c wang01=wang
- wscloc01=wscloc
- wtor01=wtor
- wtor_d01=wtor_d
-
- ipot=6
- maxmin=2000
- maxfun=4000
-c wstrain=1.0
- wsc=0.0
- wscp=0.0
- welec=0.0
- wvdwpp=0.0
-c wang=0.0
- wscloc=0.0
- wtor=0.0
- wtor_d=0.0
-
- call geom_to_var(nvar,var)
-cde change=reduce(var)
- if (check_var(var,info)) then
- write(iout,*) 'cp_min error in input'
- print *,'cp_min error in input'
- return
- endif
-
-cd call etotal(energy(0))
-cd call enerprint(energy(0))
-cd call check_eint
-
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
-cdtest call minimize(etot,var,iretcode,nfun)
-cdtest write(iout,*)'SUMSL return code is',iretcode,' eval SDIST',nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
-
-cd call etotal(energy(0))
-cd call enerprint(energy(0))
-cd call check_eint
-
- do i=1,nres
- mask_side(i)=1
- enddo
-
- ipot=ipot01
- maxmin=maxmin01
- maxfun=maxfun01
-c wstrain=wstrain01
- wsc=wsc01
- wscp=wscp01
- welec=welec01
- wvdwpp=wvdwpp01
-c wang=wang01
- wscloc=wscloc01
- wtor=wtor01
- wtor_d=wtor_d01
-ctest--------------------------------------------------
-
- if(debug) then
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,a)')' Time for distfit ',time1-time0,' sec'
- call write_pdb(2000+in_pdb,'distfit structure',0d0)
- endif
-
-
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
-c
-c run soft pot. optimization
-c with constrains:
-c nhpb,ihpb(),jhpb(),forcon(),dhpb() and hpb_partition
-c and frozen 2D:
-c mask_phi(),mask_theta(),mask_side(),mask_r
-c
- ipot=6
- maxmin=2000
- maxfun=4000
-
-cde change=reduce(var)
-cde if (check_var(var,info)) write(iout,*) 'error before soft'
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
-
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
- & nfun/(time1-time0),' SOFT eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(3000+in_pdb,'soft structure',etot)
- endif
-c
-c run full UNRES optimization with constrains and frozen 2D
-c the same variables as soft pot. optimizatio
-c
- ipot=ipot0
- maxmin=maxmin0
- maxfun=maxfun0
-c
-c check overlaps before calling full UNRES minim
-c
- call var_to_geom(nvar,var)
- call chainbuild
- call etotal(energy(0))
-#ifdef OSF
- write(iout,*) 'N7 ',energy(0)
- if (energy(0).ne.energy(0)) then
- write(iout,*) 'N7 error - gives NaN',energy(0)
- endif
-#endif
- ieval=1
- if (energy(1).eq.1.0d20) then
- write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw=1d20',energy(1)
- call overlap_sc(fail)
- if(.not.fail) then
- call etotal(energy(0))
- ieval=ieval+1
- write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw after',energy(1)
- else
- mask_r=.false.
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
- return
- endif
- endif
- call flush(iout)
-c
-cdte time0=MPI_WTIME()
-cde change=reduce(var)
-cde if (check_var(var,info)) then
-cde write(iout,*) 'error before mask dist'
-cde call var_to_geom(nvar,var)
-cde call chainbuild
-cde call write_pdb(10000+in_pdb,'before mask dist',etot)
-cde endif
-cdte call minimize(etot,var,iretcode,nfun)
-cdte write(iout,*)'SUMSL MASK DIST return code is',iretcode,
-cdte & ' eval ',nfun
-cdte ieval=ieval+nfun
-cdte
-cdte time1=MPI_WTIME()
-cdte write (iout,'(a,f6.2,f8.2,a)')
-cdte & ' Time for mask dist min.',time1-time0,
-cdte & nfun/(time1-time0),' eval/s'
-cdte call flush(iout)
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(4000+in_pdb,'mask dist',etot)
- endif
-c
-c switch off freezing of 2D and
-c run full UNRES optimization with constrains
-c
- mask_r=.false.
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
-cde change=reduce(var)
-cde if (check_var(var,info)) then
-cde write(iout,*) 'error before dist'
-cde call var_to_geom(nvar,var)
-cde call chainbuild
-cde call write_pdb(11000+in_pdb,'before dist',etot)
-cde endif
-
- call minimize(etot,var,iretcode,nfun)
-
-cde change=reduce(var)
-cde if (check_var(var,info)) then
-cde write(iout,*) 'error after dist',ico
-cde call var_to_geom(nvar,var)
-cde call chainbuild
-cde call write_pdb(12000+in_pdb+ico*1000,'after dist',etot)
-cde endif
- write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
- ieval=ieval+nfun
-
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for dist min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-cde call etotal(energy(0))
-cde write(iout,*) 'N7 after dist',energy(0)
- call flush(iout)
-
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(in_pdb,linia,etot)
- endif
-c
-c reset constrains
-c
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
-
- return
- end
-c--------------------------------------------------------
- subroutine softreg
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.INTERACT'
-c
- include 'COMMON.DISTFIT'
- integer iff(maxres)
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar)
- integer ieval
-c
- logical debug,ltest,fail
- character*50 linia
-c
- linia='test'
- debug=.true.
- in_pdb=0
-
-
-
-c------------------------
-c
-c freeze sec.elements
-c
- do i=1,nres
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- iff(i)=0
- enddo
-
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- enddo
- mask_r=.true.
-
-
-
- nhpb0=nhpb
-c
-c store dist. constrains
-c
- do i=1,nres-3
- do j=i+3,nres
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=0.1
- dhpb(nhpb)=DIST(i,j)
- endif
- enddo
- enddo
- call hpb_partition
-
- if (debug) then
- call chainbuild
- call write_pdb(100+in_pdb,'input reg. structure',0d0)
- endif
-
-
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
- wang0=wang
-c
-c run soft pot. optimization
-c
- ipot=6
- wang=3.0
- maxmin=2000
- maxfun=4000
- call geom_to_var(nvar,var)
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
-
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
- & nfun/(time1-time0),' SOFT eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(300+in_pdb,'soft structure',etot)
- endif
-c
-c run full UNRES optimization with constrains and frozen 2D
-c the same variables as soft pot. optimizatio
-c
- ipot=ipot0
- wang=wang0
- maxmin=maxmin0
- maxfun=maxfun0
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL MASK DIST return code is',iretcode,
- & ' eval ',nfun
- ieval=nfun
-
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')
- & ' Time for mask dist min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(400+in_pdb,'mask & dist',etot)
- endif
-c
-c switch off constrains and
-c run full UNRES optimization with frozen 2D
-c
-
-c
-c reset constrains
-c
- nhpb_c=nhpb
- nhpb=nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
-
-
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun
- ieval=ieval+nfun
-
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
-
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(500+in_pdb,'mask 2d frozen',etot)
- endif
-
- mask_r=.false.
-
-
-c
-c run full UNRES optimization with constrains and NO frozen 2D
-c
-
- nhpb=nhpb_c
- link_start=1
- link_end=nhpb
- maxfun=maxfun0/5
-
- do ico=1,5
-
- wstrain=wstrain0/ico
-
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)')
- & ' SUMSL DIST',wstrain,' return code is',iretcode,
- & ' eval ',nfun
- ieval=nfun
-
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')
- & ' Time for dist min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(600+in_pdb+ico,'dist cons',etot)
- endif
-
- enddo
-c
- nhpb=nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
- maxfun=maxfun0
-
-
-c
- if (minim) then
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
- & '+ DIST eval',ieval
-
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
-
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(999,'full min',etot)
- endif
-
- return
- end
-
-
- subroutine beta_slide(i1,i2,i3,i4,i5,ieval,ij)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.CHAIN'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar)
- integer jdata(5),isec(maxres)
-c
- jdata(1)=i1
- jdata(2)=i2
- jdata(3)=i3
- jdata(4)=i4
- jdata(5)=i5
-
- call secondary2(.false.)
-
- do i=1,nres
- isec(i)=0
- enddo
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- isec(i)=1
- enddo
- do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j))
- isec(i)=1
- enddo
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- isec(i)=2
- enddo
- enddo
-
-c
-c cut strands at the ends
-c
- if (jdata(2)-jdata(1).gt.3) then
- jdata(1)=jdata(1)+1
- jdata(2)=jdata(2)-1
- if (jdata(3).lt.jdata(4)) then
- jdata(3)=jdata(3)+1
- jdata(4)=jdata(4)-1
- else
- jdata(3)=jdata(3)-1
- jdata(4)=jdata(4)+1
- endif
- endif
-
-cv call chainbuild
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv write(iout,*) nnt,nct,etot
-cv call write_pdb(ij*100,'first structure',etot)
-cv write(iout,*) 'N16 test',(jdata(i),i=1,5)
-
-c------------------------
-c generate constrains
-c
- ishift=jdata(5)-2
- if(ishift.eq.0) ishift=-2
- nhpb0=nhpb
- call chainbuild
- do i=jdata(1),jdata(2)
- isec(i)=-1
- if(jdata(4).gt.jdata(3))then
- do j=jdata(3)+i-jdata(1)-2,jdata(3)+i-jdata(1)+2
- isec(j)=-1
-cd print *,i,j,j+ishift
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=1000.0
- dhpb(nhpb)=DIST(i,j+ishift)
- enddo
- else
- do j=jdata(3)-i+jdata(1)+2,jdata(3)-i+jdata(1)-2,-1
- isec(j)=-1
-cd print *,i,j,j+ishift
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=1000.0
- dhpb(nhpb)=DIST(i,j+ishift)
- enddo
- endif
- enddo
-
- do i=nnt,nct-2
- do j=i+2,nct
- if(isec(i).gt.0.or.isec(j).gt.0) then
-cd print *,i,j
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=0.1
- dhpb(nhpb)=DIST(i,j)
- endif
- enddo
- enddo
-
- call hpb_partition
-
- call geom_to_var(nvar,var)
- maxfun0=maxfun
- wstrain0=wstrain
- maxfun=4000/5
-
- do ico=1,5
-
- wstrain=wstrain0/ico
-
-cv time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)')
- & ' SUMSL DIST',wstrain,' return code is',iretcode,
- & ' eval ',nfun
- ieval=ieval+nfun
-cv time1=MPI_WTIME()
-cv write (iout,'(a,f6.2,f8.2,a)')
-cv & ' Time for dist min.',time1-time0,
-cv & nfun/(time1-time0),' eval/s'
-cv call var_to_geom(nvar,var)
-cv call chainbuild
-cv call write_pdb(ij*100+ico,'dist cons',etot)
-
- enddo
-c
- nhpb=nhpb0
- call hpb_partition
- wstrain=wstrain0
- maxfun=maxfun0
-c
-cd print *,etot
- wscloc0=wscloc
- wscloc=10.0
- call sc_move(nnt,nct,100,100d0,nft_sc,etot)
- wscloc=wscloc0
-cv call chainbuild
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv call write_pdb(ij*100+10,'sc_move',etot)
-cd call intout
-cd print *,nft_sc,etot
-
- return
- end
-
- subroutine beta_zip(i1,i2,ieval,ij)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.CHAIN'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar)
- character*10 test
-
-cv call chainbuild
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv write(test,'(2i5)') i1,i2
-cv call write_pdb(ij*100,test,etot)
-cv write(iout,*) 'N17 test',i1,i2,etot,ij
-
-c
-c generate constrains
-c
- nhpb0=nhpb
- nhpb=nhpb+1
- ihpb(nhpb)=i1
- jhpb(nhpb)=i2
- forcon(nhpb)=1000.0
- dhpb(nhpb)=4.0
-
- call hpb_partition
-
- call geom_to_var(nvar,var)
- maxfun0=maxfun
- wstrain0=wstrain
- maxfun=1000/5
-
- do ico=1,5
- wstrain=wstrain0/ico
-cv time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)')
- & ' SUMSL DIST',wstrain,' return code is',iretcode,
- & ' eval ',nfun
- ieval=ieval+nfun
-cv time1=MPI_WTIME()
-cv write (iout,'(a,f6.2,f8.2,a)')
-cv & ' Time for dist min.',time1-time0,
-cv & nfun/(time1-time0),' eval/s'
-c do not comment the next line
- call var_to_geom(nvar,var)
-cv call chainbuild
-cv call write_pdb(ij*100+ico,'dist cons',etot)
- enddo
-
- nhpb=nhpb0
- call hpb_partition
- wstrain=wstrain0
- maxfun=maxfun0
-
-cv call etotal(energy(0))
-cv etot=energy(0)
-cv write(iout,*) 'N17 test end',i1,i2,etot,ij
-
-
- return
- end
C... -1 - STOP signal was received from another node because of error;
C... -2 - STOP signal was received from another node, because
C... the node's time was up.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
integer nf
logical ovrtim
end
C--------------------------------------------------------------------------
logical function ovrtim()
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
- real*8 tcpu
+ real*8 tcpu,curtim
#ifdef MPI
include "mpif.h"
curtim = MPI_Wtime()-walltime
end
**************************************************************************
double precision function tcpu()
+ implicit none
include 'COMMON.TIME1'
+ double precision seconds
#ifdef ES9000
****************************
C Next definition for EAGLE (ibm-es9000)
end
C---------------------------------------------------------------------------
subroutine dajczas(rntime,hrtime,mintime,sectime)
+ implicit none
include 'COMMON.IOUNITS'
real*8 rntime,hrtime,mintime,sectime
+ integer ihr,imn,isc
hrtime=rntime/3600.0D0
- hrtime=aint(hrtime)
- mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
- sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
+ hrtime=dint(hrtime)
+ mintime=dint((rntime-3600.0D0*hrtime)/60.0D0)
+ sectime=dint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
if (sectime.eq.60.0D0) then
sectime=0.0D0
mintime=mintime+1.0D0
end
C---------------------------------------------------------------------------
subroutine print_detailed_timing
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
+ double precision time1
#endif
include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
& " BCASTW",time_bcastw," ALLREDUCE",time_allreduce,
& " TOTAL",
& time_bcast+time_reduce+time_gather+time_scatter+
- & time_sendrecv+time_barrier+time_bcastc
+ & time_sendrecv+time_barrier_g+time_barrier_e+time_bcastc
write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc
write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene
write (*,*) "Processor",fg_rank,myrank," intfromcart",
C approximation. C
C C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.GEO'
include 'COMMON.HEADER'
include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
& 'Mesoscopic molecular dynamics (MD) ',
& 'Not used 13',
& 'Replica exchange molecular dynamics (REMD)'/
+ integer ilen
external ilen
+ integer ierr
c call memmon_print_usage()
call flush(iout)
C
if (modecalc.eq.-2) then
- call test
- stop
+c call test
+c stop
else if (modecalc.eq.-1) then
write(iout,*) "call check_sc_map next"
call check_bond
end
c--------------------------------------------------------------------------
subroutine exec_MD
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
c---------------------------------------------------------------------------
#ifdef MPI
subroutine exec_MREMD
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
include 'COMMON.CONTROL'
include 'COMMON.IOUNITS'
include 'COMMON.REMD'
+ integer i
if (me.eq.king .or. .not. out1file)
& write (iout,*) "Calling chainbuild"
call chainbuild
#endif
c---------------------------------------------------------------------------
subroutine exec_eeval_or_minim
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.GEO'
include 'COMMON.HEADER'
include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.REMD'
include 'COMMON.MD'
include 'COMMON.SBRIDGE'
+ integer i,icall,iretcode,nfun
common /srutu/ icall
- double precision energy(0:n_ene)
+ integer nharp,iharp(4,maxres/3)
+ integer nft_sc
+ logical fail
+ double precision energy(0:n_ene),etot,etota
double precision energy_long(0:n_ene),energy_short(0:n_ene)
+ double precision rms,frac,frac_nn,co
double precision varia(maxvar)
+ double precision time00,time1,time_ene,evals
+#ifdef LBFGS
+ character*9 status
+ integer niter
+ common /lbfgstat/ status,niter,nfun
+#endif
+ integer ilen
if (indpdb.eq.0) call chainbuild
if (indpdb.ne.0) then
dc(1,0)=c(1,1)
time_ene=tcpu()-time00
#endif
write (iout,*) "Time for energy evaluation",time_ene
- print *,"after etotal"
+c print *,"after etotal"
etota = energy(0)
etot =etota
call enerprint(energy(0))
call hairpin(.true.,nharp,iharp)
- print *,'after hairpin'
+c print *,'after hairpin'
call secondary2(.true.)
- print *,'after secondary'
+c print *,'after secondary'
if (minim) then
crc overlap test
+ if (indpdb.ne.0 .and. .not.dccart) then
+ call bond_regular
+ call chainbuild_extconf
+ call etotal(energy(0))
+ write (iout,*) "After bond regularization"
+ call enerprint(energy(0))
+ endif
+
if (overlapsc) then
- print *, 'Calling OVERLAP_SC'
+c print *, 'Calling OVERLAP_SC'
call overlap_sc(fail)
- print *,"After overlap_sc"
+c print *,"After overlap_sc"
endif
if (searchsc) then
#endif
call minim_dc(etot,iretcode,nfun)
else
- if (indpdb.ne.0) then
- call bond_regular
- call chainbuild_extconf
- endif
call geom_to_var(nvar,varia)
- print *,'Calling MINIMIZE.'
+c print *,'Calling MINIMIZE.'
#ifdef MPI
time1=MPI_WTIME()
#else
#endif
call minimize(etot,varia,iretcode,nfun)
endif
+#ifdef LBFGS
+ print *,'LBFGS return code is',status,' eval ',nfun
+#else
print *,'SUMSL return code is',iretcode,' eval ',nfun
+#endif
#ifdef MPI
evals=nfun/(MPI_WTIME()-time1)
#else
call enerprint(energy(0))
call intout
- call briefout(0,etot)
+ if (out_int) call briefout(0,etot)
+ if (out_cart) then
+ cartname=prefix(:ilen(prefix))//'.x'
+ potE=etot
+ call cartoutx(0.0d0)
+ endif
if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
+#ifdef LBFGS
+ write (iout,'(a,a9)') 'LBFGS return code:',status
+ write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
+ write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
+#else
write (iout,'(a,i3)') 'SUMSL return code:',iretcode
write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
+#endif
else
print *,'refstr=',refstr
if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
end
c---------------------------------------------------------------------------
subroutine exec_regularize
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.GEO'
include 'COMMON.HEADER'
include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.MD'
include 'COMMON.SBRIDGE'
double precision energy(0:n_ene)
+ double precision etot,rms,frac,frac_nn,co
+ integer iretcode
+#ifdef LBFGS
+ character*9 status
+ integer niter,nfun
+ common /lbfgstat/ status,niter,nfun
+#endif
call gen_dist_constr
call sc_conf
if (outpdb) call pdbout(etot,titel(:50),ipdb)
if (outmol2) call mol2out(etot,titel(:32))
if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
+#ifdef LBFGS
+ write (iout,'(a,a9)') 'LBFGS return code:',status
+#else
write (iout,'(a,i3)') 'SUMSL return code:',iretcode
+#endif
return
end
c---------------------------------------------------------------------------
subroutine exec_thread
+ implicit none
include 'DIMENSIONS'
#ifdef MP
include "mpif.h"
end
c---------------------------------------------------------------------------
subroutine exec_MC
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
character*10 nodeinfo
+ integer ipar
double precision varia(maxvar)
#ifdef MPI
include "mpif.h"
end
c---------------------------------------------------------------------------
subroutine exec_mult_eeval_or_minim
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
- dimension muster(mpi_status_size)
+ integer muster(mpi_status_size)
+ integer ierr,ierror
#endif
include 'COMMON.SETUP'
include 'COMMON.TIME1'
include 'COMMON.GEO'
include 'COMMON.HEADER'
include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.MD'
include 'COMMON.SBRIDGE'
double precision varia(maxvar)
- dimension ind(6)
- double precision energy(0:max_ene)
+ integer i,j,iconf,ind(6)
+ integer n,it,man,nf_mcmf,nmin,imm,mm,nft
+ double precision energy(0:max_ene),ene,etot,ene0
+ double precision rms,frac,frac_nn,co
+ double precision time
logical eof
eof=.false.
#ifdef MPI
end
c---------------------------------------------------------------------------
subroutine exec_checkgrad
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.GEO'
include 'COMMON.HEADER'
include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
+c include 'COMMON.CONTACTS'
include 'COMMON.CHAIN'
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.FFIELD'
include 'COMMON.REMD'
include 'COMMON.MD'
+ include 'COMMON.QRESTR'
include 'COMMON.SBRIDGE'
+ integer icall
common /srutu/ icall
double precision energy(0:max_ene)
c print *,"A TU?"
goto (10,20,30) icheckgrad
10 call check_ecartint
return
- 20 call check_cartgrad
+ 20 write (iout,*)
+ & "Checking the gradient of Cartesian coordinates disabled."
return
30 call check_eint
return
end
c---------------------------------------------------------------------------
subroutine exec_CSA
+ implicit none
#ifdef MPI
include "mpif.h"
#endif
end
c---------------------------------------------------------------------------
subroutine exec_softreg
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
- double precision energy(0:max_ene)
+ double precision energy(0:max_ene),etot
+ double precision rms,frac,frac_nn,co
call chainbuild
call etotal(energy(0))
call enerprint(energy(0))
if (.not.lsecondary) then
write(iout,*) 'Calling secondary structure recognition'
- call secondary2(debug)
+ call secondary2(.true.)
else
write(iout,*) 'Using secondary structure supplied in pdb'
endif
BIN = ~/bin
FC = ftn
-OPT = -mcmodel=medium -shared-intel -O3 -dynamic
+#OPT = -mcmodel=medium -shared-intel -O3 -dynamic
#OPT = -O3 -intel-static -mcmodel=medium
#OPT = -O3 -ip -w
-#OPT = -g -CB -mcmodel=medium -shared-intel -dynamic
+OPT = -g -CB -mcmodel=medium -shared-intel -dynamic
FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include
LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a
./compinfo
${FC} -c ${FFLAGS} cinfo.f
$(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
- ${LIBS} -o ${BIN}/wham_ifort_KCC_MPICH-okeanos_NEWCORR-SAXS-homology.exe
+ ${LIBS} -o ${BIN}/wham_ifort_KCC_MPICH-okeanos_NEWCORR-SAXS-homology-D.exe
NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DDFA
NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
./compinfo
${FC} -c ${FFLAGS} cinfo.f
$(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
- ${LIBS} -o ${BIN}/wham_ifort_KCC_MPICH-okeanos_NEWCORR-SAXS-homology-DFA.exe
+ ${LIBS} -o ${BIN}/wham_ifort_KCC_MPICH-okeanos_NEWCORR-SAXS-homology-DFA-D.exe
xdrf/libxdrf.a:
cd xdrf && make
write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
write (iout,*) "Internal coordinates"
+ call intout
write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
endif
c print *,"Processor",myrank," computed Utord"
C
- call eback_sc_corr(esccor)
+ if (wsccor.gt.0.0d0) then
+ call eback_sc_corr(esccor)
+ else
+ esccor=0.0d0
+ endif
if (wliptran.gt.0) then
call Eliptransfer(eliptran)
+ else
+ eliptran=0.0d0
endif
-
+#ifdef FOURBODY
C
C 12/1/95 Multi-body terms
C
c write (iout,*) "Calling multibody_hbond"
call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
endif
+#endif
c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
call e_saxs(Esaxs_constr)
#ifdef SPLITELE
write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
& estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
- & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
- & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),eel_loc,
+ & etors_d,wtor_d*fact(2),ehpb,wstrain,
+#ifdef FOURBODY
+ & ecorr,wcorr*fact(3),
+ & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
+#endif
+ & eel_loc,
& wel_loc*fact(2),eello_turn3,wturn3*fact(2),
- & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
+ & eello_turn4,wturn4*fact(3),
+#ifdef FOURBODY
+ & eello_turn6,wturn6*fact(5),
+#endif
& esccor,wsccor*fact(1),edihcnstr,
& ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
& etube,wtube,esaxs,wsaxs,ehomology_constr,
& 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
& 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
& ' (SS bridges & dist. cnstr.)'/
+#ifdef FOURBODY
& 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
+#endif
& 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
& 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
& 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
+#ifdef FOURBODY
& 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
+#endif
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
& 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
#else
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
& estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
- & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
+ & etors_d,wtor_d*fact(2),ehpb,wstrain,
+#ifdef FOURBODY
+ & ecorr,wcorr*fact(3),
& ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
+#endif
& eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
- & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
+ & eello_turn4,wturn4*fact(3),
+#ifdef FOURBODY
+ & eello_turn6,wturn6*fact(5),
+#endif
& esccor,wsccor*fact(1),edihcnstr,
& ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
& etube,wtube,esaxs,wsaxs,ehomology_constr,
& 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
& 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
& ' (SS bridges & dist. restr.)'/
+#ifdef FOURBODY
& 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
& 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
+#endif
& 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
& 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
& 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
+#ifdef FOURBODY
& 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
+#endif
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
& 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
dimension gg(3)
integer icant
external icant
C Change 12/1/95 to calculate four-body interactions
rij=xj*xj+yj*yj+zj*zj
rrij=1.0D0/rij
+ sqrij=dsqrt(rij)
+ sss1=sscale(sqrij)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(sqrij)
c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
+ evdw=evdw+sss1*evdwij
else
- evdw_t=evdw_t+evdwij
+ evdw_t=evdw_t+sss1*evdwij
endif
if (calc_grad) then
C
C Calculate the components of the gradient in DC and X
C
- fac=-rrij*(e1+evdwij)
+ fac=-rrij*(e1+evdwij)*sss1
+ & +evdwij*sssgrad1/sqrij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
enddo
enddo
endif
+#ifdef FOURBODY
C
C 12/1/95, revised on 5/20/97
C
cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
endif
endif
+#endif
enddo ! j
enddo ! iint
+#ifdef FOURBODY
C Change 12/1/95
num_cont(i)=num_conti
+#endif
enddo ! i
if (calc_grad) then
do i=1,nct
e_augm=augm(itypi,itypj)*fac_augm
r_inv_ij=dsqrt(rrij)
rij=1.0D0/r_inv_ij
+ sss1=sscale(rij)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(rij)
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
e1=fac*fac*aa
cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
+ evdw=evdw+evdwij*sss1
else
- evdw_t=evdw_t+evdwij
+ evdw_t=evdw_t+evdwij*sss1
endif
if (calc_grad) then
C
C Calculate the components of the gradient in DC and X
C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
+ fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
+ & +evdwij*sssgrad1*r_inv_ij/expon
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
cd rrij=rrsave(ind)
cd endif
rij=dsqrt(rrij)
+ sss1=sscale(1.0d0/rij)
+ if (sss1.eq.0.0d0) cycle
+ sssgrad1=sscagrad(1.0d0/rij)
+
C Calculate the angle-dependent terms of energy & contributions to derivatives.
call sc_angular
C Calculate whole angle-dependent part of epsilon and contributions
& /dabs(eps(itypi,itypj))
eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
if (bb.gt.0.0d0) then
- evdw=evdw+evdwij
+ evdw=evdw+sss1*evdwij
else
- evdw_t=evdw_t+evdwij
+ evdw_t=evdw_t+sss1*evdwij
endif
if (calc_grad) then
if (lprn) then
fac=-expon*(e1+evdwij)
sigder=fac/sigsq
fac=rrij*fac
+ & +evdwij*sssgrad1/sss1*rij
C Calculate radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
c write (iout,*) i,j,xj,yj,zj
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
- sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
+ sss=sscale(1.0d0/rij)
+ sssgrad=sscagrad(1.0d0/rij)
if (sss.le.0.0) cycle
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
dzj=dc_norm(3,nres+j)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
+ sss=sscale(1.0d0/rij)
+ if (sss.eq.0.0d0) cycle
+ sssgrad=sscagrad(1.0d0/rij)
C Calculate angle-dependent terms of energy and contributions to their
C derivatives.
call sc_angular
e_augm=augm(itypi,itypj)*fac_augm
evdwij=evdwij*eps2rt*eps3rt
if (bb.gt.0.0d0) then
- evdw=evdw+evdwij+e_augm
+ evdw=evdw+(evdwij+e_augm)*sss
else
- evdw_t=evdw_t+evdwij+e_augm
+ evdw_t=evdw_t+(evdwij+e_augm)*sss
endif
ij=icant(itypi,itypj)
aux=eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)*rij_shift
sigder=fac*sigder
fac=rij*fac-2*expon*rrij*e_augm
+ fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
C Calculate the radial part of the gradient
gg(1)=xj*fac
gg(2)=yj*fac
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
c write(iout,*) "Macierz EUG",
c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
c & eug(2,2,i-2)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
& then
call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
endif
+#endif
else
do k=1,2
Ub2(k,i-2)=0.0d0
#endif
cd write (iout,*) 'mu1',mu1(:,i-2)
cd write (iout,*) 'mu2',mu2(:,i-2)
+#ifdef FOURBODY
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
& then
if (calc_grad) then
call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
endif
endif
+#endif
enddo
+#ifdef FOURBODY
C Matrices dependent on two consecutive virtual-bond dihedrals.
C The order of matrices is from left to right.
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
endif
enddo
endif
+#endif
return
end
C--------------------------------------------------------------------------
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
eello_turn3=0.0d0
eello_turn4=0.0d0
ind=0
+#ifdef FOURBODY
do i=1,nres
num_cont_hb(i)=0
enddo
+#endif
cd print '(a)','Enter EELEC'
cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
do i=1,nres
num_conti=0
call eelecij(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo
do i=iturn4_start,iturn4_end
if (i.lt.1) cycle
if (ymedi.lt.0) ymedi=ymedi+boxysize
zmedi=mod(zmedi,boxzsize)
if (zmedi.lt.0) zmedi=zmedi+boxzsize
-
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
c write(iout,*) "JESTEM W PETLI"
call eelecij(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
& call eturn4(i,eello_turn4)
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
C Loop over all neighbouring boxes
C do xshift=-1,1
c endif
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+#ifdef FOURBODY
num_conti=num_cont_hb(i)
+#endif
C I TU KURWA
do j=ielstart(i),ielend(i)
C do j=16,17
&) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
enddo ! j
+#ifdef FOURBODY
num_cont_hb(i)=num_conti
+#endif
enddo ! i
C enddo ! zshift
C enddo ! yshift
include 'COMMON.CHAIN'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VECTORS'
include 'COMMON.FFIELD'
C zj=zj-zmedi
rij=xj*xj+yj*yj+zj*zj
- sss=sscale(sqrt(rij))
- sssgrad=sscagrad(sqrt(rij))
+ sss=sscale(sqrt(rij))
+ if (sss.eq.0.0d0) return
+ sssgrad=sscagrad(sqrt(rij))
c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
c & " rlamb",rlamb," sss",sss
c if (sss.gt.0.0d0) then
cgrad enddo
cgrad enddo
if (sss.gt.0.0) then
- ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
- ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
- ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
+ facvdw=facvdw+sssgrad*rmij*evdwij
+ ggg(1)=facvdw*xj
+ ggg(2)=facvdw*yj
+ ggg(3)=facvdw*zj
else
ggg(1)=0.0
ggg(2)=0.0
endif ! calc_grad
#else
C MARYSIA
- facvdw=(ev1+evdwij)*sss
+ facvdw=(ev1+evdwij)
facel=(el1+eesij)
fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
+ fac=-3*rrmij*(facvdw+facvdw+facel)*sss
+ & +(evdwij+eesij)*sssgrad*rrmij
erij(1)=xj*rmij
erij(2)=yj*rmij
erij(3)=zj*rmij
C fac_shield(j)=0.6
endif
eel_loc_ij=eel_loc_ij
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
& 'eelloc',i,j,eel_loc_ij
c if (eel_loc_ij.ne.0)
& +a23*gmuij1(2)
& +a32*gmuij1(3)
& +a33*gmuij1(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
c write(iout,*) "derivative over thatai"
c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
c & a33*gmuij1(4)
& +a33*gmuij2(4)
gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
& geel_loc_ij*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
c Derivative over j residue
geel_loc_ji=a22*gmuji1(1)
c & a33*gmuji2(4)
gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
& geel_loc_ji*wel_loc
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
#endif
cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
& +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
& *fac_shield(i)*fac_shield(j)
C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
+ aux=eel_loc_ij/sss*sssgrad*rmij
+ ggg(1)=aux*xj
+ ggg(2)=aux*yj
+ ggg(3)=aux*zj
do l=1,3
- ggg(l)=(agg(l,1)*muij(1)+
+ ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
& agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
cgrad ghalf=0.5d0*ggg(l)
C Change 12/26/95 to calculate four-body contributions to H-bonding energy
c if (j.gt.i+1 .and. num_conti.le.maxconts) then
+#ifdef FOURBODY
if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
& .and. num_conti.le.maxconts) then
c write (iout,*) i,j," entered corr"
gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
enddo
gggp(1)=gggp(1)+ees0pijp*xj
+ & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
gggp(2)=gggp(2)+ees0pijp*yj
+ & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
gggp(3)=gggp(3)+ees0pijp*zj
+ & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
gggm(1)=gggm(1)+ees0mijp*xj
+ & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
gggm(2)=gggm(2)+ees0mijp*yj
+ & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
gggm(3)=gggm(3)+ees0mijp*zj
+ & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
C Derivatives due to the contact function
gacont_hbr(1,num_conti,i)=fprimcont*xj
gacont_hbr(2,num_conti,i)=fprimcont*yj
gacontp_hb1(k,num_conti,i)=!ghalfp
& +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontp_hb2(k,num_conti,i)=!ghalfp
& +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontp_hb3(k,num_conti,i)=gggp(k)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb1(k,num_conti,i)=!ghalfm
& +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
& + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb2(k,num_conti,i)=!ghalfm
& +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
& + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
gacontm_hb3(k,num_conti,i)=gggm(k)
- & *fac_shield(i)*fac_shield(j)
+ & *fac_shield(i)*fac_shield(j)*sss
enddo
C Diagnostics. Comment out or remove after debugging!
endif ! num_conti.le.maxconts
endif ! fcont.gt.0
endif ! j.gt.i+1
+#endif
if (calc_grad) then
if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
do k=1,4
include 'COMMON.FFIELD'
include 'COMMON.CONTROL'
include 'COMMON.SHIELD'
+ include 'COMMON.CORRMAT'
dimension ggg(3)
double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
& e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
include 'COMMON.FFIELD'
include 'COMMON.CONTROL'
include 'COMMON.SHIELD'
+ include 'COMMON.CORRMAT'
dimension ggg(3)
double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
& e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
coskt(k)=dcos(k*theti2)
sinkt(k)=dsin(k*theti2)
enddo
-cu if (i.eq.3) then
-cu phii=0.0d0
-cu ityp1=nthetyp+1
-cu do k=1,nsingle
-cu cosph1(k)=0.0d0
-cu sinph1(k)=0.0d0
-cu enddo
-cu else
+ if (i.eq.3) then
+ phii=0.0d0
+ ityp1=nthetyp+1
+ do k=1,nsingle
+ cosph1(k)=0.0d0
+ sinph1(k)=0.0d0
+ enddo
+ else
if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
sinph1(k)=0.0d0
enddo
endif
-cu endif
+ endif
if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
enddo
return
end
+#ifdef FOURBODY
c------------------------------------------------------------------------------
subroutine multibody(ecorr)
C This subroutine calculates multi-body contributions to energy following
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision gx(3),gx1(3)
logical lprn
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision gx(3),gx1(3)
logical lprn
lprn=.false.
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
double precision gx(3),gx1(3)
logical lprn,ldone
include 'COMMON.LOCAL'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.CHAIN'
include 'COMMON.CONTROL'
include 'COMMON.SHIELD'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.SHIELD'
include 'COMMON.CONTROL'
double precision gx(3),gx1(3)
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
include 'COMMON.DERIV'
include 'COMMON.INTERACT'
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+ include 'COMMON.CORRMAT'
include 'COMMON.TORSION'
include 'COMMON.VAR'
include 'COMMON.GEO'
cd write (2,*) 'eel_turn6',ekont*eel_turn6
return
end
-
+#endif
crc-------------------------------------------------
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
subroutine Eliptransfer(eliptran)
double precision facont,gacont
common /contacts/ ncont,ncont_ref,icont(2,maxcont),
& icont_ref(2,maxcont)
- common /contacts1/ facont(maxconts,maxres),
- & gacont(3,maxconts,maxres),
- & num_cont(maxres),jcont(maxconts,maxres)
-C 12/26/95 - H-bonding contacts
- common /contacts_hb/
- & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres),
- & gacontp_hb3(3,maxconts,maxres),
- & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres),
- & gacontm_hb3(3,maxconts,maxres),
- & gacont_hbr(3,maxconts,maxres),
- & grij_hb_cont(3,maxconts,maxres),
- & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
- & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
- & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
-C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
-C interactions
-C Interactions of pseudo-dipoles generated by loc-el interactions.
- double precision dip,dipderg,dipderx
- common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres),
- & dipderx(3,5,4,maxconts,maxres)
-C 10/30/99 Added other pre-computed vectors and matrices needed
-C to calculate three - six-order el-loc correlation terms
- double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der,
- & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,gmu,gUb2,
- & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der,
- & gtEUg
- common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres),
- & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres),
- & obrot_der(2,maxres),obrot2_der(2,maxres)
-C This common block contains vectors and matrices dependent on a single
-C amino-acid residue.
- common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres),
- & gmu(2,maxres),gUb2(2,maxres),
- & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres),
- & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres),
- & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres),
- & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres),
- & gtEUg(2,2,maxres)
-C This common block contains vectors and matrices dependent on two
-C consecutive amino-acid residues.
- double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC,
- & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder
- common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres),
- & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres),
- & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres),
- & DtUg2EUg(2,2,maxres),DtUg2EUgder(2,2,2,maxres),
- & Ug2DtEUg(2,2,maxres),Ug2DtEUgder(2,2,2,maxres)
- double precision costab,sintab,costab2,sintab2
- common /rotat_old/ costab(maxres),sintab(maxres),
- & costab2(maxres),sintab2(maxres),muder(2,maxres)
-C This common block contains dipole-interaction matrices and their
-C Cartesian derivatives.
- double precision a_chuj,a_chuj_der
- common /dipmat/ a_chuj(2,2,maxconts,maxres),
- & a_chuj_der(2,2,3,5,maxconts,maxres)
- double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx,
- & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx,
- & AEAb2,AEAb2derg,AEAb2derx
- common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2),
- & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2),
- & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2),
- & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2),
- & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2),
- & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2),
- & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2),
- & g_contij(3,2),ekont
EEold(2,2,-i)=-b(10,i)+b(11,i)
EEold(2,1,-i)=-b(12,i)+b(13,i)
EEold(1,2,-i)=-b(12,i)-b(13,i)
-c write(iout,*) "TU DOCHODZE"
-c print *,"JESTEM"
+ write(iout,*) "TU DOCHODZE"
+ print *,"JESTEM"
c ee(1,1,i)=1.0d0
c ee(2,2,i)=1.0d0
c ee(2,1,i)=0.0d0
do irec=nnt,nct ! loop for reading res sim
if (read2sigma) then
read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp,
+ & idomain_tmp,
& rescore3_tmp,idomain_tmp
i_tmp=i_tmp+nnt-1
idomain(k,i_tmp)=idomain_tmp
rescore(k,i_tmp)=rescore_tmp
rescore2(k,i_tmp)=rescore2_tmp
rescore3(k,i_tmp)=rescore3_tmp
- write(iout,'(a7,i5,3f10.5,i5)') "rescore",
+ write(iout,'(a7,i5,2f10.5,i5)') "rescore",
& i_tmp,rescore2_tmp,rescore_tmp,
& rescore3_tmp,idomain_tmp
else
c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i)
c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i)
c write(iout,*) "rescore(",k,i,") =",rescore(k,i)
+c sigma_d(k,i)=rescore(k,i) ! right expression ?
sigma_d(k,i)=rescore3(k,i) ! right expression ?
if (sigma_d(k,i).ne.0)
& sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
projects / unres.git / commitdiff