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)
- 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
+ double precision uy,uz,uygrad,uzgrad
common /vectors/ uy(3,maxres),uz(3,maxres),
& uygrad(3,3,2,maxres),uzgrad(3,3,2,maxres)
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
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)
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
& 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
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} ${object_lbfgs} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a
+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
--- /dev/null
+ subroutine check_ecartint
+! Check the gradient of the energy in Cartesian coordinates.
+ implicit none
+ include 'DIMENSIONS'
+ include 'COMMON.CONTROL'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.DERIV'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.VAR'
+ include 'COMMON.CONTACTS'
+ include 'COMMON.MD'
+ include 'COMMON.LOCAL'
+ include 'COMMON.SPLITELE'
+ integer icall
+ common /srutu/ icall
+ 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 ddc1(3),ddcn(3),dcnorm_safe1(3),dcnorm_safe2(3)
+ double precision energia(0:n_ene),energia1(0:n_ene)
+ integer uiparm(1)
+ double precision urparm(1)
+ double precision fdum
+ external fdum
+ integer i,j,k,nf
+ double precision etot,etot1,etot2,etot11,etot12,etot21,etot22
+ double precision dist,alpha,beta
+ icg=1
+ nf=0
+ nfl=0
+ call intout
+! call intcartderiv
+! call checkintcartgrad
+ call zerograd
+ aincr=1.0D-5
+ write(iout,*) 'Calling CHECK_ECARTINT.'
+ nf=0
+ icall=0
+ write (iout,*) "Before geom_to_var"
+ call geom_to_var(nvar,x)
+ write (iout,*) "after geom_to_var"
+ write (iout,*) "split_ene ",split_ene
+ call flush(iout)
+ if (.not.split_ene) then
+ write(iout,*) 'Calling CHECK_ECARTINT if'
+ call etotal(energia)
+!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
+ etot=energia(0)
+ write (iout,*) "etot",etot
+ call enerprint(energia(0))
+ call flush(iout)
+!el call enerprint(energia)
+!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
+c call flush(iout)
+c write (iout,*) "enter cartgrad"
+c call flush(iout)
+ call cartgrad
+c Transform the gradient to the CA-SC basis
+ call grad_transform
+!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
+c write (iout,*) "exit cartgrad"
+c call flush(iout)
+ icall =1
+c do i=1,nres
+c write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
+c enddo
+ do j=1,3
+ grad_s(j,0)=gcart(j,0)
+ enddo
+!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
+ do i=1,nres
+ do j=1,3
+ grad_s(j,i)=gcart(j,i)
+ grad_s(j+3,i)=gxcart(j,i)
+ enddo
+ enddo
+ else
+c write(iout,*) 'Calling CHECK_ECARTIN else.'
+!- split gradient check
+ call zerograd
+ call etotal_long(energia)
+ call enerprint(energia(0))
+!el call enerprint(energia)
+c call flush(iout)
+c write (iout,*) "enter cartgrad"
+c call flush(iout)
+ call cartgrad
+c Transform the gradient to CA-SC coordinates
+ call grad_transform
+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),
+ & (gxcart(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s(j,0)=gcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s(j,i)=gcart(j,i)
+ grad_s(j+3,i)=gxcart(j,i)
+ enddo
+ enddo
+ call zerograd
+ call etotal_short(energia)
+ call enerprint(energia(0))
+ call flush(iout)
+c write (iout,*) "enter cartgrad"
+c call flush(iout)
+ call cartgrad
+c write (iout,*) "exit cartgrad"
+c call flush(iout)
+c Transform the gradient to CA-SC basis
+ call grad_transform
+ 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),
+ & (gxcart(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s1(j,0)=gcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s1(j,i)=gcart(j,i)
+ grad_s1(j+3,i)=gxcart(j,i)
+ enddo
+ enddo
+ endif
+ write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
+! do i=1,nres
+c do i=nnt,nct
+ do i=1,nres
+ do j=1,3
+ if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
+ if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
+ ddc(j)=c(j,i)
+ ddx(j)=c(j,i+nres)
+ dcnorm_safe1(j)=dc_norm(j,i-1)
+ dcnorm_safe2(j)=dc_norm(j,i)
+ dxnorm_safe(j)=dc_norm(j,i+nres)
+ enddo
+ do j=1,3
+ c(j,i)=ddc(j)+aincr
+ if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
+ if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
+ if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call etotal(energia1)
+ etot1=energia1(0)
+c write (iout,*) "ij",i,j," etot1",etot1
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot11=energia1(0)
+ call etotal_short(energia1)
+ etot12=energia1(0)
+ endif
+!- end split gradient
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
+ c(j,i)=ddc(j)-aincr
+ if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
+ if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
+ if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call etotal(energia1)
+ etot2=energia1(0)
+c write (iout,*) "ij",i,j," etot2",etot2
+ ggg(j)=(etot1-etot2)/(2*aincr)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot21=energia1(0)
+ ggg(j)=(etot11-etot21)/(2*aincr)
+ call etotal_short(energia1)
+ etot22=energia1(0)
+ ggg1(j)=(etot12-etot22)/(2*aincr)
+!- end split gradient
+! write (iout,*) "etot21",etot21," etot22",etot22
+ endif
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
+ c(j,i)=ddc(j)
+ if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
+ if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
+ if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ dc_norm(j,i-1)=dcnorm_safe1(j)
+ dc_norm(j,i)=dcnorm_safe2(j)
+ dc_norm(j,i+nres)=dxnorm_safe(j)
+ enddo
+ do j=1,3
+ c(j,i+nres)=ddx(j)+aincr
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call etotal(energia1)
+ etot1=energia1(0)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot11=energia1(0)
+ call etotal_short(energia1)
+ etot12=energia1(0)
+ endif
+!- end split gradient
+ c(j,i+nres)=ddx(j)-aincr
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call etotal(energia1)
+ etot2=energia1(0)
+ ggg(j+3)=(etot1-etot2)/(2*aincr)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot21=energia1(0)
+ ggg(j+3)=(etot11-etot21)/(2*aincr)
+ call etotal_short(energia1)
+ etot22=energia1(0)
+ ggg1(j+3)=(etot12-etot22)/(2*aincr)
+!- end split gradient
+ endif
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
+ c(j,i+nres)=ddx(j)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ dc_norm(j,i+nres)=dxnorm_safe(j)
+ call int_from_cart1(.false.)
+ enddo
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
+ & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
+ if (split_ene) then
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
+ & i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),
+ & k=1,6)
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
+ & i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),
+ & ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
+ endif
+ enddo
+ return
+ end
enddo
return
end
-#ifdef FIVEDIAG
-!-----------------------------------------------------------------------------
- subroutine check_ecartint
-! Check the gradient of the energy in Cartesian coordinates.
- implicit none
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTACTS'
- include 'COMMON.MD'
- include 'COMMON.LOCAL'
- include 'COMMON.SPLITELE'
- integer icall
- common /srutu/ icall
- 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 ddc1(3),ddcn(3),dcnorm_safe1(3),dcnorm_safe2(3)
- double precision energia(0:n_ene),energia1(0:n_ene)
- integer uiparm(1)
- double precision urparm(1)
- double precision fdum
- external fdum
- integer i,j,k,nf
- double precision etot,etot1,etot2,etot11,etot12,etot21,etot22
- double precision dist,alpha,beta
- icg=1
- nf=0
- nfl=0
- call intout
-! call intcartderiv
-! call checkintcartgrad
- call zerograd
- aincr=1.0D-5
- write(iout,*) 'Calling CHECK_ECARTINT.'
- nf=0
- icall=0
- write (iout,*) "Before geom_to_var"
- call geom_to_var(nvar,x)
- write (iout,*) "after geom_to_var"
- write (iout,*) "split_ene ",split_ene
- call flush(iout)
- if (.not.split_ene) then
- write(iout,*) 'Calling CHECK_ECARTINT if'
- call etotal(energia)
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
- etot=energia(0)
- write (iout,*) "etot",etot
- call enerprint(energia(0))
- call flush(iout)
-!el call enerprint(energia)
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
-c call flush(iout)
-c write (iout,*) "enter cartgrad"
-c call flush(iout)
- call cartgrad
-c Transform the gradient to the CA-SC basis
- call grad_transform
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
-c write (iout,*) "exit cartgrad"
-c call flush(iout)
- icall =1
-c do i=1,nres
-c write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
-c enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
- enddo
- enddo
- else
-c write(iout,*) 'Calling CHECK_ECARTIN else.'
-!- split gradient check
- call zerograd
- call etotal_long(energia)
- call enerprint(energia(0))
-!el call enerprint(energia)
-c call flush(iout)
-c write (iout,*) "enter cartgrad"
-c call flush(iout)
- call cartgrad
-c Transform the gradient to CA-SC coordinates
- call grad_transform
-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),
- & (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
- enddo
- enddo
- call zerograd
- call etotal_short(energia)
- call enerprint(energia(0))
- call flush(iout)
-c write (iout,*) "enter cartgrad"
-c call flush(iout)
- call cartgrad
-c write (iout,*) "exit cartgrad"
-c call flush(iout)
-c Transform the gradient to CA-SC basis
- call grad_transform
- 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),
- & (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s1(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s1(j,i)=gcart(j,i)
- grad_s1(j+3,i)=gxcart(j,i)
- enddo
- enddo
- endif
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
-! do i=1,nres
-c do i=nnt,nct
- do i=1,nres
- do j=1,3
- if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
- if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
- ddc(j)=c(j,i)
- ddx(j)=c(j,i+nres)
- dcnorm_safe1(j)=dc_norm(j,i-1)
- dcnorm_safe2(j)=dc_norm(j,i)
- dxnorm_safe(j)=dc_norm(j,i+nres)
- enddo
- do j=1,3
- c(j,i)=ddc(j)+aincr
- if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
- if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
- if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
- dc(j,i)=c(j,i+1)-c(j,i)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call etotal(energia1)
- etot1=energia1(0)
-c write (iout,*) "ij",i,j," etot1",etot1
- else
-!- split gradient
- call etotal_long(energia1)
- etot11=energia1(0)
- call etotal_short(energia1)
- etot12=energia1(0)
- endif
-!- end split gradient
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- c(j,i)=ddc(j)-aincr
- if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
- if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
- if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
- dc(j,i)=c(j,i+1)-c(j,i)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call etotal(energia1)
- etot2=energia1(0)
-c write (iout,*) "ij",i,j," etot2",etot2
- ggg(j)=(etot1-etot2)/(2*aincr)
- else
-!- split gradient
- call etotal_long(energia1)
- etot21=energia1(0)
- ggg(j)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1)
- etot22=energia1(0)
- ggg1(j)=(etot12-etot22)/(2*aincr)
-!- end split gradient
-! write (iout,*) "etot21",etot21," etot22",etot22
- endif
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- c(j,i)=ddc(j)
- if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
- if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
- if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
- dc(j,i)=c(j,i+1)-c(j,i)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i-1)=dcnorm_safe1(j)
- dc_norm(j,i)=dcnorm_safe2(j)
- dc_norm(j,i+nres)=dxnorm_safe(j)
- enddo
- do j=1,3
- c(j,i+nres)=ddx(j)+aincr
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call etotal(energia1)
- etot1=energia1(0)
- else
-!- split gradient
- call etotal_long(energia1)
- etot11=energia1(0)
- call etotal_short(energia1)
- etot12=energia1(0)
- endif
-!- end split gradient
- c(j,i+nres)=ddx(j)-aincr
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call etotal(energia1)
- etot2=energia1(0)
- ggg(j+3)=(etot1-etot2)/(2*aincr)
- else
-!- split gradient
- call etotal_long(energia1)
- etot21=energia1(0)
- ggg(j+3)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1)
- etot22=energia1(0)
- ggg1(j+3)=(etot12-etot22)/(2*aincr)
-!- end split gradient
- endif
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- c(j,i+nres)=ddx(j)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dxnorm_safe(j)
- call int_from_cart1(.false.)
- enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
- & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
- if (split_ene) then
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
- & i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),
- & k=1,6)
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
- & i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),
- & ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
- endif
- enddo
- return
- end
-#else
c----------------------------------------------------------------------------
subroutine check_ecartint
C Check the gradient of the energy in Cartesian coordinates.
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
enddo
return
end
-#endif
c-------------------------------------------------------------------------
subroutine int_from_cart1(lprn)
implicit none
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)
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
end
C-----------------------------------------------------------------------
- double precision function sscale(r)
+ double precision function sscale(r,r_cut)
implicit none
- double precision r,gamm
+ double precision r,r_cut,gamm
include "COMMON.SPLITELE"
if(r.lt.r_cut-rlamb) then
sscale=1.0d0
return
end
C-----------------------------------------------------------------------
- double precision function sscagrad(r)
+ double precision function sscagrad(r,r_cut)
implicit none
- double precision r,gamm
+ 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.SPLITELE"
c include 'COMMON.CONTACTS'
- dimension gg(3)
+ 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
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.SPLITELE"
c include 'COMMON.CONTACTS'
- dimension gg(3)
+ 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
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
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
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
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
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
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
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
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
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.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),
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.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
-#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
+ 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.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)
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),
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
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)
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
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
+ include 'COMMON.SPLITELE'
#ifdef FOURBODY
include 'COMMON.CONTACTS'
include 'COMMON.CONTMAT'
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
+ & 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
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.NAMES'
+ 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
+ & 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
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 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 & 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
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
+ include 'COMMON.SPLITELE'
integer xshift,yshift,zshift,subchap
integer icall
common /srutu/ icall
& 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
+ & 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
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
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
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.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 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!
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.
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,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
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
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,
+ & 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,
& '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)'/
include 'COMMON.SBRIDGE'
include 'COMMON.NAMES'
include 'COMMON.IOUNITS'
+#ifdef FOURBODY
include 'COMMON.CONTACTS'
+ include 'COMMON.CONTMAT'
+#endif
double precision gg(3)
double precision evdw,evdwij
integer i,j,k,itypi,itypj,itypi1,num_conti,iint
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 & 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)
+ sssgrad=sscagrad(1.0d0/rij,r_cut_int)
c write (iout,'(a7,4f8.3)')
c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
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/sss*sssgrad*rij
c fac=0.0d0
C Calculate the radial part of the gradient
gg_lipi(3)=eps1*(eps2rt*eps2rt)
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
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
- write(iout,*),"i",i,i-2," iti",iti," iti1",iti1
+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
c mu(k,i-2)=b1(k,i-1)
c mu(k,i-2)=Ub2(k,i-2)
enddo
-#define MUOUT
#ifdef MUOUT
write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
& rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
& +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
& ((ee(l,k,i-2),l=1,2),k=1,2)
#endif
-#undef MUOUT
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
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
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),r_cut_int)
+ sssgrad=sscagrad(sqrt(rij),r_cut_int)
c if (sss.gt.0.0d0) then
rrmij=1.0D0/rij
rij=dsqrt(rij)
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"
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 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)
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
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,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
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
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)
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
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
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_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
enddo
! Correction: dummy residues
- if (nnt.gt.1) then
- do j=1,3
- gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
- enddo
- endif
- if (nct.lt.nres) then
- do j=1,3
-! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
- gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
- enddo
- endif
+ 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
integer i,j,ind
double precision zapas(MAXRES6),muca_factor
- logical lprn /.true./
+ logical lprn /.false./
integer itime
common /cipiszcze/ itime
#ifdef FIVEDIAG
d_a=0.0d0
if (lprn) then
write (iout,*) "Potential forces backbone"
- do i=nnt,nct
+ 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"
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_border(2,ichain-1))
d_a(:,chain_border(2,ichain-1))=0.0d0
enddo
+#endif
#else
inct_prev=0
do j=1,3
d_a(j,inct_prev)=d_a(j,innt)-aaux(j)
enddo
inct_prev=inct+1
-#ifdef DEBUG
- do i=innt,inct
- 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
-#else
do i=innt,inct
if (itype(i).ne.10) then
do j=1,3
d_a(j,i)=d_a(j,i+1)-d_a(j,i)
enddo
enddo
-#endif
enddo
#endif
if (lprn) then
write(iout,*) 'acceleration 3D FIVEDIAG in dC and dX'
- do i=0,nct-1
+ 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+nres,(d_a(j,i+nres),j=1,3)
+ & i,(d_a(j,i+nres),j=1,3)
enddo
endif
#else
#endif
double precision g(maxvar),f1
integer nvarx
+ double precision energia(0:n_ene)
#ifdef LBFGS
maxiter=maxmin
coordtype='CARTESIAN'
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
#ifdef FIVEDIAG
do i=nnt,nct-1
write (iout,*) itype(i+1),itype(i)
- if (itype(i+1).ne.ntyp1 .and. itype(i).eq.ntyp1) cycle
+ if (itype(i+1).ne.ntyp1 .and. itype(i).eq.ntyp1 .or.
+ & itype(i).ne.ntyp1 .and. itype(i+1).eq.ntyp1) cycle
call vecpr(vrot(1),dc(1,i),vp)
do j=1,3
d_t(j,i)=d_t(j,i)-vp(j)
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
& "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",
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)
--- /dev/null
+C Change 12/1/95 - common block CONTACTS1 included.
+ common /contacts1/ facont(maxconts,maxres),
+ & gacont(3,maxconts,maxres),
+ & num_cont(maxres),jcont(maxconts,maxres)
+C 12/26/95 - H-bonding contacts
+ double precision gacontp_hb1,gacontp_hb2,gacontp_hb3,gacont_hbr,
+ & gacontm_hb1,gacontm_hb2,gacontm_hb3,grij_hb_cont,facont_hb,
+ & ees0p,ees0m,d_cont
+ integer num_cont_hb,jcont_hb
+ 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 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,iint_sent_local
+ integer 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),
+ & 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,
+ & iturn3_sent(4,maxres),iturn4_sent(4,maxres),
+ & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres)
--- /dev/null
+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,Ug2DtEUg,Ug2DtEUgder
+ 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,EAEA,EAEAderg,EAEAderx,
+ & ADtEA1,AdTEA1derg,ADtEA1derx
+ 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
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),
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
--- /dev/null
+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 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
--- /dev/null
+C Change 12/1/95 - common block CONTACTS1 included.
+ common /contacts1/ facont(maxconts,maxres),
+ & gacont(3,maxconts,maxres),
+ & num_cont(maxres),jcont(maxconts,maxres)
+C 12/26/95 - H-bonding contacts
+ double precision gacontp_hb1,gacontp_hb2,gacontp_hb3,gacont_hbr,
+ & gacontm_hb1,gacontm_hb2,gacontm_hb3,grij_hb_cont,facont_hb,
+ & ees0p,ees0m,d_cont
+ integer num_cont_hb,jcont_hb
+ 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 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,iint_sent_local
+ integer 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),
+ & 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,
+ & iturn3_sent(4,maxres),iturn4_sent(4,maxres),
+ & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres)
--- /dev/null
+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,Ug2DtEUg,Ug2DtEUgder
+ 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,EAEA,EAEAderg,EAEAderx,
+ & ADtEA1,AdTEA1derg,ADtEA1derx
+ 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
c FP - Nov. 2014 Temporary specifications for new vars
c
- double precision rescore_tmp,x12,y12,z12,rescore2_tmp
+ double precision rescore_tmp,x12,y12,z12,rescore2_tmp,
+ & rescore3_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,
- & idomain_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,2f10.5,i5)') "rescore",
& i_tmp,rescore2_tmp,rescore_tmp,
- & idomain_tmp
+ & rescore3_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)=rescore(k,i) ! right expression ?
+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