- module energy
+ module energy
!-----------------------------------------------------------------------------
use io_units
use names
! amino-acid residue.
! common /precomp1/
real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
- Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
+ Ctobr,Ctobrder,Dtobr2,Dtobr2der,gUb2 !(2,maxres)
real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
! This common block contains vectors and matrices dependent on two
real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
DtUg2EUgder !(2,2,2,maxres)
! common /rotat_old/
+ real(kind=8),dimension(4) :: gmuij,gmuij1,gmuij2,gmuji1,gmuji2
real(kind=8),dimension(:),allocatable :: costab,sintab,&
costab2,sintab2 !(maxres)
! This common block contains dipole-interaction matrices and their
gvdwc_peppho
!------------------------------IONS GRADIENT
real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
- gradpepcat,gradpepcatx
+ gradpepcat,gradpepcatx,gradnuclcat,gradnuclcatx
! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
! include 'COMMON.TIME1'
real(kind=8) :: time00
!el local variables
- integer :: n_corr,n_corr1,ierror
+ integer :: n_corr,n_corr1,ierror,imatupdate
real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
Eafmforce,ethetacnstr
- real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
+ real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6,ehomology_constr
! now energies for nulceic alone parameters
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
ecorr3_nucl
! energies for ions
- real(kind=8) :: ecation_prot,ecationcation
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl
! energies for protein nucleic acid interaction
real(kind=8) :: escbase,epepbase,escpho,epeppho
integer ishield_listbuf(-1:nres), &
shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj
-
-
+! print *,"I START ENERGY"
+ imatupdate=100
+! if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
! real(kind=8), dimension(:),allocatable:: fac_shieldbuf
! real(kind=8), dimension(:,:,:),allocatable:: &
! grad_shield_locbuf,grad_shield_sidebuf
! allocate(ishield_listbuf(nres))
! allocate(shield_listbuf(maxcontsshi,nres))
! endif
-
+! print *,"wstrain check", wstrain
! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
! & " nfgtasks",nfgtasks
if (nfgtasks.gt.1) then
! print *,"Processor",myrank," BROADCAST iorder"
! FG master sets up the WEIGHTS_ array which will be broadcast to the
! FG slaves as WEIGHTS array.
- ! weights_(1)=wsc
+ weights_(1)=wsc
weights_(2)=wscp
weights_(3)=welec
weights_(4)=wcorr
weights_(41)=wcatcat
weights_(42)=wcatprot
weights_(46)=wscbase
- weights_(47)=wscpho
- weights_(48)=wpeppho
+ weights_(47)=wpepbase
+ weights_(48)=wscpho
+ weights_(49)=wpeppho
+ weights_(50)=wcatnucl
! wcatcat= weights(41)
! wcatprot=weights(42)
wcatcat= weights(41)
wcatprot=weights(42)
wscbase=weights(46)
- wscpho=weights(47)
- wpeppho=weights(48)
+ wpepbase=weights(47)
+ wscpho=weights(48)
+ wpeppho=weights(49)
+ wcatnucl=weights(50)
+! welpsb=weights(28)*fact(1)
+!
+! wcorr_nucl= weights(37)*fact(1)
+! wcorr3_nucl=weights(38)*fact(2)
+! wtor_nucl= weights(35)*fact(1)
+! wtor_d_nucl=weights(36)*fact(2)
+
endif
time_Bcast=time_Bcast+MPI_Wtime()-time00
time_Bcastw=time_Bcastw+MPI_Wtime()-time00
! call chainbuild_cart
endif
+! print *,"itime_mat",itime_mat,imatupdate
+ if (nfgtasks.gt.1) then
+ call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR)
+ endif
+ if (nres_molec(1).gt.0) then
+ if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list
+! write (iout,*) "after make_SCp_inter_list"
+ if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
+! write (iout,*) "after make_SCSC_inter_list"
+
+ if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list
+ endif
+! write (iout,*) "after make_pp_inter_list"
+
! print *,'Processor',myrank,' calling etotal ipot=',ipot
! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
#else
.or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
.or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
#endif
- write(iout,*),"just befor eelec call"
+! print *,"just befor eelec call"
call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-! write (iout,*) "ELEC calc"
+! print *, "ELEC calc"
else
ees=0.0d0
evdw1=0.0d0
! Calculate the virtual-bond-angle energy.
! write(iout,*) "in etotal afer edis",ipot
- if (wang.gt.0.0d0) then
- call ebend(ebe,ethetacnstr)
+! if (wang.gt.0.0d0) then
+! call ebend(ebe,ethetacnstr)
+! else
+! ebe=0
+! ethetacnstr=0
+! endif
+ if (wang.gt.0d0) then
+ if (tor_mode.eq.0) then
+ call ebend(ebe)
+ else
+!C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call ebend_kcc(ebe)
+ endif
else
- ebe=0
- ethetacnstr=0
+ ebe=0.0d0
endif
+ ethetacnstr=0.0d0
+ if (with_theta_constr) call etheta_constr(ethetacnstr)
+
! write(iout,*) "in etotal afer ebe",ipot
! print *,"Processor",myrank," computed UB"
! Calculate the virtual-bond torsional energy.
!
!d print *,'nterm=',nterm
- if (wtor.gt.0) then
- call etor(etors,edihcnstr)
+! if (wtor.gt.0) then
+! call etor(etors,edihcnstr)
+! else
+! etors=0
+! edihcnstr=0
+! endif
+ if (wtor.gt.0.0d0) then
+ if (tor_mode.eq.0) then
+ call etor(etors)
+ else
+!C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call etor_kcc(etors)
+ endif
else
- etors=0
- edihcnstr=0
+ etors=0.0d0
endif
+ edihcnstr=0.0d0
+ if (ndih_constr.gt.0) call etor_constr(edihcnstr)
+!c print *,"Processor",myrank," computed Utor"
+
! print *,"Processor",myrank," computed Utor"
-
+ if (constr_homology.ge.1) then
+ call e_modeller(ehomology_constr)
+! print *,'iset=',iset,'me=',me,ehomology_constr,
+! & 'Processor',fg_rank,' CG group',kolor,
+! & ' absolute rank',MyRank
+! print *,"tu"
+ else
+ ehomology_constr=0.0d0
+ endif
+
!
! 6/23/01 Calculate double-torsional energy
!
!
! If performing constraint dynamics, call the constraint energy
! after the equilibration time
- if(usampl.and.totT.gt.eq_time) then
-!elwrite(iout,*) "afeter multibody hb"
+ if((usampl).and.(totT.gt.eq_time)) then
+ write(iout,*) "usampl",usampl
call EconstrQ
!elwrite(iout,*) "afeter multibody hb"
call Econstr_back
call AFMforce(Eafmforce)
else if (selfguide.gt.0) then
call AFMvel(Eafmforce)
+ else
+ Eafmforce=0.0d0
endif
endif
if (tubemode.eq.1) then
call epsb(evdwpsb,eelpsb)
call esb(esbloc)
call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
+ call ecat_nucl(ecation_nucl)
else
etors_nucl=0.0d0
estr_nucl=0.0d0
ecorr3_nucl=0.0d0
+ ecorr_nucl=0.0d0
ebe_nucl=0.0d0
evdwsb=0.0d0
eelsb=0.0d0
eelpsb=0.0d0
evdwpp=0.0d0
eespp=0.0d0
+ etors_d_nucl=0.0d0
+ ecation_nucl=0.0d0
endif
! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
+! print *,"before ecatcat",wcatcat
+ if (nres_molec(5).gt.0) then
if (nfgtasks.gt.1) then
if (fg_rank.eq.0) then
call ecatcat(ecationcation)
else
call ecatcat(ecationcation)
endif
+ if (oldion.gt.0) then
call ecat_prot(ecation_prot)
- if (nres_molec(2).gt.0) then
+ else
+ call ecats_prot_amber(ecation_prot)
+ endif
+ else
+ ecationcation=0.0d0
+ ecation_prot=0.0d0
+ endif
+ if ((nres_molec(2).gt.0).and.(nres_molec(1).gt.0)) then
call eprot_sc_base(escbase)
call epep_sc_base(epepbase)
call eprot_sc_phosphate(escpho)
epeppho=0.0
endif
! call ecatcat(ecationcation)
-! print *,"after ebend", ebe_nucl
+! print *,"after ebend", wtor_nucl
#ifdef TIMING
time_enecalc=time_enecalc+MPI_Wtime()-time00
#endif
! Here are the energies showed per procesor if the are more processors
! per molecule then we sum it up in sum_energy subroutine
! print *," Processor",myrank," calls SUM_ENERGY"
- energia(41)=ecation_prot
- energia(42)=ecationcation
+ energia(42)=ecation_prot
+ energia(41)=ecationcation
energia(46)=escbase
energia(47)=epepbase
energia(48)=escpho
energia(49)=epeppho
+! energia(50)=ecations_prot_amber
+ energia(50)=ecation_nucl
+ energia(51)=ehomology_constr
call sum_energy(energia,.true.)
if (dyn_ss) call dyn_set_nss
! print *," Processor",myrank," left SUM_ENERGY"
eliptran,etube, Eafmforce,ethetacnstr
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
- ecorr3_nucl
- real(kind=8) :: ecation_prot,ecationcation
+ ecorr3_nucl,ehomology_constr
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl
real(kind=8) :: escbase,epepbase,escpho,epeppho
integer :: i
#ifdef MPI
etors_d_nucl=energia(36)
ecorr_nucl=energia(37)
ecorr3_nucl=energia(38)
- ecation_prot=energia(41)
- ecationcation=energia(42)
+ ecation_prot=energia(42)
+ ecationcation=energia(41)
escbase=energia(46)
epepbase=energia(47)
escpho=energia(48)
epeppho=energia(49)
+ ecation_nucl=energia(50)
+ ehomology_constr=energia(51)
+! ecations_prot_amber=energia(50)
+
! energia(41)=ecation_prot
! energia(42)=ecationcation
+wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
+wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
+wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
- +Eafmforce+ethetacnstr &
+ +Eafmforce+ethetacnstr+ehomology_constr &
+wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
+wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
+wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
+wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
+wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
- +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
+ +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl
#else
etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
+wang*ebe+wtor*etors+wscloc*escloc &
+wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
+wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
+wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
- +Eafmforce+ethetacnstr &
+ +Eafmforce+ethetacnstr+ehomology_constr &
+wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
+wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
+wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
+wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
+wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
- +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
+ +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl
#endif
energia(0)=etot
! detecting NaNQ
wtor=weights(13)*fact(1)
wtor_d=weights(14)*fact(2)
wsccor=weights(21)*fact(1)
-
+ welpsb=weights(28)*fact(1)
+ wcorr_nucl= weights(37)*fact(1)
+ wcorr3_nucl=weights(38)*fact(2)
+ wtor_nucl= weights(35)*fact(1)
+ wtor_d_nucl=weights(36)*fact(2)
+ wpepbase=weights(47)*fact(1)
return
end subroutine rescale_weights
!-----------------------------------------------------------------------------
etube,ethetacnstr,Eafmforce
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
- ecorr3_nucl
- real(kind=8) :: ecation_prot,ecationcation
+ ecorr3_nucl,ehomology_constr
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl
real(kind=8) :: escbase,epepbase,escpho,epeppho
etot=energia(0)
etors_d_nucl=energia(36)
ecorr_nucl=energia(37)
ecorr3_nucl=energia(38)
- ecation_prot=energia(41)
- ecationcation=energia(42)
+ ecation_prot=energia(42)
+ ecationcation=energia(41)
escbase=energia(46)
epepbase=energia(47)
escpho=energia(48)
epeppho=energia(49)
+ ecation_nucl=energia(50)
+ ehomology_constr=energia(51)
+
+! ecations_prot_amber=energia(50)
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
estr,wbond,ebe,wang,&
etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
- etot
+ ecation_nucl,wcatnucl,ehomology_constr,etot
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
+ 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
+ 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/&
'ETOT= ',1pE16.6,' (total)')
#else
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
ecorr,wcorr,&
ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
- ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
- etube,wtube, &
+ ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforce, &
+ etube,wtube, ehomology_constr,&
estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
- evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
- evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
+ evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
+ evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
- etot
+ ecation_nucl,wcatnucl,ehomology_constr,etot
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
+ 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
+ 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/&
'ETOT= ',1pE16.6,' (total)')
#endif
return
integer :: num_conti
!el local variables
integer :: i,itypi,iint,j,itypi1,itypj,k
- real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
+ real(kind=8) :: rij,rcut,fcont,fprimcont,rrij,sslipi,ssgradlipi,&
+ aa,bb,sslipj,ssgradlipj
real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
! Change 12/1/95
num_conti=0
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
! Change 12/1/95 to calculate four-body interactions
rij=xj*xj+yj*yj+zj*zj
rrij=1.0D0/rij
logical :: scheck
!el local variables
integer :: i,iint,j,itypi,itypi1,k,itypj
- real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
+ real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij, &
+ sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi
+ real(kind=8) :: rrij,xi,yi,zi, sslipi,ssgradlipi, sslipj, &
+ ssgradlipj, aa, bb
real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! include 'COMMON.SBRIDGE'
logical :: lprn
!el local variables
- integer :: iint,itypi,itypi1,itypj,subchap
+ integer :: iint,itypi,itypi1,itypj,subchap,icont
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
dCAVdOM1=0.0d0
dGCLdOM1=0.0d0
dPOLdOM1=0.0d0
-
-
- do i=iatsc_s,iatsc_e
+! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
+ if (nres_molec(1).eq.0) return
+ do icont=g_listscsc_start,g_listscsc_end
+ i=newcontlisti(icont)
+ j=newcontlistj(icont)
+! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
+! do i=iatsc_s,iatsc_e
!C print *,"I am in EVDW",i
itypi=iabs(itype(i,1))
! if (i.ne.47) cycle
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-! print *, sslipi,ssgradlipi
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
!
! Calculate SC interaction energy.
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+! do iint=1,nint_gr(i)
+! do j=istart(i,iint),iend(i,iint)
IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
call dyn_ssbond_ene(i,j,evdwij)
evdw=evdw+evdwij
'evdw',i,j,evdwij,' ss'
! if (energy_dec) write (iout,*) &
! 'evdw',i,j,evdwij,' ss'
- do k=j+1,iend(i,iint)
+ do k=j+1,nres
!C search over all next residues
if (dyn_ss_mask(k)) then
!C check if they are cysteins
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
-! print *,"tu",xi,yi,zi,xj,yj,zj
-! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
-! this fragment set correct epsilon for lipid phase
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-!------------------------------------------------
- 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
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! write (iout,*) "KWA2", itypi,itypj
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
- sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
! print *,sss_ele_cut,sss_ele_grad,&
! 1.0d0/(rij),r_cut_ele,rlamb_ele
if (sss_ele_cut.le.0.0) cycle
fac=rij*fac
! print *,'before fac',fac,rij,evdwij
fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
- /sigma(itypi,itypj)*rij
+ *rij
! print *,'grad part scale',fac, &
! evdwij*sss_ele_grad/sss_ele_cut &
! /sigma(itypi,itypj)*rij
! Calculate angular part of the gradient.
call sc_grad
ENDIF ! dyn_ss
- enddo ! j
- enddo ! iint
+! enddo ! j
+! enddo ! iint
enddo ! i
! print *,"ZALAMKA", evdw
! write (iout,*) "Number of loop steps in EGB:",ind
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
+ real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2, &
+ sigm,sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
!
! Calculate SC interaction energy.
!
do j=istart(i,iint),iend(i,iint)
itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ xj=boxshift(c(1,nres+j)-xi,boxxsize)
+ yj=boxshift(c(2,nres+j)-yi,boxysize)
+ zj=boxshift(c(3,nres+j)-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
r0ij=r0(itypi,itypj)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
num_conti=0
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
xj=c(1,j)+0.5D0*dxj-xmedi
yj=c(2,j)+0.5D0*dyj-ymedi
zj=c(3,j)+0.5D0*dzj-zmedi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
if (rij.lt.r0ijsq) then
evdw1ij=0.25d0*(rij-r0ijsq)**2
! include 'COMMON.FFIELD'
real(kind=8) :: auxvec(2),auxmat(2,2)
integer :: i,iti1,iti,k,l
- real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
+ real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2,cost1,sint1,&
+ sint1sq,sint1cub,sint1cost1,b1k,b2k,aux
! print *,"in set matrices"
!
! Compute the virtual-bond-torsional-angle dependent quantities needed
! to calculate the el-loc multibody terms of various order.
!
!AL el mu=0.0d0
+
+#ifdef PARMAT
+ do i=ivec_start+2,ivec_end+2
+#else
+ do i=3,nres+1
+#endif
+ if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ if (itype(i-2,1).eq.0) then
+ iti = nloctyp
+ else
+ iti = itype2loc(itype(i-2,1))
+ endif
+ 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
+ iti1 = itype2loc(itype(i-1,1))
+ else
+ iti1=nloctyp
+ endif
+! print *,i,itype(i-2,1),iti
+#ifdef NEWCORR
+ cost1=dcos(theta(i-1))
+ sint1=dsin(theta(i-1))
+ sint1sq=sint1*sint1
+ sint1cub=sint1sq*sint1
+ sint1cost1=2*sint1*cost1
+! print *,"cost1",cost1,theta(i-1)
+!c write (iout,*) "bnew1",i,iti
+!c write (iout,*) (bnew1(k,1,iti),k=1,3)
+!c write (iout,*) (bnew1(k,2,iti),k=1,3)
+!c write (iout,*) "bnew2",i,iti
+!c write (iout,*) (bnew2(k,1,iti),k=1,3)
+!c write (iout,*) (bnew2(k,2,iti),k=1,3)
+ k=1
+! print *,bnew1(1,k,iti),"bnew1"
+ do k=1,2
+ b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
+! print *,b1k
+! write(*,*) shape(b1)
+! if(.not.allocated(b1)) print *, "WTF?"
+ b1(k,i-2)=sint1*b1k
+!
+! print *,b1(k,i-2)
+
+ gtb1(k,i-2)=cost1*b1k-sint1sq*&
+ (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
+! print *,gtb1(k,i-2)
+
+ b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
+ b2(k,i-2)=sint1*b2k
+! print *,b2(k,i-2)
+
+ gtb2(k,i-2)=cost1*b2k-sint1sq*&
+ (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
+! print *,gtb2(k,i-2)
+
+ enddo
+! print *,b1k,b2k
+ do k=1,2
+ aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
+ cc(1,k,i-2)=sint1sq*aux
+ gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*&
+ (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
+ aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
+ dd(1,k,i-2)=sint1sq*aux
+ gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*&
+ (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
+ enddo
+! print *,"after cc"
+ cc(2,1,i-2)=cc(1,2,i-2)
+ cc(2,2,i-2)=-cc(1,1,i-2)
+ gtcc(2,1,i-2)=gtcc(1,2,i-2)
+ gtcc(2,2,i-2)=-gtcc(1,1,i-2)
+ dd(2,1,i-2)=dd(1,2,i-2)
+ dd(2,2,i-2)=-dd(1,1,i-2)
+ gtdd(2,1,i-2)=gtdd(1,2,i-2)
+ gtdd(2,2,i-2)=-gtdd(1,1,i-2)
+! print *,"after dd"
+
+ do k=1,2
+ do l=1,2
+ aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
+ EE(l,k,i-2)=sint1sq*aux
+ gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
+ enddo
+ enddo
+ EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
+ EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
+ EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
+ EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
+ gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
+ gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
+ gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
+! print *,"after ee"
+
+!c b1tilde(1,i-2)=b1(1,i-2)
+!c b1tilde(2,i-2)=-b1(2,i-2)
+!c b2tilde(1,i-2)=b2(1,i-2)
+!c b2tilde(2,i-2)=-b2(2,i-2)
+#ifdef DEBUG
+ write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
+ write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
+ write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
+ write (iout,*) 'theta=', theta(i-1)
+#endif
+#else
+ if (i.gt. nnt+2 .and. i.lt.nct+2) then
+! write(iout,*) "i,",molnum(i),nloctyp
+! print *, "i,",molnum(i),i,itype(i-2,1)
+ if (molnum(i).eq.1) then
+ if (itype(i-2,1).eq.ntyp1) then
+ iti=nloctyp
+ else
+ iti = itype2loc(itype(i-2,1))
+ endif
+ else
+ iti=nloctyp
+ endif
+ else
+ iti=nloctyp
+ endif
+!c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
+!c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
+ if (i.gt. nnt+1 .and. i.lt.nct+1) then
+ iti1 = itype2loc(itype(i-1,1))
+ else
+ iti1=nloctyp
+ endif
+! print *,i,iti
+ b1(1,i-2)=b(3,iti)
+ b1(2,i-2)=b(5,iti)
+ b2(1,i-2)=b(2,iti)
+ b2(2,i-2)=b(4,iti)
+ do k=1,2
+ do l=1,2
+ CC(k,l,i-2)=ccold(k,l,iti)
+ DD(k,l,i-2)=ddold(k,l,iti)
+ EE(k,l,i-2)=eeold(k,l,iti)
+ enddo
+ enddo
+#endif
+ b1tilde(1,i-2)= b1(1,i-2)
+ b1tilde(2,i-2)=-b1(2,i-2)
+ b2tilde(1,i-2)= b2(1,i-2)
+ b2tilde(2,i-2)=-b2(2,i-2)
+!c
+ Ctilde(1,1,i-2)= CC(1,1,i-2)
+ Ctilde(1,2,i-2)= CC(1,2,i-2)
+ Ctilde(2,1,i-2)=-CC(2,1,i-2)
+ Ctilde(2,2,i-2)=-CC(2,2,i-2)
+!c
+ Dtilde(1,1,i-2)= DD(1,1,i-2)
+ Dtilde(1,2,i-2)= DD(1,2,i-2)
+ Dtilde(2,1,i-2)=-DD(2,1,i-2)
+ Dtilde(2,2,i-2)=-DD(2,2,i-2)
+ enddo
#ifdef PARMAT
do i=ivec_start+2,ivec_end+2
#else
do i=3,nres+1
#endif
+
! print *,i,"i"
if (i .lt. nres+1) then
sin1=dsin(phi(i))
if (itype(i-2,1).eq.0) then
iti=ntortyp+1
else
- iti = itortyp(itype(i-2,1))
+ iti = itype2loc(itype(i-2,1))
endif
else
- iti=ntortyp+1
+ iti=nloctyp
endif
! 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 (itype(i-1,1).eq.0) then
- iti1=ntortyp+1
+ iti1=nloctyp
else
- iti1 = itortyp(itype(i-1,1))
+ iti1 = itype2loc(itype(i-1,1))
endif
else
- iti1=ntortyp+1
+ iti1=nloctyp
endif
! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
!d write (iout,*) '*******i',i,' iti1',iti
-!d write (iout,*) 'b1',b1(:,iti)
-!d write (iout,*) 'b2',b2(:,iti)
+! write (iout,*) 'b1',b1(:,iti)
+! write (iout,*) 'b2',b2(:,i-2)
!d write (iout,*) 'Ug',Ug(:,:,i-2)
! if (i .gt. iatel_s+2) then
if (i .gt. nnt+2) then
- call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
- call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
+ call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
+#ifdef NEWCORR
+ call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
+!c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
+#endif
+
+ call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
+ call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
then
- call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
- call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
+ call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
+ call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
+ call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(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
else
do k=1,2
enddo
enddo
endif
- call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
- call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
+ call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
+ call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
do k=1,2
muder(k,i-2)=Ub2der(k,i-2)
enddo
! 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 (itype(i-1,1).eq.0) then
- iti1=ntortyp+1
+ iti1=nloctyp
elseif (itype(i-1,1).le.ntyp) then
- iti1 = itortyp(itype(i-1,1))
+ iti1 = itype2loc(itype(i-1,1))
else
- iti1=ntortyp+1
+ iti1=nloctyp
endif
else
- iti1=ntortyp+1
+ iti1=nloctyp
endif
do k=1,2
- mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
+ mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
enddo
-! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
-! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
-! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
+ if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
+ if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,i-1)
+ if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
!d write (iout,*) 'mu1',mu1(:,i-2)
!d write (iout,*) 'mu2',mu2(:,i-2)
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
then
- call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
- call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
+ call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
+ call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
+ call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
+ call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
+ call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
! Vectors and matrices dependent on a single virtual-bond dihedral.
- call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
+ call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
+ call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
+ call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
0.0d0,1.0d0,0.0d0,&
0.0d0,0.0d0,1.0d0/),shape(unmat))
!el local variables
- integer :: i,k,j
+ integer :: i,k,j,icont
real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
real(kind=8) :: fac,t_eelecij,fracinbuf
eel_loc=0.0d0
eello_turn3=0.0d0
eello_turn4=0.0d0
+ if (nres_molec(1).eq.0) return
!
if (icheckgrad.eq.1) then
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=0
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-! print *,i,sslipi,ssgradlipi
call eelecij(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
num_cont_hb(i)=num_conti
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=num_cont_hb(i)
call eelecij(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
- call eturn4(i,eello_turn4)
+ call eturn4(i,eello_turn4)
! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
num_cont_hb(i)=num_conti
enddo ! i
! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
!
! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
- do i=iatel_s,iatel_e
+! do i=iatel_s,iatel_e
+! JPRDLC
+ do icont=g_listpp_start,g_listpp_end
+ i=newcontlistppi(icont)
+ j=newcontlistppj(icont)
if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
+! do j=ielstart(i),ielend(i)
! write (iout,*) i,j,itype(i,1),itype(j,1)
if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
- enddo ! j
+! enddo ! j
num_cont_hb(i)=num_conti
enddo ! i
! write (iout,*) "Number of loop steps in EELEC:",ind
real(kind=8),dimension(2,2) :: acipa !el,a_temp
!el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
real(kind=8),dimension(4) :: muij
+ real(kind=8) :: geel_loc_ij,geel_loc_ji
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
dist_temp, dist_init,rlocshield,fracinbuf
integer xshift,yshift,zshift,ilist,iresshield
!el local variables
integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
+ real(kind=8) :: faclipij2, faclipij
real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
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
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- 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
-!C print *,i,j
- 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
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
! sss_ele_grad=0.0d0
! print *,sss_ele_cut,sss_ele_grad,&
! (rij),r_cut_ele,rlamb_ele
-! if (sss_ele_cut.le.0.0) go to 128
+ if (sss_ele_cut.le.0.0) go to 128
rmij=1.0D0/rij
r3ij=rrmij*rmij
!grad enddo
!grad enddo
! 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj &
+ ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- ggg(2)=facvdw*yj &
+ ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- ggg(3)=facvdw*zj &
+ ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
do k=1,3
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)
+!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)
+!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)
+#endif
+
enddo
enddo
!d write (iout,*) 'EELEC: i',i,' j',j
enddo
endif
+#ifdef NEWCORR
+ geel_loc_ij=(a22*gmuij1(1)&
+ +a23*gmuij1(2)&
+ +a32*gmuij1(3)&
+ +a33*gmuij1(4))&
+ *fac_shield(i)*fac_shield(j)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+!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)+&
+ 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=&
+ a22*gmuij2(1)&
+ +a23*gmuij2(2)&
+ +a32*gmuij2(3)&
+ +a33*gmuij2(4)
+ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+&
+ geel_loc_ij*wel_loc&
+ *fac_shield(i)*fac_shield(j)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+!c Derivative over j residue
+ geel_loc_ji=a22*gmuji1(1)&
+ +a23*gmuji1(2)&
+ +a32*gmuji1(3)&
+ +a33*gmuji1(4)
+!c write(iout,*) "derivative over thataj"
+!c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
+!c & a33*gmuji1(4)
+
+ gloc(nphi+j,icg)=gloc(nphi+j,icg)+&
+ geel_loc_ji*wel_loc&
+ *fac_shield(i)*fac_shield(j)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+ geel_loc_ji=&
+ +a22*gmuji2(1)&
+ +a23*gmuji2(2)&
+ +a32*gmuji2(3)&
+ +a33*gmuji2(4)
+!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)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+#endif
! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
! eel_loc_ij=0.0
ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
*sss_ele_cut &
*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
*sss_ele_cut &
*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
! Diagnostics. Comment out or remove after debugging!
! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
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) &
- *sss_ele_cut*fac_shield(i)*fac_shield(j)
+ *sss_ele_cut*fac_shield(i)*fac_shield(j) ! &
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
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)&
- *sss_ele_cut*fac_shield(i)*fac_shield(j)
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)! &
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
gacontp_hb3(k,num_conti,i)=gggp(k) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
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) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
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) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
gacontm_hb3(k,num_conti,i)=gggm(k) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
enddo
! Diagnostics. Comment out or remove after debugging!
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
- e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
+ e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,gpizda1,&
+ gpizda2,auxgmat1,auxgmatt1,auxgmat2,auxgmatt2
+
real(kind=8),dimension(2) :: auxvec,auxvec1
!el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
!el num_conti,j1,j2
!el local variables
integer :: i,j,l,k,ilist,iresshield
- real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
-
+ real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield,xj,yj
+ xj=0.0d0
+ yj=0.0d0
j=i+2
! write (iout,*) "eturn3",i,j,j1,j2
zj=(c(3,j)+c(3,j+1))/2.0d0
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.lt.0)) write (*,*) "CHUJ"
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
a_temp(1,1)=a22
a_temp(1,2)=a23
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!d call checkint_turn3(i,a_temp,eello_turn3_num)
call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
+ call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
+ call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
call transpose2(auxmat(1,1),auxmat1(1,1))
+ call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
+ call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+ call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
+ call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
+
if (shield_mode.eq.0) then
fac_shield(i)=1.0d0
fac_shield(j)=1.0d0
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
+!C#ifdef NEWCORR
+!C Derivatives in theta
+ gloc(nphi+i,icg)=gloc(nphi+i,icg) &
+ +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+ gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)&
+ +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+!C#endif
+
+
+
if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
(shield_mode.gt.0)) then
!C print *,i,j
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
- e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
- real(kind=8),dimension(2) :: auxvec,auxvec1
+ e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,&
+ gte1t,gte2t,gte3t,&
+ gte1a,gtae3,gtae3e2, ae3gte2,&
+ gtEpizda1,gtEpizda2,gtEpizda3
+
+ real(kind=8),dimension(2) :: auxvec,auxvec1,auxgEvec1,auxgEvec2,&
+ auxgEvec3,auxgvec
+
!el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
!el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
!el local variables
integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
- rlocshield
-
+ rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3,xj,yj
+ xj=0.0d0
+ yj=0.0d0
j=i+3
! if (j.ne.20) return
! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
!d call checkint_turn4(i,a_temp,eello_turn4_num)
! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
zj=(c(3,j)+c(3,j+1))/2.0d0
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+
a_temp(1,1)=a22
a_temp(1,2)=a23
a_temp(2,1)=a32
a_temp(2,2)=a33
- iti1=itortyp(itype(i+1,1))
- iti2=itortyp(itype(i+2,1))
- iti3=itortyp(itype(i+3,1))
+ iti1=i+1
+ iti2=i+2
+ iti3=i+3
! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
call transpose2(EUg(1,1,i+1),e1t(1,1))
call transpose2(Eug(1,1,i+2),e2t(1,1))
call transpose2(Eug(1,1,i+3),e3t(1,1))
+!C Ematrix derivative in theta
+ call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
+ call transpose2(gtEug(1,1,i+2),gte2t(1,1))
+ call transpose2(gtEug(1,1,i+3),gte3t(1,1))
+
call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+ call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
+ call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
+!c auxalary matrix of E i+1
+ call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
s1=scalar2(b1(1,iti2),auxvec(1))
+!c derivative of theta i+2 with constant i+3
+ gs23=scalar2(gtb1(1,i+2),auxvec(1))
+!c derivative of theta i+2 with constant i+2
+ gs32=scalar2(b1(1,i+2),auxgvec(1))
+!c derivative of E matix in theta of i+1
+ gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
+
call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+ call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
+!c auxilary matrix auxgvec of Ub2 with constant E matirx
+ call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
+!c auxilary matrix auxgEvec1 of E matix with Ub2 constant
+ call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
+ s2=scalar2(b1(1,i+1),auxvec(1))
+!c derivative of theta i+1 with constant i+3
+ gs13=scalar2(gtb1(1,i+1),auxvec(1))
+!c derivative of theta i+2 with constant i+1
+ gs21=scalar2(b1(1,i+1),auxgvec(1))
+!c derivative of theta i+3 with constant i+1
+ gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
+
call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+ call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
+!c ae3gte2 is derivative over i+2
+ call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
+
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+ call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
+!c i+2
+ call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
+!c i+3
+ call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
+
s3=0.5d0*(pizda(1,1)+pizda(2,2))
+ gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
+ gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
+ gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
if (shield_mode.eq.0) then
fac_shield(i)=1.0
fac_shield(j)=1.0
! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1)
enddo
endif
+#ifdef NEWCORR
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)&
+ -(gs13+gsE13+gsEE1)*wturn4&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+ gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)&
+ -(gs23+gs21+gsEE2)*wturn4&
+ *fac_shield(i)*fac_shield(j)&
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+ gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)&
+ -(gs32+gsE31+gsEE3)*wturn4&
+ *fac_shield(i)*fac_shield(j)&
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+!c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
+!c & gs2
+#endif
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
'eturn4',i,j,-(s1+s2+s3)
!d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
call transpose2(EUgder(1,1,i+1),e1tder(1,1))
call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
+ s1=scalar2(b1(1,i+1),auxvec(1))
call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
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))
+ call to_box(xi,yi,zi)
do iint=1,nscp_gr(i)
xj=c(1,j)-xi
yj=c(2,j)-yi
zj=c(3,j)-zi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
r0ij=r0_scp
r0ijsq=r0ij*r0ij
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
!el local variables
- integer :: i,iint,j,k,iteli,itypj,subchap
+ integer :: i,iint,j,k,iteli,itypj,subchap,icont
real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
e1,e2,evdwij,rij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
evdw2_14=0.0d0
!d print '(a)','Enter ESCP'
!d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
+! do i=iatscp_s,iatscp_e
+ if (nres_molec(1).eq.0) return
+ do icont=g_listscp_start,g_listscp_end
+ i=newcontlistscpi(icont)
+ j=newcontlistscpj(icont)
if (itype(i,1).eq.ntyp1 .or. itype(i+1,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
+ call to_box(xi,yi,zi)
- do iint=1,nscp_gr(i)
+! do iint=1,nscp_gr(i)
- do j=iscpstart(i,iint),iscpend(i,iint)
+! do j=iscpstart(i,iint),iscpend(i,iint)
itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
! Uncomment following three lines for SC-p interactions
xj=c(1,j)
yj=c(2,j)
zj=c(3,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
- 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
+
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(1.0d0/rrij)
gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
enddo
- enddo
+! enddo
- enddo ! iint
+! enddo ! iint
enddo ! i
do i=1,nct
do j=1,3
iabs(itype(jjj,1)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
-!d write (iout,*) "eij",eij
+! write (iout,*) "eij",eij,iii,jjj
endif
else if (ii.gt.nres .and. jj.gt.nres) then
!c Restraints from contact prediction
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
itypj=iabs(itype(j,1))
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
+akct*deltad*deltat12 &
+v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
-! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
-! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
-! & " deltat12",deltat12," eij",eij
+! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, &
+! " akct",akct," deltad",deltad," deltat",deltat1,deltat2, &
+! " deltat12",deltat12," eij",eij
ed=2*akcm*deltad+akct*deltat12
pom1=akct*deltad
pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
end subroutine theteng
#else
!-----------------------------------------------------------------------------
- subroutine ebend(etheta,ethetacnstr)
+ subroutine ebend(etheta)
!
! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
! angles gamma and its derivatives in consecutive thetas and gammas.
enddo
!-----------thete constrains
! if (tor_mode.ne.2) then
- ethetacnstr=0.0d0
- print *,ithetaconstr_start,ithetaconstr_end,"TU"
- do i=ithetaconstr_start,ithetaconstr_end
- itheta=itheta_constr(i)
- thetiii=theta(itheta)
- difi=pinorm(thetiii-theta_constr0(i))
- if (difi.gt.theta_drange(i)) then
- difi=difi-theta_drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
- +for_thet_constr(i)*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
- +for_thet_constr(i)*difi**3
- else
- difi=0.0
- endif
- if (energy_dec) then
- write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
- i,itheta,rad2deg*thetiii, &
- rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
- rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
- gloc(itheta+nphi-2,icg)
- endif
- enddo
-! endif
return
end subroutine ebend
! & dscp1,dscp2,sumene
! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
+ if (energy_dec) write (2,*) "i",i," itype",itype(i,1)," it",it, &
+ " escloc",sumene,escloc,it,itype(i,1)
! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
! & ,zz,xx,yy
!#define DEBUG
etors_d=0.0d0
return
end subroutine etor_d
+!-----------------------------------------------------------------------------
+c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
+ subroutine e_modeller(ehomology_constr)
+ real(kind=8) :: ehomology_constr
+ ehomology_constr=0.0d0
+ write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
+ return
+ end subroutine e_modeller
+C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
#else
!-----------------------------------------------------------------------------
- subroutine etor(etors,edihcnstr)
+ subroutine etor(etors)
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
-! do i=1,ndih_constr
+ return
+ end subroutine etor
+!C The rigorous attempt to derive energy function
+!-------------------------------------------------------------------------------------------
+ subroutine etor_kcc(etors)
+ double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
+ real(kind=8) :: etors,glocig,glocit1,glocit2,sinthet1,&
+ sinthet2,costhet1,costhet2,sint1t2,sint1t2n,phii,sinphi,cosphi,&
+ sint1t2n1,sumvalc,gradvalct1,gradvalct2,sumvals,gradvalst1,&
+ gradvalst2,etori
+ logical lprn
+ integer :: i,j,itori,itori1,nval,k,l
+
+ if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
+ etors=0.0D0
+ do i=iphi_start,iphi_end
+!C ANY TWO ARE DUMMY ATOMS in row CYCLE
+!c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
+!c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
+!c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
+ if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
+ .or. itype(i,1).eq.ntyp1 .or. itype(i-3,1).eq.ntyp1) cycle
+ itori=itortyp(itype(i-2,1))
+ itori1=itortyp(itype(i-1,1))
+ phii=phi(i)
+ glocig=0.0D0
+ glocit1=0.0d0
+ glocit2=0.0d0
+!C to avoid multiple devision by 2
+!c theti22=0.5d0*theta(i)
+!C theta 12 is the theta_1 /2
+!C theta 22 is theta_2 /2
+!c theti12=0.5d0*theta(i-1)
+!C and appropriate sinus function
+ sinthet1=dsin(theta(i-1))
+ sinthet2=dsin(theta(i))
+ costhet1=dcos(theta(i-1))
+ costhet2=dcos(theta(i))
+!C to speed up lets store its mutliplication
+ sint1t2=sinthet2*sinthet1
+ sint1t2n=1.0d0
+!C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
+!C +d_n*sin(n*gamma)) *
+!C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
+!C we have two sum 1) Non-Chebyshev which is with n and gamma
+ nval=nterm_kcc_Tb(itori,itori1)
+ c1(0)=0.0d0
+ c2(0)=0.0d0
+ c1(1)=1.0d0
+ c2(1)=1.0d0
+ do j=2,nval
+ c1(j)=c1(j-1)*costhet1
+ c2(j)=c2(j-1)*costhet2
+ enddo
+ etori=0.0d0
+
+ do j=1,nterm_kcc(itori,itori1)
+ cosphi=dcos(j*phii)
+ sinphi=dsin(j*phii)
+ sint1t2n1=sint1t2n
+ sint1t2n=sint1t2n*sint1t2
+ sumvalc=0.0d0
+ gradvalct1=0.0d0
+ gradvalct2=0.0d0
+ do k=1,nval
+ do l=1,nval
+ sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
+ gradvalct1=gradvalct1+ &
+ (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
+ gradvalct2=gradvalct2+ &
+ (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
+ enddo
+ enddo
+ gradvalct1=-gradvalct1*sinthet1
+ gradvalct2=-gradvalct2*sinthet2
+ sumvals=0.0d0
+ gradvalst1=0.0d0
+ gradvalst2=0.0d0
+ do k=1,nval
+ do l=1,nval
+ sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
+ gradvalst1=gradvalst1+ &
+ (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
+ gradvalst2=gradvalst2+ &
+ (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
+ enddo
+ enddo
+ gradvalst1=-gradvalst1*sinthet1
+ gradvalst2=-gradvalst2*sinthet2
+ if (lprn) write (iout,*)j,"sumvalc",sumvalc," sumvals",sumvals
+ etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
+!C glocig is the gradient local i site in gamma
+ glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
+!C now gradient over theta_1
+ glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)&
+ +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
+ glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)&
+ +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
+ enddo ! j
+ etors=etors+etori
+ gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
+!C derivative over theta1
+ gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
+!C now derivative over theta2
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
+ if (lprn) then
+ write (iout,*) i-2,i-1,itype(i-2,1),itype(i-1,1),itori,itori1,&
+ theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
+ write (iout,*) "c1",(c1(k),k=0,nval), &
+ " c2",(c2(k),k=0,nval)
+ endif
+ enddo
+ return
+ end subroutine etor_kcc
+!------------------------------------------------------------------------------
+
+ subroutine etor_constr(edihcnstr)
+ real(kind=8) :: etors,edihcnstr
+ logical :: lprn
+!el local variables
+ integer :: i,j,iblock,itori,itori1
+ real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
+ vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom,&
+ gaudih_i,gauder_i,s,cos_i,dexpcos_i
+
+ if (raw_psipred) then
+ do i=idihconstr_start,idihconstr_end
+ itori=idih_constr(i)
+ phii=phi(itori)
+ gaudih_i=vpsipred(1,i)
+ gauder_i=0.0d0
+ do j=1,2
+ s = sdihed(j,i)
+ cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
+ dexpcos_i=dexp(-cos_i*cos_i)
+ gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
+ gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) &
+ *cos_i*dexpcos_i/s**2
+ enddo
+ edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
+ gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
+ if (energy_dec) &
+ write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') &
+ i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),&
+ phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),&
+ phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,&
+ -wdihc*dlog(gaudih_i)
+ enddo
+ else
+
do i=idihconstr_start,idihconstr_end
itori=idih_constr(i)
phii=phi(itori)
else
difi=0.0
endif
-!d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
-!d & rad2deg*phi0(i), rad2deg*drange(i),
-!d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
enddo
-!d write (iout,*) 'edihcnstr',edihcnstr
+
+ endif
+
return
- end subroutine etor
+
+ end subroutine etor_constr
!-----------------------------------------------------------------------------
subroutine etor_d(etors_d)
! 6/23/01 Compute double torsional energy
return
end subroutine etor_d
#endif
-!-----------------------------------------------------------------------------
- subroutine eback_sc_corr(esccor)
-! 7/21/2007 Correlations between the backbone-local and side-chain-local
-! conformational states; temporarily implemented as differences
-! between UNRES torsional potentials (dependent on three types of
-! residues) and the torsional potentials dependent on all 20 types
-! of residues computed from AM1 energy surfaces of terminally-blocked
-! amino-acid residues.
-! implicit real*8 (a-h,o-z)
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+ subroutine e_modeller(ehomology_constr)
+! implicit none
! include 'DIMENSIONS'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
-! include 'COMMON.TORSION'
-! include 'COMMON.SCCOR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.DERIV'
-! include 'COMMON.CHAIN'
-! include 'COMMON.NAMES'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.CONTROL'
- real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
- cosphi,sinphi
- logical :: lprn
- integer :: i,interty,j,isccori,isccori1,intertyp
-! Set lprn=.true. for debugging
- lprn=.false.
-! lprn=.true.
-! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
- esccor=0.0D0
- do i=itau_start,itau_end
- if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
- esccor_ii=0.0D0
- isccori=isccortyp(itype(i-2,1))
- isccori1=isccortyp(itype(i-1,1))
+ use MD_data, only: iset
+ real(kind=8) :: ehomology_constr
+ integer nnn,i,ii,j,k,ijk,jik,ki,kk,nexl,irec,l
+ integer katy, odleglosci, test7
+ real(kind=8) :: odleg, odleg2, odleg3, kat, kat2, kat3
+ real(kind=8) :: Eval,Erot,min_odl
+ real(kind=8),dimension(constr_homology) :: distance,distancek,godl,dih_diff,gdih, &
+ gtheta,dscdiff, &
+ uscdiffk,guscdiff2,guscdiff3,&
+ theta_diff
+
+
+!
+! FP - 30/10/2014 Temporary specifications for homology restraints
+!
+ real(kind=8) :: utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,&
+ sgtheta
+ real(kind=8), dimension (nres) :: guscdiff,usc_diff
+ real(kind=8) :: sum_godl,sgodl,grad_odl3,ggodl,sum_gdih,&
+ sum_guscdiff,sum_sgdih,sgdih,grad_dih3,usc_diff_i,dxx,dyy,dzz,&
+ betai,sum_sgodl,dij,max_template
+! real(kind=8) :: dist,pinorm
+!
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.CHAIN'
+! include 'COMMON.GEO'
+! include 'COMMON.DERIV'
+! include 'COMMON.LOCAL'
+! include 'COMMON.INTERACT'
+! include 'COMMON.VAR'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.MD'
+! include 'COMMON.CONTROL'
+! include 'COMMON.HOMOLOGY'
+! include 'COMMON.QRESTR'
+!
+! From subroutine Econstr_back
+!
+! include 'COMMON.NAMES'
+! include 'COMMON.TIME1'
+!
-! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
- phii=phi(i)
- do intertyp=1,3 !intertyp
- esccor_ii=0.0D0
-!c Added 09 May 2012 (Adasko)
-!c Intertyp means interaction type of backbone mainchain correlation:
-! 1 = SC...Ca...Ca...Ca
-! 2 = Ca...Ca...Ca...SC
-! 3 = SC...Ca...Ca...SCi
- gloci=0.0D0
- if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
- (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
- (itype(i-1,1).eq.ntyp1))) &
- .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
- .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
- .or.(itype(i,1).eq.ntyp1))) &
- .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
- (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
- (itype(i-3,1).eq.ntyp1)))) cycle
- if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
- if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
- cycle
- do j=1,nterm_sccor(isccori,isccori1)
- v1ij=v1sccor(j,intertyp,isccori,isccori1)
- v2ij=v2sccor(j,intertyp,isccori,isccori1)
- cosphi=dcos(j*tauangle(intertyp,i))
- sinphi=dsin(j*tauangle(intertyp,i))
- if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
- esccor=esccor+v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
- 'esccor',i,intertyp,esccor_ii
-! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
- gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
- if (lprn) &
- write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
- restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
- (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
- (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
- gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
- enddo !intertyp
+
+ do i=1,max_template
+ distancek(i)=9999999.9
enddo
- return
- end subroutine eback_sc_corr
-!-----------------------------------------------------------------------------
- subroutine multibody(ecorr)
-! This subroutine calculates multi-body contributions to energy following
-! the idea of Skolnick et al. If side chains I and J make a contact and
-! at the same time side chains I+1 and J+1 make a contact, an extra
-! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
- real(kind=8),dimension(3) :: gx,gx1
- logical :: lprn
- real(kind=8) :: ecorr
- integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
-! Set lprn=.true. for debugging
- lprn=.false.
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(i2,20(1x,i2,f10.5))') &
- i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
- enddo
- endif
- ecorr=0.0D0
+ odleg=0.0d0
-! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
-! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
- do i=nnt,nct-2
+! Pseudo-energy and gradient from homology restraints (MODELLER-like
+! function)
+! AL 5/2/14 - Introduce list of restraints
+! write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs start -------"
+#endif
+ do ii = link_start_homo,link_end_homo
+ i = ires_homo(ii)
+ j = jres_homo(ii)
+ dij=dist(i,j)
+! write (iout,*) "dij(",i,j,") =",dij
+ nexl=0
+ do k=1,constr_homology
+! write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
+ if(.not.l_homo(k,ii)) then
+ nexl=nexl+1
+ cycle
+ endif
+ distance(k)=odl(k,ii)-dij
+! write (iout,*) "distance(",k,") =",distance(k)
+!
+! For Gaussian-type Urestr
+!
+ distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
+! write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
+! write (iout,*) "distancek(",k,") =",distancek(k)
+! distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
+!
+! For Lorentzian-type Urestr
+!
+ if (waga_dist.lt.0.0d0) then
+ sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
+ distancek(k)=distance(k)**2/(sigma_odlir(k,ii)* &
+ (distance(k)**2+sigma_odlir(k,ii)**2))
+ endif
+ enddo
- DO ISHIFT = 3,4
+! min_odl=minval(distancek)
+ if (nexl.gt.0) then
+ min_odl=0.0d0
+ else
+ do kk=1,constr_homology
+ if(l_homo(kk,ii)) then
+ min_odl=distancek(kk)
+ exit
+ endif
+ enddo
+ do kk=1,constr_homology
+ if (l_homo(kk,ii) .and. distancek(kk).lt.min_odl) &
+ min_odl=distancek(kk)
+ enddo
+ endif
- i1=i+ishift
- num_conti=num_cont(i)
- num_conti1=num_cont(i1)
- do jj=1,num_conti
- j=jcont(jj,i)
- do kk=1,num_conti1
- j1=jcont(kk,i1)
- if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
-!d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-!d & ' ishift=',ishift
-! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
-! The system gains extra energy.
- ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
- endif ! j1==j+-ishift
- enddo ! kk
- enddo ! jj
+! write (iout,* )"min_odl",min_odl
+#ifdef DEBUG
+ write (iout,*) "ij dij",i,j,dij
+ write (iout,*) "distance",(distance(k),k=1,constr_homology)
+ write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
+ write (iout,* )"min_odl",min_odl
+#endif
+#ifdef OLDRESTR
+ odleg2=0.0d0
+#else
+ if (waga_dist.ge.0.0d0) then
+ odleg2=nexl
+ else
+ odleg2=0.0d0
+ endif
+#endif
+ do k=1,constr_homology
+! Nie wiem po co to liczycie jeszcze raz!
+! odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
+! & (2*(sigma_odl(i,j,k))**2))
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ godl(k)=dexp(-distancek(k)+min_odl)
+ odleg2=odleg2+godl(k)
+!
+! For Lorentzian-type Urestr
+!
+ else
+ odleg2=odleg2+distancek(k)
+ endif
- ENDDO ! ISHIFT
+!cc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
+!cc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
+!cc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
+!cc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
- enddo ! i
- return
- end subroutine multibody
-!-----------------------------------------------------------------------------
- real(kind=8) function esccorr(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
- real(kind=8),dimension(3) :: gx,gx1
- logical :: lprn
- integer :: i,j,k,l,jj,kk,m,ll
- real(kind=8) :: eij,ekl
- lprn=.false.
- eij=facont(jj,i)
- ekl=facont(kk,k)
-!d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
-! Calculate the multi-body contribution to energy.
-! Calculate multi-body contributions to the gradient.
-!d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
-!d & k,l,(gacont(m,kk,k),m=1,3)
- do m=1,3
- gx(m) =ekl*gacont(m,jj,i)
- gx1(m)=eij*gacont(m,kk,k)
- gradxorr(m,i)=gradxorr(m,i)-gx(m)
- gradxorr(m,j)=gradxorr(m,j)+gx(m)
- gradxorr(m,k)=gradxorr(m,k)-gx1(m)
- gradxorr(m,l)=gradxorr(m,l)+gx1(m)
+ enddo
+! write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+! write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+ write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#endif
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
+!
+! For Lorentzian-type Urestr
+!
+ else
+ odleg=odleg+odleg2/constr_homology
+ endif
+!
+! write (iout,*) "odleg",odleg ! sum of -ln-s
+! Gradient
+!
+! For Gaussian-type Urestr
+!
+ if (waga_dist.ge.0.0d0) sum_godl=odleg2
+ sum_sgodl=0.0d0
+ do k=1,constr_homology
+! godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+! & *waga_dist)+min_odl
+! sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
+!
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+! For Gaussian-type Urestr
+!
+ sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
+!
+! For Lorentzian-type Urestr
+!
+ else
+ sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+ &
+ sigma_odlir(k,ii)**2)**2)
+ endif
+ sum_sgodl=sum_sgodl+sgodl
+
+! sgodl2=sgodl2+sgodl
+! write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
+! write(iout,*) "constr_homology=",constr_homology
+! write(iout,*) i, j, k, "TEST K"
+ enddo
+! print *, "ok",iset
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ grad_odl3=waga_homology(iset)*waga_dist &
+ *sum_sgodl/(sum_godl*dij)
+! print *, "ok"
+!
+! For Lorentzian-type Urestr
+!
+ else
+! Original grad expr modified by analogy w Gaussian-type Urestr grad
+! grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
+ grad_odl3=-waga_homology(iset)*waga_dist* &
+ sum_sgodl/(constr_homology*dij)
+! print *, "ok2"
+ endif
+!
+! grad_odl3=sum_sgodl/(sum_godl*dij)
+
+
+! write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
+! write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
+! & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+
+!cc write(iout,*) godl, sgodl, grad_odl3
+
+! grad_odl=grad_odl+grad_odl3
+
+ do jik=1,3
+ ggodl=grad_odl3*(c(jik,i)-c(jik,j))
+!cc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
+!cc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
+!cc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+ ghpbc(jik,i)=ghpbc(jik,i)+ggodl
+ ghpbc(jik,j)=ghpbc(jik,j)-ggodl
+!cc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
+!cc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+! if (i.eq.25.and.j.eq.27) then
+! write(iout,*) "jik",jik,"i",i,"j",j
+! write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
+! write(iout,*) "grad_odl3",grad_odl3
+! write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
+! write(iout,*) "ggodl",ggodl
+! write(iout,*) "ghpbc(",jik,i,")",
+! & ghpbc(jik,i),"ghpbc(",jik,j,")",
+! & ghpbc(jik,j)
+! endif
+ enddo
+!cc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
+!cc & dLOG(odleg2),"-odleg=", -odleg
+
+ enddo ! ii-loop for dist
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs end -------"
+! if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
+! & waga_d.eq.1.0d0) call sum_gradient
+#endif
+! Pseudo-energy and gradient from dihedral-angle restraints from
+! homology templates
+! write (iout,*) "End of distance loop"
+! call flush(iout)
+ kat=0.0d0
+! write (iout,*) idihconstr_start_homo,idihconstr_end_homo
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs start -------"
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
enddo
- do m=i,j-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
- enddo
+#endif
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ kat2=0.0d0
+! betai=beta(i,i+1,i+2,i+3)
+ betai = phi(i)
+! write (iout,*) "betai =",betai
+ do k=1,constr_homology
+ dih_diff(k)=pinorm(dih(k,i)-betai)
+!d write (iout,'(a8,2i4,2f15.8)') "dih_diff",i,k,dih_diff(k)
+!d & ,sigma_dih(k,i)
+! if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
+! & -(6.28318-dih_diff(i,k))
+! if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
+! & 6.28318+dih_diff(i,k)
+#ifdef OLD_DIHED
+ kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+#else
+ kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+#endif
+! kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
+ gdih(k)=dexp(kat3)
+ kat2=kat2+gdih(k)
+! write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
+! write(*,*)""
+ enddo
+! write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
+! write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "i",i," betai",betai," kat2",kat2
+ write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
+#endif
+ if (kat2.le.1.0d-14) cycle
+ kat=kat-dLOG(kat2/constr_homology)
+! write (iout,*) "kat",kat ! sum of -ln-s
+
+!cc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
+!cc & dLOG(kat2), "-kat=", -kat
+
+! ----------------------------------------------------------------------
+! Gradient
+! ----------------------------------------------------------------------
+
+ sum_gdih=kat2
+ sum_sgdih=0.0d0
+ do k=1,constr_homology
+#ifdef OLD_DIHED
+ sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
+#else
+ sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd
+#endif
+! sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
+ sum_sgdih=sum_sgdih+sgdih
+ enddo
+! grad_dih3=sum_sgdih/sum_gdih
+ grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
+! print *, "ok3"
+
+! write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
+!cc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
+!cc & gloc(nphi+i-3,icg)
+ gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
+! if (i.eq.25) then
+! write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
+! endif
+!cc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
+!cc & gloc(nphi+i-3,icg)
+
+ enddo ! i-loop for dih
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs end -------"
+#endif
+
+! Pseudo-energy and gradient for theta angle restraints from
+! homology templates
+! FP 01/15 - inserted from econstr_local_test.F, loop structure
+! adapted
+
+!
+! For constr_homology reference structures (FP)
+!
+! Uconst_back_tot=0.0d0
+ Eval=0.0d0
+ Erot=0.0d0
+! Econstr_back legacy
+ do i=1,nres
+! do i=ithet_start,ithet_end
+ dutheta(i)=0.0d0
enddo
- do m=k,l-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
+! do i=loc_start,loc_end
+ do i=-1,nres
+ do j=1,3
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
enddo
- enddo
- esccorr=-eij*ekl
- return
- end function esccorr
-!-----------------------------------------------------------------------------
- subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
-! This subroutine calculates multi-body contributions to hydrogen-bonding
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-#ifdef MPI
- include "mpif.h"
-! integer :: maxconts !max_cont=maxconts =nres/4
- integer,parameter :: max_dim=26
- integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
-!el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
-!el common /przechowalnia/ zapas
- integer :: status(MPI_STATUS_SIZE)
- integer,dimension((nres/4)*2) :: req !maxconts*2
- integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
+ enddo
+!
+! do iref=1,nref
+! write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
+! write (iout,*) "waga_theta",waga_theta
+ if (waga_theta.gt.0.0d0) then
+#ifdef DEBUG
+ write (iout,*) "usampl",usampl
+ write(iout,*) "------- theta restrs start -------"
+! do i=ithet_start,ithet_end
+! write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
+! enddo
#endif
-! include 'COMMON.SETUP'
-! include 'COMMON.FFIELD'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.CONTROL'
-! include 'COMMON.LOCAL'
- real(kind=8),dimension(3) :: gx,gx1
- real(kind=8) :: time00,ecorr,ecorr5,ecorr6
- logical :: lprn,ldone
-!el local variables
- integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
- jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
+! write (iout,*) "maxres",maxres,"nres",nres
-! Set lprn=.true. for debugging
- lprn=.true.
-#ifdef MPI
-! maxconts=nres/4
- if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
- n_corr=0
- n_corr1=0
- if (nfgtasks.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values before RECEIVE:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
- j=1,num_cont_hb(i))
+ do i=ithet_start,ithet_end
+!
+! do i=1,nfrag_back
+! ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
+!
+! Deviation of theta angles wrt constr_homology ref structures
+!
+ utheta_i=0.0d0 ! argument of Gaussian for single k
+ gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+! do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
+! over residues in a fragment
+! write (iout,*) "theta(",i,")=",theta(i)
+ do k=1,constr_homology
+!
+! dtheta_i=theta(j)-thetaref(j,iref)
+! dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
+ theta_diff(k)=thetatpl(k,i)-theta(i)
+!d write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k)
+!d & ,sigma_theta(k,i)
+
+!
+ utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
+! utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
+ gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
+ gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk)
+! Gradient for single Gaussian restraint in subr Econstr_back
+! dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
+!
+ enddo
+! write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
+! write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
+
+!
+! Gradient for multiple Gaussian restraint
+ sum_gtheta=gutheta_i
+ sum_sgtheta=0.0d0
+ do k=1,constr_homology
+! New generalized expr for multiple Gaussian from Econstr_back
+ sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
+!
+! sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
+ sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
enddo
+! Final value of gradient using same var as in Econstr_back
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg) &
+ +sum_sgtheta/sum_gtheta*waga_theta &
+ *waga_homology(iset)
+! print *, "ok4"
+
+! dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
+! & *waga_homology(iset)
+! dutheta(i)=sum_sgtheta/sum_gtheta
+!
+! Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
+ Eval=Eval-dLOG(gutheta_i/constr_homology)
+! write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
+! write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
+! Uconst_back=Uconst_back+utheta(i)
+ enddo ! (i-loop for theta)
+#ifdef DEBUG
+ write(iout,*) "------- theta restrs end -------"
+#endif
endif
- call flush(iout)
- do i=1,ntask_cont_from
- ncont_recv(i)=0
- enddo
- do i=1,ntask_cont_to
- ncont_sent(i)=0
- enddo
-! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
-! & ntask_cont_to
-! Make the list of contacts to send to send to other procesors
-! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
-! call flush(iout)
- do i=iturn3_start,iturn3_end
-! write (iout,*) "make contact list turn3",i," num_cont",
-! & num_cont_hb(i)
- call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
- enddo
- do i=iturn4_start,iturn4_end
-! write (iout,*) "make contact list turn4",i," num_cont",
-! & num_cont_hb(i)
- call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
+!
+! Deviation of local SC geometry
+!
+! Separation of two i-loops (instructed by AL - 11/3/2014)
+!
+! write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
+! write (iout,*) "waga_d",waga_d
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs start -------"
+ write (iout,*) "Initial duscdiff,duscdiffx"
+ do i=loc_start,loc_end
+ write (iout,*) i,(duscdiff(jik,i),jik=1,3), &
+ (duscdiffx(jik,i),jik=1,3)
enddo
- do ii=1,nat_sent
- i=iat_sent(ii)
-! write (iout,*) "make contact list longrange",i,ii," num_cont",
-! & num_cont_hb(i)
- do j=1,num_cont_hb(i)
- do k=1,4
- jjc=jcont_hb(j,i)
- iproc=iint_sent_local(k,jjc,ii)
-! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.gt.0) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=i
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,i)
- zapas(4,nn,iproc)=ees0p(j,i)
- zapas(5,nn,iproc)=ees0m(j,i)
- zapas(6,nn,iproc)=gacont_hbr(1,j,i)
- zapas(7,nn,iproc)=gacont_hbr(2,j,i)
- zapas(8,nn,iproc)=gacont_hbr(3,j,i)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
- endif
+#endif
+ do i=loc_start,loc_end
+ usc_diff_i=0.0d0 ! argument of Gaussian for single k
+ guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+! do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
+! write(iout,*) "xxtab, yytab, zztab"
+! write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
+ do k=1,constr_homology
+!
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+! Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+! write(iout,*) "dxx, dyy, dzz"
+!d write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i)
+!
+ usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
+! usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
+! uscdiffk(k)=usc_diff(i)
+ guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
+! write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i),
+! & " guscdiff2",guscdiff2(k)
+ guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk)
+! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
+! & xxref(j),yyref(j),zzref(j)
enddo
+!
+! Gradient
+!
+! Generalized expression for multiple Gaussian acc to that for a single
+! Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
+!
+! Original implementation
+! sum_guscdiff=guscdiff(i)
+!
+! sum_sguscdiff=0.0d0
+! do k=1,constr_homology
+! sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
+! sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
+! sum_sguscdiff=sum_sguscdiff+sguscdiff
+! enddo
+!
+! Implementation of new expressions for gradient (Jan. 2015)
+!
+! grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
+ do k=1,constr_homology
+!
+! New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
+! before. Now the drivatives should be correct
+!
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+! Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+ sum_guscdiff=guscdiff2(k)* &!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
+ sigma_d(k,i) ! for the grad wrt r'
+! sum_sguscdiff=sum_sguscdiff+sum_guscdiff
+
+!
+! New implementation
+ sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
+ do jik=1,3
+ duscdiff(jik,i-1)=duscdiff(jik,i-1)+ &
+ sum_guscdiff*(dXX_C1tab(jik,i)*dxx+ &
+ dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
+ duscdiff(jik,i)=duscdiff(jik,i)+ &
+ sum_guscdiff*(dXX_Ctab(jik,i)*dxx+ &
+ dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
+ duscdiffx(jik,i)=duscdiffx(jik,i)+ &
+ sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+ &
+ dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
+! print *, "ok5"
+!
+#ifdef DEBUG
+! write(iout,*) "jik",jik,"i",i
+ write(iout,*) "dxx, dyy, dzz"
+ write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
+ write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
+ write(iout,*) "sum_sguscdiff",sum_guscdiff,waga_homology(iset),waga_d
+ write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
+ write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
+ write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
+ write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
+ write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
+ write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
+ write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
+ write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
+ write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
+ write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
+ write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
+ write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
+! endif
+#endif
+ enddo
enddo
+! print *, "ok6"
+!
+! uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
+! usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
+!
+! write (iout,*) i," uscdiff",uscdiff(i)
+!
+! Put together deviations from local geometry
+
+! Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
+! & wfrag_back(3,i,iset)*uscdiff(i)
+ Erot=Erot-dLOG(guscdiff(i)/constr_homology)
+! write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
+! write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
+! Uconst_back=Uconst_back+usc_diff(i)
+!
+! Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
+!
+! New implment: multiplied by sum_sguscdiff
+!
+
+ enddo ! (i-loop for dscdiff)
+
+! endif
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs end -------"
+ write (iout,*) "------ After SC loop in e_modeller ------"
+ do i=loc_start,loc_end
+ write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
+ write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
+ enddo
+ if (waga_theta.eq.1.0d0) then
+ write (iout,*) "in e_modeller after SC restr end: dutheta"
+ do i=ithet_start,ithet_end
+ write (iout,*) i,dutheta(i)
enddo
- if (lprn) then
- write (iout,*) &
- "Numbers of contacts to be sent to other processors",&
- (ncont_sent(i),i=1,ntask_cont_to)
- write (iout,*) "Contacts sent"
- do ii=1,ntask_cont_to
- nn=ncont_sent(ii)
- iproc=itask_cont_to(ii)
- write (iout,*) nn," contacts to processor",iproc,&
- " of CONT_TO_COMM group"
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
- enddo
+ endif
+ if (waga_d.eq.1.0d0) then
+ write (iout,*) "e_modeller after SC loop: duscdiff/x"
+ do i=1,nres
+ write (iout,*) i,(duscdiff(j,i),j=1,3)
+ write (iout,*) i,(duscdiffx(j,i),j=1,3)
enddo
- call flush(iout)
endif
- CorrelType=477
- CorrelID=fg_rank+1
- CorrelType1=478
- CorrelID1=nfgtasks+fg_rank+1
- ireq=0
-! Receive the numbers of needed contacts from other processors
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- ireq=ireq+1
- call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
- FG_COMM,req(ireq),IERR)
- enddo
-! write (iout,*) "IRECV ended"
-! call flush(iout)
-! Send the number of contacts needed by other processors
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- ireq=ireq+1
- call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
- FG_COMM,req(ireq),IERR)
+#endif
+
+! Total energy from homology restraints
+#ifdef DEBUG
+ write (iout,*) "odleg",odleg," kat",kat
+#endif
+!
+! Addition of energy of theta angle and SC local geom over constr_homologs ref strs
+!
+! ehomology_constr=odleg+kat
+!
+! For Lorentzian-type Urestr
+!
+
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ ehomology_constr=(waga_dist*odleg+waga_angle*kat+ &
+ waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+! write (iout,*) "ehomology_constr=",ehomology_constr
+! print *, "ok7"
+ else
+!
+! For Lorentzian-type Urestr
+!
+ ehomology_constr=(-waga_dist*odleg+waga_angle*kat+ &
+ waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+! write (iout,*) "ehomology_constr=",ehomology_constr
+ print *, "ok8"
+ endif
+#ifdef DEBUG
+ write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat, &
+ "Eval",waga_theta,eval, &
+ "Erot",waga_d,Erot
+ write (iout,*) "ehomology_constr",ehomology_constr
+#endif
+ return
+!
+! FP 01/15 end
+!
+ 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
+ 747 format(a12,i4,i4,i4,f8.3,f8.3)
+ 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
+ 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
+ 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, &
+ f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
+ end subroutine e_modeller
+
+!----------------------------------------------------------------------------
+ subroutine ebend_kcc(etheta)
+ logical lprn
+ double precision thybt1(maxang_kcc),etheta
+ integer :: i,iti,j,ihelp
+ real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1
+!C Set lprn=.true. for debugging
+ lprn=energy_dec
+!c lprn=.true.
+!C print *,"wchodze kcc"
+ if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
+ etheta=0.0D0
+ do i=ithet_start,ithet_end
+!c print *,i,itype(i-1),itype(i),itype(i-2)
+ if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 &
+ .or.itype(i,1).eq.ntyp1) cycle
+ iti=iabs(itortyp(itype(i-1,1)))
+ sinthet=dsin(theta(i))
+ costhet=dcos(theta(i))
+ do j=1,nbend_kcc_Tb(iti)
+ thybt1(j)=v1bend_chyb(j,iti)
+ enddo
+ sumth1thyb=v1bend_chyb(0,iti)+ &
+ tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
+ if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,&
+ sumth1thyb
+ ihelp=nbend_kcc_Tb(iti)-1
+ gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
+ etheta=etheta+sumth1thyb
+!C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
enddo
-! write (iout,*) "ISEND ended"
-! write (iout,*) "number of requests (nn)",ireq
- call flush(iout)
- if (ireq.gt.0) &
- call MPI_Waitall(ireq,req,status_array,ierr)
-! write (iout,*)
-! & "Numbers of contacts to be received from other processors",
-! & (ncont_recv(i),i=1,ntask_cont_from)
-! call flush(iout)
-! Receive contacts
- ireq=0
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- nn=ncont_recv(ii)
-! write (iout,*) "Receiving",nn," contacts from processor",iproc,
-! & " of CONT_TO_COMM group"
- call flush(iout)
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
- MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-! write (iout,*) "ireq,req",ireq,req(ireq)
+ return
+ end subroutine ebend_kcc
+!c------------
+!c-------------------------------------------------------------------------------------
+ subroutine etheta_constr(ethetacnstr)
+ real (kind=8) :: ethetacnstr,thetiii,difi
+ integer :: i,itheta
+ ethetacnstr=0.0d0
+!C print *,ithetaconstr_start,ithetaconstr_end,"TU"
+ do i=ithetaconstr_start,ithetaconstr_end
+ itheta=itheta_constr(i)
+ thetiii=theta(itheta)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
+ +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
+ +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
endif
- enddo
-! Send the contacts to processors that need them
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- nn=ncont_sent(ii)
-! write (iout,*) nn," contacts to processor",iproc,
-! & " of CONT_TO_COMM group"
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
- iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-! write (iout,*) "ireq,req",ireq,req(ireq)
-! do i=1,nn
-! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
-! enddo
- endif
- enddo
-! write (iout,*) "number of requests (contacts)",ireq
-! write (iout,*) "req",(req(i),i=1,4)
-! call flush(iout)
- if (ireq.gt.0) &
- call MPI_Waitall(ireq,req,status_array,ierr)
- do iii=1,ntask_cont_from
- iproc=itask_cont_from(iii)
- nn=ncont_recv(iii)
- if (lprn) then
- write (iout,*) "Received",nn," contacts from processor",iproc,&
- " of CONT_FROM_COMM group"
- call flush(iout)
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
- enddo
- call flush(iout)
+ if (energy_dec) then
+ write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",&
+ i,itheta,rad2deg*thetiii,&
+ rad2deg*theta_constr0(i), rad2deg*theta_drange(i),&
+ rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,&
+ gloc(itheta+nphi-2,icg)
endif
- do i=1,nn
- ii=zapas_recv(1,i,iii)
-! Flag the received contacts to prevent double-counting
- jj=-zapas_recv(2,i,iii)
-! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
-! call flush(iout)
- nnn=num_cont_hb(ii)+1
- num_cont_hb(ii)=nnn
- jcont_hb(nnn,ii)=jj
- facont_hb(nnn,ii)=zapas_recv(3,i,iii)
- ees0p(nnn,ii)=zapas_recv(4,i,iii)
- ees0m(nnn,ii)=zapas_recv(5,i,iii)
- gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
- gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
- gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
- gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
- gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
- gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
- gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
- gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
- gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
- gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
- gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
- gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
- gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
- gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
- gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
- gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
- gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
- gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
- gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
- gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
- gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
+ enddo
+ return
+ end subroutine etheta_constr
+
+!-----------------------------------------------------------------------------
+ subroutine eback_sc_corr(esccor)
+! 7/21/2007 Correlations between the backbone-local and side-chain-local
+! conformational states; temporarily implemented as differences
+! between UNRES torsional potentials (dependent on three types of
+! residues) and the torsional potentials dependent on all 20 types
+! of residues computed from AM1 energy surfaces of terminally-blocked
+! amino-acid residues.
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.TORSION'
+! include 'COMMON.SCCOR'
+! include 'COMMON.INTERACT'
+! include 'COMMON.DERIV'
+! include 'COMMON.CHAIN'
+! include 'COMMON.NAMES'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.FFIELD'
+! include 'COMMON.CONTROL'
+ real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
+ cosphi,sinphi
+ logical :: lprn
+ integer :: i,interty,j,isccori,isccori1,intertyp
+! Set lprn=.true. for debugging
+ lprn=.false.
+! lprn=.true.
+! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
+ esccor=0.0D0
+ do i=itau_start,itau_end
+ if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
+ esccor_ii=0.0D0
+ isccori=isccortyp(itype(i-2,1))
+ isccori1=isccortyp(itype(i-1,1))
+
+! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
+ phii=phi(i)
+ do intertyp=1,3 !intertyp
+ esccor_ii=0.0D0
+!c Added 09 May 2012 (Adasko)
+!c Intertyp means interaction type of backbone mainchain correlation:
+! 1 = SC...Ca...Ca...Ca
+! 2 = Ca...Ca...Ca...SC
+! 3 = SC...Ca...Ca...SCi
+ gloci=0.0D0
+ if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
+ (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
+ (itype(i-1,1).eq.ntyp1))) &
+ .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
+ .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
+ .or.(itype(i,1).eq.ntyp1))) &
+ .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
+ (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
+ (itype(i-3,1).eq.ntyp1)))) cycle
+ if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
+ if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
+ cycle
+ do j=1,nterm_sccor(isccori,isccori1)
+ v1ij=v1sccor(j,intertyp,isccori,isccori1)
+ v2ij=v2sccor(j,intertyp,isccori,isccori1)
+ cosphi=dcos(j*tauangle(intertyp,i))
+ sinphi=dsin(j*tauangle(intertyp,i))
+ if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
+ esccor=esccor+v1ij*cosphi+v2ij*sinphi
+ gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
enddo
+ if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
+ 'esccor',i,intertyp,esccor_ii
+! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
+ gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
+ if (lprn) &
+ write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
+ restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
+ (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
+ (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
+ gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
+ enddo !intertyp
enddo
- call flush(iout)
+
+ return
+ end subroutine eback_sc_corr
+!-----------------------------------------------------------------------------
+ subroutine multibody(ecorr)
+! This subroutine calculates multi-body contributions to energy following
+! the idea of Skolnick et al. If side chains I and J make a contact and
+! at the same time side chains I+1 and J+1 make a contact, an extra
+! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+ real(kind=8),dimension(3) :: gx,gx1
+ logical :: lprn
+ real(kind=8) :: ecorr
+ integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
+! Set lprn=.true. for debugging
+ lprn=.false.
+
if (lprn) then
- write (iout,'(a)') 'Contact function values after receive:'
+ write (iout,'(a)') 'Contact function values:'
do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
- j=1,num_cont_hb(i))
- enddo
- call flush(iout)
- endif
- 30 continue
-#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
- j=1,num_cont_hb(i))
+ write (iout,'(i2,20(1x,i2,f10.5))') &
+ i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
enddo
endif
ecorr=0.0D0
! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
-! Remove the loop below after debugging !!!
do i=nnt,nct
do j=1,3
gradcorr(j,i)=0.0D0
gradxorr(j,i)=0.0D0
enddo
enddo
-! Calculate the local-electrostatic correlation terms
- do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
+ do i=nnt,nct-2
+
+ DO ISHIFT = 3,4
+
+ i1=i+ishift
+ num_conti=num_cont(i)
+ num_conti1=num_cont(i1)
do jj=1,num_conti
- j=jcont_hb(jj,i)
- jp=iabs(j)
+ j=jcont(jj,i)
do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
- jp1=iabs(j1)
-! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
-! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
- if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
- .or. j.lt.0 .and. j1.gt.0) .and. &
- (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
-! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
+ j1=jcont(kk,i1)
+ if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
+!d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+!d & ' ishift=',ishift
+! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
! The system gains extra energy.
- ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
-! Contacts I-J and I-(J+1) occur simultaneously.
-! The system loses extra energy.
-! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
-! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-! & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
-! Contacts I-J and (I+1)-J occur simultaneously.
-! The system loses extra energy.
-! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
- enddo ! i
+ ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
+ endif ! j1==j+-ishift
+ enddo ! kk
+ enddo ! jj
+
+ ENDDO ! ISHIFT
+
+ enddo ! i
return
- end subroutine multibody_hb
+ end subroutine multibody
!-----------------------------------------------------------------------------
- subroutine add_hb_contact(ii,jj,itask)
+ real(kind=8) function esccorr(i,j,k,l,jj,kk)
! implicit real*8 (a-h,o-z)
-! include "DIMENSIONS"
-! include "COMMON.IOUNITS"
-! include "COMMON.CONTACTS"
-! integer,parameter :: maxconts=nres/4
- integer,parameter :: max_dim=26
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
-! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
-! common /przechowalnia/ zapas
- integer :: i,j,ii,jj,iproc,nn,jjc
- integer,dimension(4) :: itask
-! write (iout,*) "itask",itask
- do i=1,2
- iproc=itask(i)
- if (iproc.gt.0) then
- do j=1,num_cont_hb(ii)
- jjc=jcont_hb(j,ii)
-! write (iout,*) "i",ii," j",jj," jjc",jjc
- if (jjc.eq.jj) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=ii
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,ii)
- zapas(4,nn,iproc)=ees0p(j,ii)
- zapas(5,nn,iproc)=ees0m(j,ii)
- zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
- zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
- zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
- exit
- endif
- enddo
- endif
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+ real(kind=8),dimension(3) :: gx,gx1
+ logical :: lprn
+ integer :: i,j,k,l,jj,kk,m,ll
+ real(kind=8) :: eij,ekl
+ lprn=.false.
+ eij=facont(jj,i)
+ ekl=facont(kk,k)
+!d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
+! Calculate the multi-body contribution to energy.
+! Calculate multi-body contributions to the gradient.
+!d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
+!d & k,l,(gacont(m,kk,k),m=1,3)
+ do m=1,3
+ gx(m) =ekl*gacont(m,jj,i)
+ gx1(m)=eij*gacont(m,kk,k)
+ gradxorr(m,i)=gradxorr(m,i)-gx(m)
+ gradxorr(m,j)=gradxorr(m,j)+gx(m)
+ gradxorr(m,k)=gradxorr(m,k)-gx1(m)
+ gradxorr(m,l)=gradxorr(m,l)+gx1(m)
+ enddo
+ do m=i,j-1
+ do ll=1,3
+ gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
+ enddo
enddo
+ do m=k,l-1
+ do ll=1,3
+ gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
+ enddo
+ enddo
+ esccorr=-eij*ekl
return
- end subroutine add_hb_contact
+ end function esccorr
!-----------------------------------------------------------------------------
- subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
+ subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
! This subroutine calculates multi-body contributions to hydrogen-bonding
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
- integer,parameter :: max_dim=70
#ifdef MPI
include "mpif.h"
-! integer :: maxconts !max_cont=maxconts=nres/4
+! integer :: maxconts !max_cont=maxconts =nres/4
+ integer,parameter :: max_dim=26
integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
-! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
-! common /przechowalnia/ zapas
- integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
- status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
- ierr,iii,nnn
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+!el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
+!el common /przechowalnia/ zapas
+ integer :: status(MPI_STATUS_SIZE)
+ integer,dimension((nres/4)*2) :: req !maxconts*2
+ integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
#endif
! include 'COMMON.SETUP'
! include 'COMMON.FFIELD'
! include 'COMMON.DERIV'
-! include 'COMMON.LOCAL'
! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
-! include 'COMMON.CHAIN'
! include 'COMMON.CONTROL'
+! include 'COMMON.LOCAL'
real(kind=8),dimension(3) :: gx,gx1
- integer,dimension(nres) :: num_cont_hb_old
+ real(kind=8) :: time00,ecorr,ecorr5,ecorr6
logical :: lprn,ldone
-!EL double precision eello4,eello5,eelo6,eello_turn6
-!EL external eello4,eello5,eello6,eello_turn6
!el local variables
- integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
- j1,jp1,i1,num_conti1
- real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
- real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
+ integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
+ jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
! Set lprn=.true. for debugging
lprn=.false.
- eturn6=0.0d0
#ifdef MPI
! maxconts=nres/4
if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
- do i=1,nres
- num_cont_hb_old(i)=num_cont_hb(i)
- enddo
n_corr=0
n_corr1=0
if (nfgtasks.le.1) goto 30
! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
! & ntask_cont_to
! Make the list of contacts to send to send to other procesors
+! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
+! call flush(iout)
do i=iturn3_start,iturn3_end
! write (iout,*) "make contact list turn3",i," num_cont",
! & num_cont_hb(i)
- call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
+ call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
enddo
do i=iturn4_start,iturn4_end
! write (iout,*) "make contact list turn4",i," num_cont",
! & num_cont_hb(i)
- call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
+ call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
enddo
do ii=1,nat_sent
i=iat_sent(ii)
jjc=jcont_hb(j,i)
iproc=iint_sent_local(k,jjc,ii)
! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.ne.0) then
+ if (iproc.gt.0) then
ncont_sent(iproc)=ncont_sent(iproc)+1
nn=ncont_sent(iproc)
zapas(1,nn,iproc)=i
zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,i)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
- enddo
- enddo
- enddo
- enddo
+ zapas(3,nn,iproc)=facont_hb(j,i)
+ zapas(4,nn,iproc)=ees0p(j,i)
+ zapas(5,nn,iproc)=ees0m(j,i)
+ zapas(6,nn,iproc)=gacont_hbr(1,j,i)
+ zapas(7,nn,iproc)=gacont_hbr(2,j,i)
+ zapas(8,nn,iproc)=gacont_hbr(3,j,i)
+ zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
+ zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
+ zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
+ zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
+ zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
+ zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
+ zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
+ zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
+ zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
+ zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
+ zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
+ zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
+ zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
+ zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
+ zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
+ zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
+ zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
+ zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
endif
enddo
enddo
write (iout,*) nn," contacts to processor",iproc,&
" of CONT_TO_COMM group"
do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
+ write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
enddo
enddo
call flush(iout)
" of CONT_FROM_COMM group"
call flush(iout)
do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
+ write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
enddo
call flush(iout)
endif
nnn=num_cont_hb(ii)+1
num_cont_hb(ii)=nnn
jcont_hb(nnn,ii)=jj
- d_cont(nnn,ii)=zapas_recv(3,i,iii)
- ind=3
- do kk=1,3
- ind=ind+1
- grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- enddo
- enddo
+ facont_hb(nnn,ii)=zapas_recv(3,i,iii)
+ ees0p(nnn,ii)=zapas_recv(4,i,iii)
+ ees0m(nnn,ii)=zapas_recv(5,i,iii)
+ gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
+ gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
+ gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
+ gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
+ gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
+ gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
+ gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
+ gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
+ gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
+ gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
+ gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
+ gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
+ gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
+ gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
+ gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
+ gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
+ gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
+ gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
+ gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
+ gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
+ gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
enddo
enddo
call flush(iout)
if (lprn) then
write (iout,'(a)') 'Contact function values after receive:'
do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,5f6.3))') &
- i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
- ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
+ write (iout,'(2i3,50(1x,i3,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
+ j=1,num_cont_hb(i))
enddo
call flush(iout)
endif
if (lprn) then
write (iout,'(a)') 'Contact function values:'
do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,5f6.3))') &
- i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
- ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
+ write (iout,'(2i3,50(1x,i3,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
+ j=1,num_cont_hb(i))
enddo
endif
ecorr=0.0D0
- ecorr5=0.0d0
- ecorr6=0.0d0
! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
gradxorr(j,i)=0.0D0
enddo
enddo
-! Calculate the dipole-dipole interaction energies
- if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
- do i=iatel_s,iatel_e+1
- num_conti=num_cont_hb(i)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
-#ifdef MOMENT
- call dipole(i,j,jj)
-#endif
- enddo
- enddo
- endif
! Calculate the local-electrostatic correlation terms
-! write (iout,*) "gradcorr5 in eello5 before loop"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
- do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
-! write (iout,*) "corr loop i",i
+ do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
i1=i+1
num_conti=num_cont_hb(i)
num_conti1=num_cont_hb(i+1)
do kk=1,num_conti1
j1=jcont_hb(kk,i1)
jp1=iabs(j1)
-! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-! & ' jj=',jj,' kk=',kk
-! if (j1.eq.j+1 .or. j1.eq.j-1) then
+! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
+! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
.or. j.lt.0 .and. j1.gt.0) .and. &
(jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
! The system gains extra energy.
+ ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
+ 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
n_corr=n_corr+1
- sqd1=dsqrt(d_cont(jj,i))
- sqd2=dsqrt(d_cont(kk,i1))
- sred_geom = sqd1*sqd2
- IF (sred_geom.lt.cutoff_corr) THEN
- call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
- ekont,fprimcont)
-!d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
-!d & ' jj=',jj,' kk=',kk
- fac_prim1=0.5d0*sqd2/sqd1*fprimcont
- fac_prim2=0.5d0*sqd1/sqd2*fprimcont
- do l=1,3
- g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
- g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
- enddo
- n_corr1=n_corr1+1
-!d write (iout,*) 'sred_geom=',sred_geom,
-!d & ' ekont=',ekont,' fprim=',fprimcont,
-!d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
-!d write (iout,*) "g_contij",g_contij
-!d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
-!d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
- call calc_eello(i,jp,i+1,jp1,jj,kk)
- if (wcorr4.gt.0.0d0) &
- ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
- if (energy_dec.and.wcorr4.gt.0.0d0) &
- write (iout,'(a6,4i5,0pf7.3)') &
- 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
-! write (iout,*) "gradcorr5 before eello5"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
- if (wcorr5.gt.0.0d0) &
- ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
-! write (iout,*) "gradcorr5 after eello5"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
- if (energy_dec.and.wcorr5.gt.0.0d0) &
- write (iout,'(a6,4i5,0pf7.3)') &
- 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
-!d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
-!d write(2,*)'ijkl',i,jp,i+1,jp1
- if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
- .or. wturn6.eq.0.0d0))then
-!d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
- ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
- 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
-!d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
-!d & 'ecorr6=',ecorr6
-!d write (iout,'(4e15.5)') sred_geom,
-!d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
-!d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
-!d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
- else if (wturn6.gt.0.0d0 &
- .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
-!d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
- eturn6=eturn6+eello_turn6(i,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
- 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
-!d write (2,*) 'multibody_eello:eturn6',eturn6
- endif
- ENDIF
-1111 continue
+ else if (j1.eq.j) then
+! Contacts I-J and I-(J+1) occur simultaneously.
+! The system loses extra energy.
+! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
endif
enddo ! kk
+ do kk=1,num_conti
+ j1=jcont_hb(kk,i)
+! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+! & ' jj=',jj,' kk=',kk
+ if (j1.eq.j+1) then
+! Contacts I-J and (I+1)-J occur simultaneously.
+! The system loses extra energy.
+! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
+ endif ! j1==j+1
+ enddo ! kk
enddo ! jj
enddo ! i
- do i=1,nres
- num_cont_hb(i)=num_cont_hb_old(i)
- enddo
-! write (iout,*) "gradcorr5 in eello5"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
return
- end subroutine multibody_eello
+ end subroutine multibody_hb
!-----------------------------------------------------------------------------
- subroutine add_hb_contact_eello(ii,jj,itask)
+ subroutine add_hb_contact(ii,jj,itask)
! implicit real*8 (a-h,o-z)
! include "DIMENSIONS"
! include "COMMON.IOUNITS"
! include "COMMON.CONTACTS"
! integer,parameter :: maxconts=nres/4
- integer,parameter :: max_dim=70
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
-! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+ integer,parameter :: max_dim=26
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
! common /przechowalnia/ zapas
-
- integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
- integer,dimension(4) ::itask
+ integer :: i,j,ii,jj,iproc,nn,jjc
+ integer,dimension(4) :: itask
! write (iout,*) "itask",itask
do i=1,2
iproc=itask(i)
if (iproc.gt.0) then
do j=1,num_cont_hb(ii)
jjc=jcont_hb(j,ii)
-! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
+! write (iout,*) "i",ii," j",jj," jjc",jjc
if (jjc.eq.jj) then
ncont_sent(iproc)=ncont_sent(iproc)+1
nn=ncont_sent(iproc)
zapas(1,nn,iproc)=ii
zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,ii)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
- enddo
- enddo
- enddo
- enddo
+ zapas(3,nn,iproc)=facont_hb(j,ii)
+ zapas(4,nn,iproc)=ees0p(j,ii)
+ zapas(5,nn,iproc)=ees0m(j,ii)
+ zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
+ zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
+ zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
+ zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
+ zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
+ zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
+ zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
+ zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
+ zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
+ zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
+ zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
+ zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
+ zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
+ zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
+ zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
+ zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
+ zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
+ zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
+ zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
+ zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
+ zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
exit
endif
enddo
endif
enddo
return
- end subroutine add_hb_contact_eello
+ end subroutine add_hb_contact
!-----------------------------------------------------------------------------
- real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
+ subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
+! This subroutine calculates multi-body contributions to hydrogen-bonding
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
+ integer,parameter :: max_dim=70
+#ifdef MPI
+ include "mpif.h"
+! integer :: maxconts !max_cont=maxconts=nres/4
+ integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
+! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+! common /przechowalnia/ zapas
+ integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
+ status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
+ ierr,iii,nnn
+#endif
+! include 'COMMON.SETUP'
+! include 'COMMON.FFIELD'
! include 'COMMON.DERIV'
+! include 'COMMON.LOCAL'
! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: gx,gx1
- logical :: lprn
+ integer,dimension(nres) :: num_cont_hb_old
+ logical :: lprn,ldone
+!EL double precision eello4,eello5,eelo6,eello_turn6
+!EL external eello4,eello5,eello6,eello_turn6
!el local variables
- integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
- real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
+ j1,jp1,i1,num_conti1
+ real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
+ real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
+! Set lprn=.true. for debugging
lprn=.false.
- eij=facont_hb(jj,i)
- ekl=facont_hb(kk,k)
- ees0pij=ees0p(jj,i)
- ees0pkl=ees0p(kk,k)
- ees0mij=ees0m(jj,i)
- ees0mkl=ees0m(kk,k)
- ekont=eij*ekl
- ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
-!d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
-! Following 4 lines for diagnostics.
-!d ees0pkl=0.0D0
-!d ees0pij=1.0D0
-!d ees0mkl=0.0D0
-!d ees0mij=1.0D0
-! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
-! & 'Contacts ',i,j,
-! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
-! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
-! & 'gradcorr_long'
-! Calculate the multi-body contribution to energy.
-! ecorr=ecorr+ekont*ees
-! Calculate multi-body contributions to the gradient.
- coeffpees0pij=coeffp*ees0pij
- coeffmees0mij=coeffm*ees0mij
- coeffpees0pkl=coeffp*ees0pkl
- coeffmees0mkl=coeffm*ees0mkl
- do ll=1,3
-!grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
- gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
- -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
-!grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
- gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
-! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
- enddo
-! write (iout,*)
-!grad do m=i+1,j-1
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+
-!grad & ees*ekl*gacont_hbr(ll,jj,i)-
-!grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
-!grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
-!grad enddo
-!grad enddo
-!grad do m=k+1,l-1
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+
-!grad & ees*eij*gacont_hbr(ll,kk,k)-
-!grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
-!grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
-!grad enddo
-!grad enddo
-! write (iout,*) "ehbcorr",ekont*ees
- ehbcorr=ekont*ees
- if (shield_mode.gt.0) then
- j=ees0plist(jj,i)
- l=ees0plist(kk,k)
-!C print *,i,j,fac_shield(i),fac_shield(j),
-!C &fac_shield(k),fac_shield(l)
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
- (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
-
- do ilist=1,ishield_list(k)
- iresshield=shield_list(ilist,k)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(l)
- iresshield=shield_list(ilist,l)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
- do m=1,3
- gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
- grad_shield(m,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
- grad_shield(m,j)*ehbcorr/fac_shield(j)
- gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
- grad_shield(m,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
- grad_shield(m,j)*ehbcorr/fac_shield(j)
-
- gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
- grad_shield(m,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
- grad_shield(m,l)*ehbcorr/fac_shield(l)
- gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
- grad_shield(m,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
- grad_shield(m,l)*ehbcorr/fac_shield(l)
-
- enddo
- endif
- endif
- return
- end function ehbcorr
-#ifdef MOMENT
-!-----------------------------------------------------------------------------
- subroutine dipole(i,j,jj)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.FFIELD'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
- real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
- integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
-
- allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
- allocate(dipderx(3,5,4,maxconts,nres))
-!
-
- iti1 = itortyp(itype(i+1,1))
- if (j.lt.nres-1) then
- itj1 = itortyp(itype(j+1,1))
- else
- itj1=ntortyp+1
- endif
- do iii=1,2
- dipi(iii,1)=Ub2(iii,i)
- dipderi(iii)=Ub2der(iii,i)
- dipi(iii,2)=b1(iii,iti1)
- dipj(iii,1)=Ub2(iii,j)
- dipderj(iii)=Ub2der(iii,j)
- dipj(iii,2)=b1(iii,itj1)
+ eturn6=0.0d0
+#ifdef MPI
+! maxconts=nres/4
+ if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
+ do i=1,nres
+ num_cont_hb_old(i)=num_cont_hb(i)
enddo
- kkk=0
- do iii=1,2
- call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
- do jjj=1,2
- kkk=kkk+1
- dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
+ n_corr=0
+ n_corr1=0
+ if (nfgtasks.le.1) goto 30
+ if (lprn) then
+ write (iout,'(a)') 'Contact function values before RECEIVE:'
+ do i=nnt,nct-2
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
+ j=1,num_cont_hb(i))
enddo
+ endif
+ call flush(iout)
+ do i=1,ntask_cont_from
+ ncont_recv(i)=0
enddo
- do kkk=1,5
- do lll=1,3
- mmm=0
- do iii=1,2
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
- auxvec(1))
- do jjj=1,2
- mmm=mmm+1
- dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
- enddo
- enddo
+ do i=1,ntask_cont_to
+ ncont_sent(i)=0
enddo
- call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
- call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
- do iii=1,2
- dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
+! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
+! & ntask_cont_to
+! Make the list of contacts to send to send to other procesors
+ do i=iturn3_start,iturn3_end
+! write (iout,*) "make contact list turn3",i," num_cont",
+! & num_cont_hb(i)
+ call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
enddo
- call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
- do iii=1,2
- dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
+ do i=iturn4_start,iturn4_end
+! write (iout,*) "make contact list turn4",i," num_cont",
+! & num_cont_hb(i)
+ call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
enddo
- return
- end subroutine dipole
-#endif
-!-----------------------------------------------------------------------------
- subroutine calc_eello(i,j,k,l,jj,kk)
-!
-! This subroutine computes matrices and vectors needed to calculate
-! the fourth-, fifth-, and sixth-order local-electrostatic terms.
-!
- use comm_kut
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.FFIELD'
- real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
- real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
- integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
- itj1
-!el logical :: lprn
-!el common /kutas/ lprn
-!d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
-!d & ' jj=',jj,' kk=',kk
-!d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
-!d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
-!d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
- do iii=1,2
- do jjj=1,2
- aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
- aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
+ do ii=1,nat_sent
+ i=iat_sent(ii)
+! write (iout,*) "make contact list longrange",i,ii," num_cont",
+! & num_cont_hb(i)
+ do j=1,num_cont_hb(i)
+ do k=1,4
+ jjc=jcont_hb(j,i)
+ iproc=iint_sent_local(k,jjc,ii)
+! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
+ if (iproc.ne.0) then
+ ncont_sent(iproc)=ncont_sent(iproc)+1
+ nn=ncont_sent(iproc)
+ zapas(1,nn,iproc)=i
+ zapas(2,nn,iproc)=jjc
+ zapas(3,nn,iproc)=d_cont(j,i)
+ ind=3
+ do kk=1,3
+ ind=ind+1
+ zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
+ enddo
+ do kk=1,2
+ do ll=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
+ enddo
+ enddo
+ do jj=1,5
+ do kk=1,3
+ do ll=1,2
+ do mm=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
+ enddo
+ enddo
+ enddo
+ enddo
+ endif
+ enddo
enddo
enddo
- call transpose2(aa1(1,1),aa1t(1,1))
- call transpose2(aa2(1,1),aa2t(1,1))
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
- aa1tder(1,1,lll,kkk))
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
- aa2tder(1,1,lll,kkk))
+ if (lprn) then
+ write (iout,*) &
+ "Numbers of contacts to be sent to other processors",&
+ (ncont_sent(i),i=1,ntask_cont_to)
+ write (iout,*) "Contacts sent"
+ do ii=1,ntask_cont_to
+ nn=ncont_sent(ii)
+ iproc=itask_cont_to(ii)
+ write (iout,*) nn," contacts to processor",iproc,&
+ " of CONT_TO_COMM group"
+ do i=1,nn
+ write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
enddo
- enddo
- if (l.eq.j+1) then
-! parallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i,1))
- else
- iti=ntortyp+1
+ enddo
+ call flush(iout)
+ endif
+ CorrelType=477
+ CorrelID=fg_rank+1
+ CorrelType1=478
+ CorrelID1=nfgtasks+fg_rank+1
+ ireq=0
+! Receive the numbers of needed contacts from other processors
+ do ii=1,ntask_cont_from
+ iproc=itask_cont_from(ii)
+ ireq=ireq+1
+ call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
+ FG_COMM,req(ireq),IERR)
+ enddo
+! write (iout,*) "IRECV ended"
+! call flush(iout)
+! Send the number of contacts needed by other processors
+ do ii=1,ntask_cont_to
+ iproc=itask_cont_to(ii)
+ ireq=ireq+1
+ call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
+ FG_COMM,req(ireq),IERR)
+ enddo
+! write (iout,*) "ISEND ended"
+! write (iout,*) "number of requests (nn)",ireq
+ call flush(iout)
+ if (ireq.gt.0) &
+ call MPI_Waitall(ireq,req,status_array,ierr)
+! write (iout,*)
+! & "Numbers of contacts to be received from other processors",
+! & (ncont_recv(i),i=1,ntask_cont_from)
+! call flush(iout)
+! Receive contacts
+ ireq=0
+ do ii=1,ntask_cont_from
+ iproc=itask_cont_from(ii)
+ nn=ncont_recv(ii)
+! write (iout,*) "Receiving",nn," contacts from processor",iproc,
+! & " of CONT_TO_COMM group"
+ call flush(iout)
+ if (nn.gt.0) then
+ ireq=ireq+1
+ call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
+ MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+! write (iout,*) "ireq,req",ireq,req(ireq)
endif
- itk1=itortyp(itype(k+1,1))
- itj=itortyp(itype(j,1))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1,1))
- else
- itl1=ntortyp+1
+ enddo
+! Send the contacts to processors that need them
+ do ii=1,ntask_cont_to
+ iproc=itask_cont_to(ii)
+ nn=ncont_sent(ii)
+! write (iout,*) nn," contacts to processor",iproc,
+! & " of CONT_TO_COMM group"
+ if (nn.gt.0) then
+ ireq=ireq+1
+ call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
+ iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+! write (iout,*) "ireq,req",ireq,req(ireq)
+! do i=1,nn
+! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
+! enddo
+ endif
+ enddo
+! write (iout,*) "number of requests (contacts)",ireq
+! write (iout,*) "req",(req(i),i=1,4)
+! call flush(iout)
+ if (ireq.gt.0) &
+ call MPI_Waitall(ireq,req,status_array,ierr)
+ do iii=1,ntask_cont_from
+ iproc=itask_cont_from(iii)
+ nn=ncont_recv(iii)
+ if (lprn) then
+ write (iout,*) "Received",nn," contacts from processor",iproc,&
+ " of CONT_FROM_COMM group"
+ call flush(iout)
+ do i=1,nn
+ write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
+ enddo
+ call flush(iout)
endif
-! A1 kernel(j+1) A2T
-!d do iii=1,2
-!d write (iout,'(3f10.5,5x,3f10.5)')
-!d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
-!d enddo
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
- AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
- AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
- Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
- ADtEAderx(1,1,1,1,1,1))
- lprn=.false.
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
- DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
- ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-! End 6-th order cumulants
-!d lprn=.false.
-!d if (lprn) then
-!d write (2,*) 'In calc_eello6'
-!d do iii=1,2
-!d write (2,*) 'iii=',iii
-!d do kkk=1,5
-!d write (2,*) 'kkk=',kkk
-!d do jjj=1,2
-!d write (2,'(3(2f10.5),5x)')
-!d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
-!d enddo
-!d enddo
-!d enddo
-!d endif
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
- EAEAderx(1,1,lll,kkk,iii,1))
+ do i=1,nn
+ ii=zapas_recv(1,i,iii)
+! Flag the received contacts to prevent double-counting
+ jj=-zapas_recv(2,i,iii)
+! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
+! call flush(iout)
+ nnn=num_cont_hb(ii)+1
+ num_cont_hb(ii)=nnn
+ jcont_hb(nnn,ii)=jj
+ d_cont(nnn,ii)=zapas_recv(3,i,iii)
+ ind=3
+ do kk=1,3
+ ind=ind+1
+ grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
+ enddo
+ do kk=1,2
+ do ll=1,2
+ ind=ind+1
+ a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
enddo
enddo
- enddo
-! A1T kernel(i+1) A2
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
- AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
- AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
- Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
- ADtEAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
- DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
- ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-! End 6-th order cumulants
- call transpose2(EUgder(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
- enddo
-! AEAb1 and AEAb2
-! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-! They are needed only when the fifth- or the sixth-order cumulants are
-! indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
-! Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),&
- AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),&
- AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
- AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
- AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),&
- AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),&
- AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
- AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
- AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-! End vectors
- else
-! Antiparallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i,1))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1,1))
- itl=itortyp(itype(l,1))
- itj=itortyp(itype(j,1))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1,1))
- else
- itj1=ntortyp+1
- endif
-! A2 kernel(j-1)T A1T
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
- AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
- j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
- AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
- Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
- ADtEAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
- DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
- ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-! End 6-th order cumulants
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
- EAEAderx(1,1,lll,kkk,iii,1))
+ do jj=1,5
+ do kk=1,3
+ do ll=1,2
+ do mm=1,2
+ ind=ind+1
+ a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
+ enddo
+ enddo
enddo
enddo
enddo
-! A2T kernel(i+1)T A1
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
- AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
- j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
- AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
- Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
- ADtEAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
- DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
- ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-! End 6-th order cumulants
- call transpose2(EUgder(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
+ enddo
+ call flush(iout)
+ if (lprn) then
+ write (iout,'(a)') 'Contact function values after receive:'
+ do i=nnt,nct-2
+ write (iout,'(2i3,50(1x,i3,5f6.3))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
+ ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
enddo
-! AEAb1 and AEAb2
-! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-! They are needed only when the fifth- or the sixth-order cumulants are
-! indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
- (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
-! Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),&
- AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),&
- AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
- AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
- AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),&
- AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),&
- AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
- AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
- AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
+ call flush(iout)
+ endif
+ 30 continue
+#endif
+ if (lprn) then
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt,nct-2
+ write (iout,'(2i3,50(1x,i2,5f6.3))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
+ ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
enddo
- ENDIF
-! End vectors
endif
- return
- end subroutine calc_eello
-!-----------------------------------------------------------------------------
- subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
- use comm_kut
- implicit none
- integer :: nderg
- logical :: transp
- real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
- real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
- real(kind=8),dimension(2,2,3,5,2) :: AKAderx
- real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
- integer :: iii,kkk,lll
- integer :: jjj,mmm
-!el logical :: lprn
-!el common /kutas/ lprn
- call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
- do iii=1,nderg
- call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
- AKAderg(1,1,iii))
+ ecorr=0.0D0
+ ecorr5=0.0d0
+ ecorr6=0.0d0
+
+! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
+! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
+! Remove the loop below after debugging !!!
+ do i=nnt,nct
+ do j=1,3
+ gradcorr(j,i)=0.0D0
+ gradxorr(j,i)=0.0D0
+ enddo
enddo
-!d if (lprn) write (2,*) 'In kernel'
- do kkk=1,5
-!d if (lprn) write (2,*) 'kkk=',kkk
- do lll=1,3
- call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
- KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
-!d if (lprn) then
-!d write (2,*) 'lll=',lll
-!d write (2,*) 'iii=1'
-!d do jjj=1,2
-!d write (2,'(3(2f10.5),5x)')
-!d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
-!d enddo
-!d endif
- call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
- KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
-!d if (lprn) then
-!d write (2,*) 'lll=',lll
-!d write (2,*) 'iii=2'
-!d do jjj=1,2
-!d write (2,'(3(2f10.5),5x)')
-!d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
-!d enddo
-!d endif
+! Calculate the dipole-dipole interaction energies
+ if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
+ do i=iatel_s,iatel_e+1
+ num_conti=num_cont_hb(i)
+ do jj=1,num_conti
+ j=jcont_hb(jj,i)
+#ifdef MOMENT
+ call dipole(i,j,jj)
+#endif
enddo
enddo
+ endif
+! Calculate the local-electrostatic correlation terms
+! write (iout,*) "gradcorr5 in eello5 before loop"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
+ do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
+! write (iout,*) "corr loop i",i
+ i1=i+1
+ num_conti=num_cont_hb(i)
+ num_conti1=num_cont_hb(i+1)
+ do jj=1,num_conti
+ j=jcont_hb(jj,i)
+ jp=iabs(j)
+ do kk=1,num_conti1
+ j1=jcont_hb(kk,i1)
+ jp1=iabs(j1)
+! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+! & ' jj=',jj,' kk=',kk
+! if (j1.eq.j+1 .or. j1.eq.j-1) then
+ if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
+ .or. j.lt.0 .and. j1.gt.0) .and. &
+ (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
+! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
+! The system gains extra energy.
+ n_corr=n_corr+1
+ sqd1=dsqrt(d_cont(jj,i))
+ sqd2=dsqrt(d_cont(kk,i1))
+ sred_geom = sqd1*sqd2
+ IF (sred_geom.lt.cutoff_corr) THEN
+ call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
+ ekont,fprimcont)
+!d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
+!d & ' jj=',jj,' kk=',kk
+ fac_prim1=0.5d0*sqd2/sqd1*fprimcont
+ fac_prim2=0.5d0*sqd1/sqd2*fprimcont
+ do l=1,3
+ g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
+ g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
+ enddo
+ n_corr1=n_corr1+1
+!d write (iout,*) 'sred_geom=',sred_geom,
+!d & ' ekont=',ekont,' fprim=',fprimcont,
+!d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
+!d write (iout,*) "g_contij",g_contij
+!d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
+!d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
+ call calc_eello(i,jp,i+1,jp1,jj,kk)
+ if (wcorr4.gt.0.0d0) &
+ ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
+ if (energy_dec.and.wcorr4.gt.0.0d0) &
+ write (iout,'(a6,4i5,0pf7.3)') &
+ 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
+! write (iout,*) "gradcorr5 before eello5"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
+ if (wcorr5.gt.0.0d0) &
+ ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
+! write (iout,*) "gradcorr5 after eello5"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
+ if (energy_dec.and.wcorr5.gt.0.0d0) &
+ write (iout,'(a6,4i5,0pf7.3)') &
+ 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
+!d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
+!d write(2,*)'ijkl',i,jp,i+1,jp1
+ if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
+ .or. wturn6.eq.0.0d0))then
+!d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
+ ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
+ if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
+ 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
+!d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
+!d & 'ecorr6=',ecorr6
+!d write (iout,'(4e15.5)') sred_geom,
+!d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
+!d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
+!d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
+ else if (wturn6.gt.0.0d0 &
+ .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
+!d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
+ eturn6=eturn6+eello_turn6(i,jj,kk)
+ if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
+ 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
+!d write (2,*) 'multibody_eello:eturn6',eturn6
+ endif
+ ENDIF
+1111 continue
+ endif
+ enddo ! kk
+ enddo ! jj
+ enddo ! i
+ do i=1,nres
+ num_cont_hb(i)=num_cont_hb_old(i)
+ enddo
+! write (iout,*) "gradcorr5 in eello5"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
return
- end subroutine kernel
+ end subroutine multibody_eello
!-----------------------------------------------------------------------------
- real(kind=8) function eello4(i,j,k,l,jj,kk)
+ subroutine add_hb_contact_eello(ii,jj,itask)
+! implicit real*8 (a-h,o-z)
+! include "DIMENSIONS"
+! include "COMMON.IOUNITS"
+! include "COMMON.CONTACTS"
+! integer,parameter :: maxconts=nres/4
+ integer,parameter :: max_dim=70
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
+! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+! common /przechowalnia/ zapas
+
+ integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
+ integer,dimension(4) ::itask
+! write (iout,*) "itask",itask
+ do i=1,2
+ iproc=itask(i)
+ if (iproc.gt.0) then
+ do j=1,num_cont_hb(ii)
+ jjc=jcont_hb(j,ii)
+! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
+ if (jjc.eq.jj) then
+ ncont_sent(iproc)=ncont_sent(iproc)+1
+ nn=ncont_sent(iproc)
+ zapas(1,nn,iproc)=ii
+ zapas(2,nn,iproc)=jjc
+ zapas(3,nn,iproc)=d_cont(j,ii)
+ ind=3
+ do kk=1,3
+ ind=ind+1
+ zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
+ enddo
+ do kk=1,2
+ do ll=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
+ enddo
+ enddo
+ do jj=1,5
+ do kk=1,3
+ do ll=1,2
+ do mm=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
+ enddo
+ enddo
+ enddo
+ enddo
+ exit
+ endif
+ enddo
+ endif
+ enddo
+ return
+ end subroutine add_hb_contact_eello
+!-----------------------------------------------------------------------------
+ real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- real(kind=8),dimension(2,2) :: pizda
- real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8) :: eel4,glongij,glongkl
- integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
-!d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
-!d eello4=0.0d0
-!d return
-!d endif
-!d print *,'eello4:',i,j,k,l,jj,kk
-!d write (2,*) 'i',i,' j',j,' k',k,' l',l
-!d call checkint4(i,j,k,l,jj,kk,eel4_num)
-!old eij=facont_hb(jj,i)
-!old ekl=facont_hb(kk,k)
-!old ekont=eij*ekl
- eel4=-EAEA(1,1,1)-EAEA(2,2,1)
-!d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
- gcorr_loc(k-1)=gcorr_loc(k-1) &
- -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
- if (l.eq.j+1) then
- gcorr_loc(l-1)=gcorr_loc(l-1) &
- -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- else
- gcorr_loc(j-1)=gcorr_loc(j-1) &
- -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
- -EAEAderx(2,2,lll,kkk,iii,1)
-!d derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d gcorr_loc(l-1)=0.0d0
-!d gcorr_loc(j-1)=0.0d0
-!d gcorr_loc(k-1)=0.0d0
-!d eel4=1.0d0
-!d write (iout,*)'Contacts have occurred for peptide groups',
-!d & i,j,' fcont:',eij,' eij',' and ',k,l,
-!d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
+ real(kind=8),dimension(3) :: gx,gx1
+ logical :: lprn
+!el local variables
+ integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
+ real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
+ ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
+
+ lprn=.false.
+ eij=facont_hb(jj,i)
+ ekl=facont_hb(kk,k)
+ ees0pij=ees0p(jj,i)
+ ees0pkl=ees0p(kk,k)
+ ees0mij=ees0m(jj,i)
+ ees0mkl=ees0m(kk,k)
+ ekont=eij*ekl
+ ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
+!d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
+! Following 4 lines for diagnostics.
+!d ees0pkl=0.0D0
+!d ees0pij=1.0D0
+!d ees0mkl=0.0D0
+!d ees0mij=1.0D0
+! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
+! & 'Contacts ',i,j,
+! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
+! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
+! & 'gradcorr_long'
+! Calculate the multi-body contribution to energy.
+! ecorr=ecorr+ekont*ees
+! Calculate multi-body contributions to the gradient.
+ coeffpees0pij=coeffp*ees0pij
+ coeffmees0mij=coeffm*ees0mij
+ coeffpees0pkl=coeffp*ees0pkl
+ coeffmees0mkl=coeffm*ees0mkl
do ll=1,3
-!grad ggg1(ll)=eel4*g_contij(ll,1)
-!grad ggg2(ll)=eel4*g_contij(ll,2)
- glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
- glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
-!grad ghalf=0.5d0*ggg1(ll)
- gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
- gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
- gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
-!grad ghalf=0.5d0*ggg2(ll)
- gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
- gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
- gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
+!grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
+ gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
+ -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb1(ll,jj,i))
+ gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+!grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
+ gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
+ gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
+ gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
+! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
enddo
+! write (iout,*)
!grad do m=i+1,j-1
!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+
+!grad & ees*ekl*gacont_hbr(ll,jj,i)-
+!grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
+!grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
!grad enddo
!grad enddo
!grad do m=k+1,l-1
!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
-!grad enddo
-!grad enddo
-!grad do m=i+2,j2
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
-!grad enddo
-!grad enddo
-!grad do m=k+2,l2
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+
+!grad & ees*eij*gacont_hbr(ll,kk,k)-
+!grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
+!grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
!grad enddo
!grad enddo
-!d do iii=1,nres-3
-!d write (2,*) iii,gcorr_loc(iii)
-!d enddo
- eello4=ekont*eel4
-!d write (2,*) 'ekont',ekont
-!d write (iout,*) 'eello4',ekont*eel4
+! write (iout,*) "ehbcorr",ekont*ees
+ ehbcorr=ekont*ees
+ if (shield_mode.gt.0) then
+ j=ees0plist(jj,i)
+ l=ees0plist(kk,k)
+!C print *,i,j,fac_shield(i),fac_shield(j),
+!C &fac_shield(k),fac_shield(l)
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
+ (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
+ +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
+ +rlocshield
+ enddo
+ enddo
+
+ do ilist=1,ishield_list(k)
+ iresshield=shield_list(ilist,k)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
+ +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(l)
+ iresshield=shield_list(ilist,l)
+ do m=1,3
+ rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
+ gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
+ gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
+ +rlocshield
+ enddo
+ enddo
+ do m=1,3
+ gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
+ grad_shield(m,i)*ehbcorr/fac_shield(i)
+ gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
+ grad_shield(m,j)*ehbcorr/fac_shield(j)
+ gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
+ grad_shield(m,i)*ehbcorr/fac_shield(i)
+ gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
+ grad_shield(m,j)*ehbcorr/fac_shield(j)
+
+ gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
+ grad_shield(m,k)*ehbcorr/fac_shield(k)
+ gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
+ grad_shield(m,l)*ehbcorr/fac_shield(l)
+ gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
+ grad_shield(m,k)*ehbcorr/fac_shield(k)
+ gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
+ grad_shield(m,l)*ehbcorr/fac_shield(l)
+
+ enddo
+ endif
+ endif
return
- end function eello4
+ end function ehbcorr
+#ifdef MOMENT
!-----------------------------------------------------------------------------
- real(kind=8) function eello5(i,j,k,l,jj,kk)
+ subroutine dipole(i,j,jj)
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
+! include 'COMMON.FFIELD'
! include 'COMMON.DERIV'
! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
! include 'COMMON.TORSION'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
- real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
- real(kind=8),dimension(2) :: vv
- real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
- real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
- integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel chains C
-! C
-! o o o o C
-! /l\ / \ \ / \ / \ / C
-! / \ / \ \ / \ / \ / C
-! j| o |l1 | o | o| o | | o |o C
-! \ |/k\| |/ \| / |/ \| |/ \| C
-! \i/ \ / \ / / \ / \ C
-! o k1 o C
-! (I) (II) (III) (IV) C
-! C
-! eello5_1 eello5_2 eello5_3 eello5_4 C
-! C
-! Antiparallel chains C
-! C
-! o o o o C
-! /j\ / \ \ / \ / \ / C
-! / \ / \ \ / \ / \ / C
-! j1| o |l | o | o| o | | o |o C
-! \ |/k\| |/ \| / |/ \| |/ \| C
-! \i/ \ / \ / / \ / \ C
-! o k1 o C
-! (I) (II) (III) (IV) C
-! C
-! eello5_1 eello5_2 eello5_3 eello5_4 C
-! C
-! o denotes a local interaction, vertical lines an electrostatic interaction. C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
-!d eello5=0.0d0
-!d return
-!d endif
-!d write (iout,*)
-!d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
-!d & ' and',k,l
- itk=itortyp(itype(k,1))
- itl=itortyp(itype(l,1))
- itj=itortyp(itype(j,1))
- eello5_1=0.0d0
- eello5_2=0.0d0
- eello5_3=0.0d0
- eello5_4=0.0d0
-!d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
-!d & eel5_3_num,eel5_4_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d eij=facont_hb(jj,i)
-!d ekl=facont_hb(kk,k)
-!d ekont=eij*ekl
-!d write (iout,*)'Contacts have occurred for peptide groups',
-!d & i,j,' fcont:',eij,' eij',' and ',k,l
-!d goto 1111
-! Contribution from the graph I.
-!d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
-!d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i))
-! Explicit gradient in virtual-dihedral angles.
- if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
- +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- if (l.eq.j+1) then
- if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+ real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
+ real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
+ integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
+
+ allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
+ allocate(dipderx(3,5,4,maxconts,nres))
+!
+
+ iti1 = itortyp(itype(i+1,1))
+ if (j.lt.nres-1) then
+ itj1 = itype2loc(itype(j+1,1))
else
- if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- endif
-! Cartesian gradient
+ itj1=nloctyp
+ endif
do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i))
- enddo
- enddo
+ dipi(iii,1)=Ub2(iii,i)
+ dipderi(iii)=Ub2der(iii,i)
+ dipi(iii,2)=b1(iii,iti1)
+ dipj(iii,1)=Ub2(iii,j)
+ dipderj(iii)=Ub2der(iii,j)
+ dipj(iii,2)=b1(iii,itj1)
enddo
-! goto 1112
-!1111 continue
-! Contribution from graph II
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- if (l.eq.j+1) then
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- else
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- endif
-! Cartesian gradient
+ kkk=0
do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k))
- enddo
+ call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
+ do jjj=1,2
+ kkk=kkk+1
+ dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
enddo
enddo
-!d goto 1112
-!d1111 continue
- if (l.eq.j+1) then
-!d goto 1110
-! Parallel orientation
-! Contribution from graph III
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
- call transpose2(EUgder(1,1,l),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j))
+ do kkk=1,5
+ do lll=1,3
+ mmm=0
+ do iii=1,2
+ call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
+ auxvec(1))
+ do jjj=1,2
+ mmm=mmm+1
+ dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
enddo
enddo
enddo
-!d goto 1112
-! Contribution from graph IV
-!d1110 continue
- call transpose2(EE(1,1,itl),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,l))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,l)))
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,l))
- enddo
- enddo
+ enddo
+ call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
+ call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
+ do iii=1,2
+ dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
+ enddo
+ call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
+ do iii=1,2
+ dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
+ enddo
+ return
+ end subroutine dipole
+#endif
+!-----------------------------------------------------------------------------
+ subroutine calc_eello(i,j,k,l,jj,kk)
+!
+! This subroutine computes matrices and vectors needed to calculate
+! the fourth-, fifth-, and sixth-order local-electrostatic terms.
+!
+ use comm_kut
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.FFIELD'
+ real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
+ real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
+ integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
+ itj1
+!el logical :: lprn
+!el common /kutas/ lprn
+!d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
+!d & ' jj=',jj,' kk=',kk
+!d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
+!d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
+!d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
+ do iii=1,2
+ do jjj=1,2
+ aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
+ aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
enddo
- else
-! Antiparallel orientation
-! Contribution from graph III
-! goto 1110
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
- call transpose2(EUgder(1,1,j),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
-! Cartesian gradient
+ enddo
+ call transpose2(aa1(1,1),aa1t(1,1))
+ call transpose2(aa2(1,1),aa2t(1,1))
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
+ aa1tder(1,1,lll,kkk))
+ call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
+ aa2tder(1,1,lll,kkk))
+ enddo
+ enddo
+ if (l.eq.j+1) then
+! parallel orientation of the two CA-CA-CA frames.
+ if (i.gt.1) then
+ iti=itortyp(itype(i,1))
+ else
+ iti=ntortyp+1
+ endif
+ itk1=itortyp(itype(k+1,1))
+ itj=itortyp(itype(j,1))
+ if (l.lt.nres-1) then
+ itl1=itortyp(itype(l+1,1))
+ else
+ itl1=ntortyp+1
+ endif
+! A1 kernel(j+1) A2T
+!d do iii=1,2
+!d write (iout,'(3f10.5,5x,3f10.5)')
+!d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
+!d enddo
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
+ AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0) THEN
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
+ AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
+ Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
+ ADtEAderx(1,1,1,1,1,1))
+ lprn=.false.
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
+ DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
+ ADtEA1derx(1,1,1,1,1,1))
+ ENDIF
+! End 6-th order cumulants
+!d lprn=.false.
+!d if (lprn) then
+!d write (2,*) 'In calc_eello6'
+!d do iii=1,2
+!d write (2,*) 'iii=',iii
+!d do kkk=1,5
+!d write (2,*) 'kkk=',kkk
+!d do jjj=1,2
+!d write (2,'(3(2f10.5),5x)')
+!d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
+!d enddo
+!d enddo
+!d enddo
+!d endif
+ call transpose2(EUgder(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
+ call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
do iii=1,2
do kkk=1,5
do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
- +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l))
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
+ EAEAderx(1,1,lll,kkk,iii,1))
enddo
enddo
enddo
-!d goto 1112
-! Contribution from graph IV
-1110 continue
- call transpose2(EE(1,1,itj),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,j))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,j)))
-! Cartesian gradient
+! A1T kernel(i+1) A2
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
+ AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0) THEN
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
+ AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
+ Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
+ ADtEAderx(1,1,1,1,1,2))
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
+ DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
+ ADtEA1derx(1,1,1,1,1,2))
+ ENDIF
+! End 6-th order cumulants
+ call transpose2(EUgder(1,1,l),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
+ call transpose2(EUg(1,1,l),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
do iii=1,2
do kkk=1,5
do lll=1,3
call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
- +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,j))
+ EAEAderx(1,1,lll,kkk,iii,2))
enddo
enddo
enddo
- endif
-1112 continue
- eel5=eello5_1+eello5_2+eello5_3+eello5_4
-!d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
-!d write (2,*) 'ijkl',i,j,k,l
-!d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
-!d & ' eello5_3',eello5_3,' eello5_4',eello5_4
-!d endif
-!d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
-!d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
-!d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
-!d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
+! AEAb1 and AEAb2
+! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
+! They are needed only when the fifth- or the sixth-order cumulants are
+! indluded.
+ IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
+ call transpose2(AEA(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
+ call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
+ call transpose2(AEAderg(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
+ call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
+ call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
+ call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
+ call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
+ call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
+ call transpose2(AEA(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
+ call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
+ call transpose2(AEAderg(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
+ call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
+ call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
+ call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
+ call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
+ call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
+! Calculate the Cartesian derivatives of the vectors.
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),&
+ AEAb1derx(1,lll,kkk,iii,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),&
+ AEAb2derx(1,lll,kkk,iii,1,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
+ AEAb1derx(1,lll,kkk,iii,2,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
+ AEAb2derx(1,lll,kkk,iii,2,1))
+ call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj),&
+ AEAb1derx(1,lll,kkk,iii,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,j),&
+ AEAb2derx(1,lll,kkk,iii,1,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
+ AEAb1derx(1,lll,kkk,iii,2,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
+ AEAb2derx(1,lll,kkk,iii,2,2))
+ enddo
+ enddo
+ enddo
+ ENDIF
+! End vectors
else
- l1=l-1
- l2=l-2
- endif
-!d eij=1.0d0
-!d ekl=1.0d0
-!d ekont=1.0d0
-!d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
-! 2/11/08 AL Gradients over DC's connecting interacting sites will be
-! summed up outside the subrouine as for the other subroutines
-! handling long-range interactions. The old code is commented out
-! with "cgrad" to keep track of changes.
- do ll=1,3
-!grad ggg1(ll)=eel5*g_contij(ll,1)
-!grad ggg2(ll)=eel5*g_contij(ll,2)
- gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
-! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
-! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
-! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
-! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
-! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
-! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
-! & gradcorr5ij,
-! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
-!old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
-!grad ghalf=0.5d0*ggg1(ll)
-!d ghalf=0.0d0
- gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
- gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
- gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
- gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
- gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
-!old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
-!grad ghalf=0.5d0*ggg2(ll)
- ghalf=0.0d0
- gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
- gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
- gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
- gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
- gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
+! Antiparallel orientation of the two CA-CA-CA frames.
+ if (i.gt.1) then
+ iti=itortyp(itype(i,1))
+ else
+ iti=ntortyp+1
+ endif
+ itk1=itortyp(itype(k+1,1))
+ itl=itortyp(itype(l,1))
+ itj=itortyp(itype(j,1))
+ if (j.lt.nres-1) then
+ itj1=itortyp(itype(j+1,1))
+ else
+ itj1=ntortyp+1
+ endif
+! A2 kernel(j-1)T A1T
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
+ AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
+ j.eq.i+4 .and. l.eq.i+3)) THEN
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
+ AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
+ call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
+ Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
+ ADtEAderx(1,1,1,1,1,1))
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
+ DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
+ ADtEA1derx(1,1,1,1,1,1))
+ ENDIF
+! End 6-th order cumulants
+ call transpose2(EUgder(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
+ call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
+ EAEAderx(1,1,lll,kkk,iii,1))
+ enddo
+ enddo
+ enddo
+! A2T kernel(i+1)T A1
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
+ AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
+ j.eq.i+4 .and. l.eq.i+3)) THEN
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
+ AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
+ Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
+ ADtEAderx(1,1,1,1,1,2))
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
+ DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
+ ADtEA1derx(1,1,1,1,1,2))
+ ENDIF
+! End 6-th order cumulants
+ call transpose2(EUgder(1,1,j),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
+ call transpose2(EUg(1,1,j),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
+ EAEAderx(1,1,lll,kkk,iii,2))
+ enddo
+ enddo
+ enddo
+! AEAb1 and AEAb2
+! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
+! They are needed only when the fifth- or the sixth-order cumulants are
+! indluded.
+ IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
+ (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
+ call transpose2(AEA(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
+ call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
+ call transpose2(AEAderg(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
+ call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
+ call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
+ call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
+ call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
+ call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
+ call transpose2(AEA(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
+ call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
+ call transpose2(AEAderg(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
+ call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
+ call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
+ call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
+ call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
+ call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
+! Calculate the Cartesian derivatives of the vectors.
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),&
+ AEAb1derx(1,lll,kkk,iii,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),&
+ AEAb2derx(1,lll,kkk,iii,1,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
+ AEAb1derx(1,lll,kkk,iii,2,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
+ AEAb2derx(1,lll,kkk,iii,2,1))
+ call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itl),&
+ AEAb1derx(1,lll,kkk,iii,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,l),&
+ AEAb2derx(1,lll,kkk,iii,1,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
+ AEAb1derx(1,lll,kkk,iii,2,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
+ AEAb2derx(1,lll,kkk,iii,2,2))
+ enddo
+ enddo
+ enddo
+ ENDIF
+! End vectors
+ endif
+ return
+ end subroutine calc_eello
+!-----------------------------------------------------------------------------
+ subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
+ use comm_kut
+ implicit none
+ integer :: nderg
+ logical :: transp
+ real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
+ real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
+ real(kind=8),dimension(2,2,3,5,2) :: AKAderx
+ real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
+ integer :: iii,kkk,lll
+ integer :: jjj,mmm
+!el logical :: lprn
+!el common /kutas/ lprn
+ call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
+ do iii=1,nderg
+ call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
+ AKAderg(1,1,iii))
+ enddo
+!d if (lprn) write (2,*) 'In kernel'
+ do kkk=1,5
+!d if (lprn) write (2,*) 'kkk=',kkk
+ do lll=1,3
+ call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
+ KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
+!d if (lprn) then
+!d write (2,*) 'lll=',lll
+!d write (2,*) 'iii=1'
+!d do jjj=1,2
+!d write (2,'(3(2f10.5),5x)')
+!d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
+!d enddo
+!d endif
+ call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
+ KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
+!d if (lprn) then
+!d write (2,*) 'lll=',lll
+!d write (2,*) 'iii=2'
+!d do jjj=1,2
+!d write (2,'(3(2f10.5),5x)')
+!d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
+!d enddo
+!d endif
+ enddo
enddo
-!d goto 1112
-!grad do m=i+1,j-1
-!grad do ll=1,3
-!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
-!grad enddo
-!grad enddo
-!grad do m=k+1,l-1
-!grad do ll=1,3
-!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
-!grad enddo
-!grad enddo
-!1112 continue
-!grad do m=i+2,j2
-!grad do ll=1,3
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
-!grad enddo
-!grad enddo
-!grad do m=k+2,l2
-!grad do ll=1,3
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
-!grad enddo
-!grad enddo
-!d do iii=1,nres-3
-!d write (2,*) iii,g_corr5_loc(iii)
-!d enddo
- eello5=ekont*eel5
-!d write (2,*) 'ekont',ekont
-!d write (iout,*) 'eello5',ekont*eel5
return
- end function eello5
+ end subroutine kernel
!-----------------------------------------------------------------------------
- real(kind=8) function eello6(i,j,k,l,jj,kk)
+ real(kind=8) function eello4(i,j,k,l,jj,kk)
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.TORSION'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
-! include 'COMMON.FFIELD'
+ real(kind=8),dimension(2,2) :: pizda
real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
- eello6_6,eel6
- real(kind=8) :: gradcorr6ij,gradcorr6kl
+ real(kind=8) :: eel4,glongij,glongkl
integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
-!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-!d eello6=0.0d0
+!d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
+!d eello4=0.0d0
!d return
!d endif
-!d write (iout,*)
-!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-!d & ' and',k,l
- eello6_1=0.0d0
- eello6_2=0.0d0
- eello6_3=0.0d0
- eello6_4=0.0d0
- eello6_5=0.0d0
- eello6_6=0.0d0
-!d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
-!d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d eij=facont_hb(jj,i)
-!d ekl=facont_hb(kk,k)
-!d ekont=eij*ekl
-!d eij=1.0d0
-!d ekl=1.0d0
-!d ekont=1.0d0
+!d print *,'eello4:',i,j,k,l,jj,kk
+!d write (2,*) 'i',i,' j',j,' k',k,' l',l
+!d call checkint4(i,j,k,l,jj,kk,eel4_num)
+!old eij=facont_hb(jj,i)
+!old ekl=facont_hb(kk,k)
+!old ekont=eij*ekl
+ eel4=-EAEA(1,1,1)-EAEA(2,2,1)
+!d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
+ gcorr_loc(k-1)=gcorr_loc(k-1) &
+ -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
if (l.eq.j+1) then
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(j,i,l,k,2,.false.)
- eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
- eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
+ gcorr_loc(l-1)=gcorr_loc(l-1) &
+ -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
else
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(l,k,j,i,2,.true.)
- eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
- else
- eello6_5=0.0d0
- endif
- eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
+ gcorr_loc(j-1)=gcorr_loc(j-1) &
+ -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
endif
-! If turn contributions are considered, they will be handled separately.
- eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
-!d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
-!d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
-!d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
-!d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
-!d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
-!d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
-!d goto 1112
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
+ -EAEAderx(2,2,lll,kkk,iii,1)
+!d derx(lll,kkk,iii)=0.0d0
+ enddo
+ enddo
+ enddo
+!d gcorr_loc(l-1)=0.0d0
+!d gcorr_loc(j-1)=0.0d0
+!d gcorr_loc(k-1)=0.0d0
+!d eel4=1.0d0
+!d write (iout,*)'Contacts have occurred for peptide groups',
+!d & i,j,' fcont:',eij,' eij',' and ',k,l,
+!d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
if (j.lt.nres-1) then
j1=j+1
j2=j-1
l2=l-2
endif
do ll=1,3
-!grad ggg1(ll)=eel6*g_contij(ll,1)
-!grad ggg2(ll)=eel6*g_contij(ll,2)
-!old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
+!grad ggg1(ll)=eel4*g_contij(ll,1)
+!grad ggg2(ll)=eel4*g_contij(ll,2)
+ glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
+ glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
!grad ghalf=0.5d0*ggg1(ll)
-!d ghalf=0.0d0
- gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
- gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
- gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
- gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
- gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
- gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
+ gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
+ gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
+ gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
+ gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
+ gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
+ gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
!grad ghalf=0.5d0*ggg2(ll)
-!old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
-!d ghalf=0.0d0
- gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
- gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
- gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
- gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
- gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
+ gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
+ gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
+ gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
+ gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
+ gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
+ gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
enddo
-!d goto 1112
!grad do m=i+1,j-1
!grad do ll=1,3
-!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
!grad enddo
!grad enddo
!grad do m=k+1,l-1
!grad do ll=1,3
-!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
!grad enddo
!grad enddo
-!grad1112 continue
!grad do m=i+2,j2
!grad do ll=1,3
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
!grad enddo
!grad enddo
!grad do m=k+2,l2
!grad do ll=1,3
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
!grad enddo
!grad enddo
!d do iii=1,nres-3
-!d write (2,*) iii,g_corr6_loc(iii)
+!d write (2,*) iii,gcorr_loc(iii)
!d enddo
- eello6=ekont*eel6
+ eello4=ekont*eel4
!d write (2,*) 'ekont',ekont
-!d write (iout,*) 'eello6',ekont*eel6
+!d write (iout,*) 'eello4',ekont*eel4
return
- end function eello6
+ end function eello4
!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
- use comm_kut
+ real(kind=8) function eello5(i,j,k,l,jj,kk)
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.TORSION'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
- real(kind=8),dimension(2) :: vv,vv1
- real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
- logical :: swap
-!el logical :: lprn
-!el common /kutas/ lprn
- integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
- real(kind=8) :: s1,s2,s3,s4,s5
+ real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
+ real(kind=8),dimension(2) :: vv
+ real(kind=8),dimension(3) :: ggg1,ggg2
+ real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
+ real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
+ integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! C
-! Parallel Antiparallel C
+! Parallel chains C
! C
-! o o C
-! /l\ /j\ C
-! / \ / \ C
-! /| o | | o |\ C
-! \ j|/k\| / \ |/k\|l / C
-! \ / \ / \ / \ / C
-! o o o o C
-! i i C
+! o o o o C
+! /l\ / \ \ / \ / \ / C
+! / \ / \ \ / \ / \ / C
+! j| o |l1 | o | o| o | | o |o C
+! \ |/k\| |/ \| / |/ \| |/ \| C
+! \i/ \ / \ / / \ / \ C
+! o k1 o C
+! (I) (II) (III) (IV) C
+! C
+! eello5_1 eello5_2 eello5_3 eello5_4 C
+! C
+! Antiparallel chains C
+! C
+! o o o o C
+! /j\ / \ \ / \ / \ / C
+! / \ / \ \ / \ / \ / C
+! j1| o |l | o | o| o | | o |o C
+! \ |/k\| |/ \| / |/ \| |/ \| C
+! \i/ \ / \ / / \ / \ C
+! o k1 o C
+! (I) (II) (III) (IV) C
+! C
+! eello5_1 eello5_2 eello5_3 eello5_4 C
+! C
+! o denotes a local interaction, vertical lines an electrostatic interaction. C
! C
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
+!d eello5=0.0d0
+!d return
+!d endif
+!d write (iout,*)
+!d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
+!d & ' and',k,l
itk=itortyp(itype(k,1))
- s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
- eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
- if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
- -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
- -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
- +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
- +scalar2(vv(1),Dtobr2der(1,i)))
- call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
- if (l.eq.j+1) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1) &
- +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
- -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
- +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1) &
- +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
- -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
- +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- endif
- call transpose2(EUgCder(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
- +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
- +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
+ itl=itortyp(itype(l,1))
+ itj=itortyp(itype(j,1))
+ eello5_1=0.0d0
+ eello5_2=0.0d0
+ eello5_3=0.0d0
+ eello5_4=0.0d0
+!d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
+!d & eel5_3_num,eel5_4_num)
do iii=1,2
- if (swap) then
- ind=3-iii
- else
- ind=iii
- endif
do kkk=1,5
do lll=1,3
- s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
- pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
- -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
- vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
- +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
- derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
+ derx(lll,kkk,iii)=0.0d0
enddo
enddo
enddo
- return
- end function eello6_graph1
-!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
- use comm_kut
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- logical :: swap
- real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
- real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
-!el logical :: lprn
-!el common /kutas/ lprn
- integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
- real(kind=8) :: s2,s3,s4
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel Antiparallel C
-! C
-! o o C
-! \ /l\ /j\ / C
-! \ / \ / \ / C
-! o| o | | o |o C
-! \ j|/k\| \ |/k\|l C
-! \ / \ \ / \ C
-! o o C
-! i i C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
-! AL 7/4/01 s1 would occur in the sixth-order moment,
-! but not in a cluster cumulant
-#ifdef MOMENT
- s1=dip(1,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
+!d eij=facont_hb(jj,i)
+!d ekl=facont_hb(kk,k)
+!d ekont=eij*ekl
+!d write (iout,*)'Contacts have occurred for peptide groups',
+!d & i,j,' fcont:',eij,' eij',' and ',k,l
+!d goto 1111
+! Contribution from the graph I.
+!d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
+!d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
+ call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
vv(1)=pizda(1,1)-pizda(2,2)
vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph2=-(s1+s2+s3+s4)
-#else
- eello6_graph2=-(s2+s3+s4)
-#endif
-! eello6_graph2=-s3
-! Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- s1=dipderg(1,jj,i)*dip(1,kk,k)
-#endif
- s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
-! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
- endif
-! Derivatives in gamma(k-1)
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+ eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i))
+! Explicit gradient in virtual-dihedral angles.
+ if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
+ +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
+ call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
vv(1)=pizda(1,1)-pizda(2,2)
vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
-! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
-! Derivatives in gamma(j-1) or gamma(l-1)
- if (j.gt.1) then
-#ifdef MOMENT
- s1=dipderg(3,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
- call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
-! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
- endif
-! Derivatives in gamma(l-1) or gamma(j-1)
- if (l.gt.1) then
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(3,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- else
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
-! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
- endif
-! Cartesian derivatives.
- if (lprn) then
- write (2,*) 'In eello6_graph2'
- do iii=1,2
- write (2,*) 'iii=',iii
- do kkk=1,5
- write (2,*) 'kkk=',kkk
- do jjj=1,2
- write (2,'(3(2f10.5),5x)') &
- ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
- enddo
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+ call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ if (l.eq.j+1) then
+ if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+ else
+ if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+ endif
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i))
enddo
enddo
+ enddo
+! goto 1112
+!1111 continue
+! Contribution from graph II
+ call transpose2(EE(1,1,itk),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
+ call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ if (l.eq.j+1) then
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k)))
+ else
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k)))
endif
+! Cartesian gradient
do iii=1,2
do kkk=1,5
do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
- else
- s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
- endif
-#endif
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
- auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
- auxvec(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k))
enddo
enddo
enddo
- return
- end function eello6_graph2
-!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- real(kind=8),dimension(2) :: vv,auxvec
- real(kind=8),dimension(2,2) :: pizda,auxmat
- logical :: swap
- integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
- real(kind=8) :: s1,s2,s3,s4
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel Antiparallel C
-! C
-! o o C
-! /l\ / \ /j\ C
-! / \ / \ / \ C
-! /| o |o o| o |\ C
-! j|/k\| / |/k\|l / C
-! / \ / / \ / C
-! / o / o C
-! i i C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!
-! 4/7/01 AL Component s1 was removed, because it pertains to the respective
-! energy moment and not to the cluster cumulant.
- iti=itortyp(itype(i,1))
+!d goto 1112
+!d1111 continue
+ if (l.eq.j+1) then
+!d goto 1110
+! Parallel orientation
+! Contribution from graph III
+ call transpose2(EUg(1,1,l),auxmat(1,1))
+ call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
+ call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
+ call transpose2(EUgder(1,1,l),auxmat1(1,1))
+ call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j))
+ enddo
+ enddo
+ enddo
+!d goto 1112
+! Contribution from graph IV
+!d1110 continue
+ call transpose2(EE(1,1,itl),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,l))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,l)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,l))
+ enddo
+ enddo
+ enddo
+ else
+! Antiparallel orientation
+! Contribution from graph III
+! goto 1110
+ call transpose2(EUg(1,1,j),auxmat(1,1))
+ call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
+ call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
+ call transpose2(EUgder(1,1,j),auxmat1(1,1))
+ call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
+ +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l))
+ enddo
+ enddo
+ enddo
+!d goto 1112
+! Contribution from graph IV
+1110 continue
+ call transpose2(EE(1,1,itj),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,j))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,j)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
+ +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,j))
+ enddo
+ enddo
+ enddo
+ endif
+1112 continue
+ eel5=eello5_1+eello5_2+eello5_3+eello5_4
+!d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
+!d write (2,*) 'ijkl',i,j,k,l
+!d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
+!d & ' eello5_3',eello5_3,' eello5_4',eello5_4
+!d endif
+!d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
+!d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
+!d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
+!d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1,1))
+ j1=j+1
+ j2=j-1
else
- itj1=ntortyp+1
+ j1=j-1
+ j2=j-2
endif
- itk=itortyp(itype(k,1))
- itk1=itortyp(itype(k+1,1))
if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1,1))
+ l1=l+1
+ l2=l-1
else
- itl1=ntortyp+1
+ l1=l-1
+ l2=l-2
endif
-#ifdef MOMENT
- s1=dip(4,jj,i)*dip(4,kk,k)
-#endif
- call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-!d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
-!d & "sum",-(s2+s3+s4)
-#ifdef MOMENT
- eello6_graph3=-(s1+s2+s3+s4)
-#else
- eello6_graph3=-(s2+s3+s4)
-#endif
-! eello6_graph3=-s4
-! Derivatives in gamma(k-1)
- call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
-! Derivatives in gamma(l-1)
- call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
-! Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
- else
- s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
- auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
- auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
-! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
+!d eij=1.0d0
+!d ekl=1.0d0
+!d ekont=1.0d0
+!d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
+! 2/11/08 AL Gradients over DC's connecting interacting sites will be
+! summed up outside the subrouine as for the other subroutines
+! handling long-range interactions. The old code is commented out
+! with "cgrad" to keep track of changes.
+ do ll=1,3
+!grad ggg1(ll)=eel5*g_contij(ll,1)
+!grad ggg2(ll)=eel5*g_contij(ll,2)
+ gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
+ gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
+! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
+! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
+! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
+! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
+! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
+! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
+! & gradcorr5ij,
+! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
+!old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
+!grad ghalf=0.5d0*ggg1(ll)
+!d ghalf=0.0d0
+ gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
+ gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
+ gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
+ gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
+ gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
+ gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
+!old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
+!grad ghalf=0.5d0*ggg2(ll)
+ ghalf=0.0d0
+ gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
+ gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
+ gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
+ gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
+ gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
+ gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
+ enddo
+!d goto 1112
+!grad do m=i+1,j-1
+!grad do ll=1,3
+!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
+!grad enddo
+!grad enddo
+!grad do m=k+1,l-1
+!grad do ll=1,3
+!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
+!grad enddo
+!grad enddo
+!1112 continue
+!grad do m=i+2,j2
+!grad do ll=1,3
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
+!grad enddo
+!grad enddo
+!grad do m=k+2,l2
+!grad do ll=1,3
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
+!grad enddo
+!grad enddo
+!d do iii=1,nres-3
+!d write (2,*) iii,g_corr5_loc(iii)
+!d enddo
+ eello5=ekont*eel5
+!d write (2,*) 'ekont',ekont
+!d write (iout,*) 'eello5',ekont*eel5
+ return
+ end function eello5
+!-----------------------------------------------------------------------------
+ real(kind=8) function eello6(i,j,k,l,jj,kk)
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.FFIELD'
+ real(kind=8),dimension(3) :: ggg1,ggg2
+ real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
+ eello6_6,eel6
+ real(kind=8) :: gradcorr6ij,gradcorr6kl
+ integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
+!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
+!d eello6=0.0d0
+!d return
+!d endif
+!d write (iout,*)
+!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
+!d & ' and',k,l
+ eello6_1=0.0d0
+ eello6_2=0.0d0
+ eello6_3=0.0d0
+ eello6_4=0.0d0
+ eello6_5=0.0d0
+ eello6_6=0.0d0
+!d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
+!d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ derx(lll,kkk,iii)=0.0d0
enddo
enddo
enddo
+!d eij=facont_hb(jj,i)
+!d ekl=facont_hb(kk,k)
+!d ekont=eij*ekl
+!d eij=1.0d0
+!d ekl=1.0d0
+!d ekont=1.0d0
+ if (l.eq.j+1) then
+ eello6_1=eello6_graph1(i,j,k,l,1,.false.)
+ eello6_2=eello6_graph1(j,i,l,k,2,.false.)
+ eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
+ eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
+ eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
+ eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
+ else
+ eello6_1=eello6_graph1(i,j,k,l,1,.false.)
+ eello6_2=eello6_graph1(l,k,j,i,2,.true.)
+ eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
+ eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
+ if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
+ eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
+ else
+ eello6_5=0.0d0
+ endif
+ eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
+ endif
+! If turn contributions are considered, they will be handled separately.
+ eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
+!d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
+!d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
+!d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
+!d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
+!d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
+!d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
+!d goto 1112
+ if (j.lt.nres-1) then
+ j1=j+1
+ j2=j-1
+ else
+ j1=j-1
+ j2=j-2
+ endif
+ if (l.lt.nres-1) then
+ l1=l+1
+ l2=l-1
+ else
+ l1=l-1
+ l2=l-2
+ endif
+ do ll=1,3
+!grad ggg1(ll)=eel6*g_contij(ll,1)
+!grad ggg2(ll)=eel6*g_contij(ll,2)
+!old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
+!grad ghalf=0.5d0*ggg1(ll)
+!d ghalf=0.0d0
+ gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
+ gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
+ gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
+ gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
+ gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
+ gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
+ gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
+ gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
+!grad ghalf=0.5d0*ggg2(ll)
+!old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
+!d ghalf=0.0d0
+ gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
+ gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
+ gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
+ gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
+ gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
+ gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
+ enddo
+!d goto 1112
+!grad do m=i+1,j-1
+!grad do ll=1,3
+!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
+!grad enddo
+!grad enddo
+!grad do m=k+1,l-1
+!grad do ll=1,3
+!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
+!grad enddo
+!grad enddo
+!grad1112 continue
+!grad do m=i+2,j2
+!grad do ll=1,3
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
+!grad enddo
+!grad enddo
+!grad do m=k+2,l2
+!grad do ll=1,3
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
+!grad enddo
+!grad enddo
+!d do iii=1,nres-3
+!d write (2,*) iii,g_corr6_loc(iii)
+!d enddo
+ eello6=ekont*eel6
+!d write (2,*) 'ekont',ekont
+!d write (iout,*) 'eello6',ekont*eel6
return
- end function eello6_graph3
+ end function eello6
!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
+ real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
+ use comm_kut
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.TORSION'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
-! include 'COMMON.FFIELD'
- real(kind=8),dimension(2) :: vv,auxvec,auxvec1
- real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
+ real(kind=8),dimension(2) :: vv,vv1
+ real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
logical :: swap
- integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
- iii,kkk,lll
- real(kind=8) :: s1,s2,s3,s4
+!el logical :: lprn
+!el common /kutas/ lprn
+ integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
+ real(kind=8) :: s1,s2,s3,s4,s5
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! C
! Parallel Antiparallel C
! C
! o o C
-! /l\ / \ /j\ C
-! / \ / \ / \ C
-! /| o |o o| o |\ C
-! \ j|/k\| \ |/k\|l C
-! \ / \ \ / \ C
-! o \ o \ C
+! /l\ /j\ C
+! / \ / \ C
+! /| o | | o |\ C
+! \ j|/k\| / \ |/k\|l / C
+! \ / \ / \ / \ / C
+! o o o o C
! i i C
! C
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!
-! 4/7/01 AL Component s1 was removed, because it pertains to the respective
-! energy moment and not to the cluster cumulant.
-!d write (2,*) 'eello_graph4: wturn6',wturn6
- iti=itortyp(itype(i,1))
- itj=itortyp(itype(j,1))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1,1))
- else
- itj1=ntortyp+1
- endif
itk=itortyp(itype(k,1))
- if (k.lt.nres-1) then
- itk1=itortyp(itype(k+1,1))
- else
- itk1=ntortyp+1
- endif
- itl=itortyp(itype(l,1))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1,1))
+ s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
+ s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
+ s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
+ call transpose2(EUgC(1,1,k),auxmat(1,1))
+ call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
+ vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
+ vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
+ s5=scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
+ eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
+ if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
+ -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
+ -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
+ +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
+ +scalar2(vv(1),Dtobr2der(1,i)))
+ call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
+ vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
+ if (l.eq.j+1) then
+ g_corr6_loc(l-1)=g_corr6_loc(l-1) &
+ +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
+ -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
+ +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
else
- itl1=ntortyp+1
+ g_corr6_loc(j-1)=g_corr6_loc(j-1) &
+ +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
+ -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
+ +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
endif
-!d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
-!d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
-!d & ' itl',itl,' itl1',itl1
+ call transpose2(EUgCder(1,1,k),auxmat(1,1))
+ call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
+ +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
+ +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
+ do iii=1,2
+ if (swap) then
+ ind=3-iii
+ else
+ ind=iii
+ endif
+ do kkk=1,5
+ do lll=1,3
+ s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
+ s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
+ s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
+ call transpose2(EUgC(1,1,k),auxmat(1,1))
+ call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
+ pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
+ vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
+ -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
+ vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
+ +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
+ s5=scalar2(vv(1),Dtobr2(1,i))
+ derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
+ enddo
+ enddo
+ enddo
+ return
+ end function eello6_graph1
+!-----------------------------------------------------------------------------
+ real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
+ use comm_kut
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ logical :: swap
+ real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
+ real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
+!el logical :: lprn
+!el common /kutas/ lprn
+ integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
+ real(kind=8) :: s2,s3,s4
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel Antiparallel C
+! C
+! o o C
+! \ /l\ /j\ / C
+! \ / \ / \ / C
+! o| o | | o |o C
+! \ j|/k\| \ |/k\|l C
+! \ / \ \ / \ C
+! o o C
+! i i C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
+! AL 7/4/01 s1 would occur in the sixth-order moment,
+! but not in a cluster cumulant
#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dip(3,kk,k)
- else
- s1=dip(2,jj,j)*dip(2,kk,l)
- endif
+ s1=dip(1,jj,i)*dip(1,kk,k)
#endif
- call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
+ call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
+ call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
#ifdef MOMENT
- eello6_graph4=-(s1+s2+s3+s4)
+ eello6_graph2=-(s1+s2+s3+s4)
#else
- eello6_graph4=-(s2+s3+s4)
+ eello6_graph2=-(s2+s3+s4)
#endif
+! eello6_graph2=-s3
! Derivatives in gamma(i-1)
if (i.gt.1) then
#ifdef MOMENT
- if (imat.eq.1) then
- s1=dipderg(2,jj,i)*dip(3,kk,k)
- else
- s1=dipderg(4,jj,j)*dip(2,kk,l)
- endif
-#endif
- s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-!d write (2,*) 'turn6 derivatives'
-#ifdef MOMENT
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
+ s1=dipderg(1,jj,i)*dip(1,kk,k)
#endif
- else
+ s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
+ call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+ s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
#endif
- endif
+! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
endif
! Derivatives in gamma(k-1)
#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderg(2,kk,k)
- else
- s1=dip(2,jj,j)*dipderg(4,kk,l)
- endif
+ s1=dip(1,jj,i)*dipderg(1,kk,k)
#endif
- call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
+ call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+ call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
+ call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
#ifdef MOMENT
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
#else
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
#endif
- else
+! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
+! Derivatives in gamma(j-1) or gamma(l-1)
+ if (j.gt.1) then
#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
+ s1=dipderg(3,jj,i)*dip(1,kk,k)
#endif
- endif
-! Derivatives in gamma(j-1) or gamma(l-1)
- if (l.eq.j+1 .and. l.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
- else if (j.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
+ call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
+ call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
- gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+ if (swap) then
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
endif
+#endif
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
+! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
endif
-! Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
+! Derivatives in gamma(l-1) or gamma(j-1)
+ if (l.gt.1) then
+#ifdef MOMENT
+ s1=dip(1,jj,i)*dipderg(3,kk,k)
+#endif
+ call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+ call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+ call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+ if (swap) then
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
+ else
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
+ endif
+#endif
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
+! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
+ endif
+! Cartesian derivatives.
+ if (lprn) then
+ write (2,*) 'In eello6_graph2'
+ do iii=1,2
+ write (2,*) 'iii=',iii
+ do kkk=1,5
+ write (2,*) 'kkk=',kkk
+ do jjj=1,2
+ write (2,'(3(2f10.5),5x)') &
+ ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
+ enddo
+ enddo
+ enddo
+ endif
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
#ifdef MOMENT
if (iii.eq.1) then
- if (imat.eq.1) then
- s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
- else
- s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
- endif
+ s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
else
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
- else
- s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
- endif
+ s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
endif
#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
+ call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
- b1(1,itj1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
- else
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
- b1(1,itl1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
- endif
- call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
+ auxvec(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
pizda(1,1))
vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (swap) then
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
- -(s1+s2+s4)
-#else
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
- -(s2+s4)
-#endif
- derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
- else
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
#ifdef MOMENT
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
#else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
#endif
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
+ if (swap) then
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
else
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (l.eq.j+1) then
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- endif
- endif
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ endif
enddo
enddo
enddo
return
- end function eello6_graph4
+ end function eello6_graph2
!-----------------------------------------------------------------------------
- real(kind=8) function eello_turn6(i,jj,kk)
+ real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.TORSION'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
- real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
- real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
- real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
- real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
-! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
-! the respective energy moment and not to the cluster cumulant.
-!el local variables
- integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
- integer :: j1,j2,l1,l2,ll
- real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
- real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
- s1=0.0d0
- s8=0.0d0
- s13=0.0d0
+ real(kind=8),dimension(2) :: vv,auxvec
+ real(kind=8),dimension(2,2) :: pizda,auxmat
+ logical :: swap
+ integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
+ real(kind=8) :: s1,s2,s3,s4
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel Antiparallel C
+! C
+! o o C
+! /l\ / \ /j\ C
+! / \ / \ / \ C
+! /| o |o o| o |\ C
+! j|/k\| / |/k\|l / C
+! / \ / / \ / C
+! / o / o C
+! i i C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!
- eello_turn6=0.0d0
- j=i+4
- k=i+1
- l=i+3
+! 4/7/01 AL Component s1 was removed, because it pertains to the respective
+! energy moment and not to the cluster cumulant.
iti=itortyp(itype(i,1))
+ if (j.lt.nres-1) then
+ itj1=itortyp(itype(j+1,1))
+ else
+ itj1=ntortyp+1
+ endif
itk=itortyp(itype(k,1))
itk1=itortyp(itype(k+1,1))
- itl=itortyp(itype(l,1))
- itj=itortyp(itype(j,1))
-!d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
-!d write (2,*) 'i',i,' k',k,' j',j,' l',l
-!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-!d eello6=0.0d0
-!d return
-!d endif
-!d write (iout,*)
-!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-!d & ' and',k,l
-!d call checkint_turn6(i,jj,kk,eel_turn6_num)
+ if (l.lt.nres-1) then
+ itl1=itortyp(itype(l+1,1))
+ else
+ itl1=ntortyp+1
+ endif
+#ifdef MOMENT
+ s1=dip(4,jj,i)*dip(4,kk,k)
+#endif
+ call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
+ s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
+ call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
+ s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
+ call transpose2(EE(1,1,itk),auxmat(1,1))
+ call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+!d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
+!d & "sum",-(s2+s3+s4)
+#ifdef MOMENT
+ eello6_graph3=-(s1+s2+s3+s4)
+#else
+ eello6_graph3=-(s2+s3+s4)
+#endif
+! eello6_graph3=-s4
+! Derivatives in gamma(k-1)
+ call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
+ s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
+ s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
+! Derivatives in gamma(l-1)
+ call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
+ s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
+ call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
+! Cartesian derivatives.
do iii=1,2
do kkk=1,5
do lll=1,3
- derx_turn(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d eij=1.0d0
-!d ekl=1.0d0
-!d ekont=1.0d0
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
-!d eello6_5=0.0d0
-!d write (2,*) 'eello6_5',eello6_5
#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
- ss1=scalar2(Ub2(1,i+2),b1(1,itl))
- s1 = (auxmat(1,1)+auxmat(2,2))*ss1
+ if (iii.eq.1) then
+ s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
+ else
+ s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
+ endif
#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
- s2 = scalar2(b1(1,itk),vtemp1(1))
+ call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
+ auxvec(1))
+ s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
+ call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
+ auxvec(1))
+ s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
+ call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
#ifdef MOMENT
- call transpose2(AEA(1,1,2),atemp(1,1))
- call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
- call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
- s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
#endif
- call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
- s12 = scalar2(Ub2(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
- call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
- call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
- ss13 = scalar2(b1(1,itk),vtemp4(1))
- s13 = (gtemp(1,1)+gtemp(2,2))*ss13
-#endif
-! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
-! s1=0.0d0
-! s2=0.0d0
-! s8=0.0d0
-! s12=0.0d0
-! s13=0.0d0
- eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
-! Derivatives in gamma(i+2)
- s1d =0.0d0
- s8d =0.0d0
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
- call transpose2(AEAderg(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
- gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
-! Derivatives in gamma(i+3)
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
-#endif
- call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
- s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
-#endif
- s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
+ if (swap) then
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+ else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ endif
+! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
+ enddo
+ enddo
+ enddo
+ return
+ end function eello6_graph3
+!-----------------------------------------------------------------------------
+ real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.FFIELD'
+ real(kind=8),dimension(2) :: vv,auxvec,auxvec1
+ real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
+ logical :: swap
+ integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
+ iii,kkk,lll
+ real(kind=8) :: s1,s2,s3,s4
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel Antiparallel C
+! C
+! o o C
+! /l\ / \ /j\ C
+! / \ / \ / \ C
+! /| o |o o| o |\ C
+! \ j|/k\| \ |/k\|l C
+! \ / \ \ / \ C
+! o \ o \ C
+! i i C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!
+! 4/7/01 AL Component s1 was removed, because it pertains to the respective
+! energy moment and not to the cluster cumulant.
+!d write (2,*) 'eello_graph4: wturn6',wturn6
+ iti=itortyp(itype(i,1))
+ itj=itortyp(itype(j,1))
+ if (j.lt.nres-1) then
+ itj1=itortyp(itype(j+1,1))
+ else
+ itj1=ntortyp+1
+ endif
+ itk=itortyp(itype(k,1))
+ if (k.lt.nres-1) then
+ itk1=itortyp(itype(k+1,1))
+ else
+ itk1=ntortyp+1
+ endif
+ itl=itortyp(itype(l,1))
+ if (l.lt.nres-1) then
+ itl1=itortyp(itype(l+1,1))
+ else
+ itl1=ntortyp+1
+ endif
+!d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
+!d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
+!d & ' itl',itl,' itl1',itl1
#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
+ if (imat.eq.1) then
+ s1=dip(3,jj,i)*dip(3,kk,k)
+ else
+ s1=dip(2,jj,j)*dip(2,kk,l)
+ endif
#endif
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
+ call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
+ else
+ call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
+ endif
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
#ifdef MOMENT
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
- -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+ eello6_graph4=-(s1+s2+s3+s4)
#else
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
- -0.5d0*ekont*(s2d+s12d)
+ eello6_graph4=-(s2+s3+s4)
#endif
-! Derivatives in gamma(i+4)
- call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+! Derivatives in gamma(i-1)
+ if (i.gt.1) then
#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
+ if (imat.eq.1) then
+ s1=dipderg(2,jj,i)*dip(3,kk,k)
+ else
+ s1=dipderg(4,jj,j)*dip(2,kk,l)
+ endif
#endif
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
+ s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
+ else
+ call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
+ endif
+ s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+!d write (2,*) 'turn6 derivatives'
#ifdef MOMENT
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
+ gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
#else
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
-#endif
-! Derivatives in gamma(i+5)
-#ifdef MOMENT
- call transpose2(AEAderg(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+ gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
+ else
#ifdef MOMENT
- call transpose2(AEA(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
+#else
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
#endif
- call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+ endif
+ endif
+! Derivatives in gamma(k-1)
#ifdef MOMENT
- call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
+ if (imat.eq.1) then
+ s1=dip(3,jj,i)*dipderg(2,kk,k)
+ else
+ s1=dip(2,jj,j)*dipderg(4,kk,l)
+ endif
#endif
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
+ call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
+ else
+ call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
+ endif
+ call transpose2(EUgder(1,1,k),auxmat1(1,1))
+ call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
#ifdef MOMENT
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
- -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+ gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
#else
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
- -0.5d0*ekont*(s2d+s12d)
+ gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
#endif
-! Cartesian derivatives
- do iii=1,2
- do kkk=1,5
- do lll=1,3
+ else
#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
+#else
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
- vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))* &
- scalar2(cc(1,1,itl),vtemp2(1))
+ endif
+! Derivatives in gamma(j-1) or gamma(l-1)
+ if (l.eq.j+1 .and. l.gt.1) then
+ call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
+ else if (j.gt.1) then
+ call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+ gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
+ else
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
+ endif
+ endif
+! Cartesian derivatives.
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+#ifdef MOMENT
+ if (iii.eq.1) then
+ if (imat.eq.1) then
+ s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
+ else
+ s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
+ endif
+ else
+ if (imat.eq.1) then
+ s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
+ else
+ s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
+ endif
+ endif
#endif
- call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
- auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
+ call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
+ auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
+ b1(1,itj1),auxvec(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
+ else
+ call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
+ b1(1,itl1),auxvec(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
+ endif
+ call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ if (swap) then
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
#ifdef MOMENT
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
- - 0.5d0*(s1d+s2d)
+ derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
+ -(s1+s2+s4)
#else
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
- - 0.5d0*s2d
+ derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
+ -(s2+s4)
#endif
+ derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
+ else
#ifdef MOMENT
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
- - 0.5d0*(s8d+s12d)
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
#else
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
- - 0.5d0*s12d
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
#endif
- enddo
- enddo
- enddo
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ endif
+ else
#ifdef MOMENT
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
- achuj_tempd(1,1))
- call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d=(gtempd(1,1)+gtempd(2,2))*ss13
- derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
- vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
- derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
- enddo
- enddo
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
#endif
-!d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
-!d & 16*eel_turn6_num
-!d goto 1112
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-!grad ggg1(ll)=eel_turn6*g_contij(ll,1)
-!grad ggg2(ll)=eel_turn6*g_contij(ll,2)
-!grad ghalf=0.5d0*ggg1(ll)
-!d ghalf=0.0d0
- gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
- gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
- gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
- +ekont*derx_turn(ll,2,1)
- gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
- gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
- +ekont*derx_turn(ll,4,1)
- gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
- gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
- gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
-!grad ghalf=0.5d0*ggg2(ll)
-!d ghalf=0.0d0
- gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
- +ekont*derx_turn(ll,2,2)
- gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
- gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
- +ekont*derx_turn(ll,4,2)
- gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
- gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
- gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
+ if (l.eq.j+1) then
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ else
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+ endif
+ endif
+ enddo
+ enddo
enddo
-!d goto 1112
-!grad do m=i+1,j-1
-!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
-!grad enddo
-!grad enddo
-!grad do m=k+1,l-1
-!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
-!grad enddo
-!grad enddo
-!grad1112 continue
-!grad do m=i+2,j2
-!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
-!grad enddo
-!grad enddo
-!grad do m=k+2,l2
-!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
-!grad enddo
-!grad enddo
-!d do iii=1,nres-3
-!d write (2,*) iii,g_corr6_loc(iii)
-!d enddo
- eello_turn6=ekont*eel_turn6
-!d write (2,*) 'ekont',ekont
-!d write (2,*) 'eel_turn6',ekont*eel_turn6
return
- end function eello_turn6
-!-----------------------------------------------------------------------------
- subroutine MATVEC2(A1,V1,V2)
-!DIR$ INLINEALWAYS MATVEC2
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
-#endif
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- real(kind=8),dimension(2) :: V1,V2
- real(kind=8),dimension(2,2) :: A1
- real(kind=8) :: vaux1,vaux2
-! DO 1 I=1,2
-! VI=0.0
-! DO 3 K=1,2
-! 3 VI=VI+A1(I,K)*V1(K)
-! Vaux(I)=VI
-! 1 CONTINUE
-
- vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
- vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
-
- v2(1)=vaux1
- v2(2)=vaux2
- end subroutine MATVEC2
+ end function eello6_graph4
!-----------------------------------------------------------------------------
- subroutine MATMAT2(A1,A2,A3)
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
-#endif
+ real(kind=8) function eello_turn6(i,jj,kk)
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
- real(kind=8),dimension(2,2) :: A1,A2,A3
- real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
-! DIMENSION AI3(2,2)
-! DO J=1,2
-! A3IJ=0.0
-! DO K=1,2
-! A3IJ=A3IJ+A1(I,K)*A2(K,J)
-! enddo
-! A3(I,J)=A3IJ
-! enddo
-! enddo
-
- ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
- ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
- ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
- ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
-
- A3(1,1)=AI3_11
- A3(2,1)=AI3_21
- A3(1,2)=AI3_12
- A3(2,2)=AI3_22
- end subroutine MATMAT2
-!-----------------------------------------------------------------------------
- real(kind=8) function scalar2(u,v)
-!DIR$ INLINEALWAYS scalar2
- implicit none
- real(kind=8),dimension(2) :: u,v
- real(kind=8) :: sc
- integer :: i
- scalar2=u(1)*v(1)+u(2)*v(2)
- return
- end function scalar2
-!-----------------------------------------------------------------------------
- subroutine transpose2(a,at)
-!DIR$ INLINEALWAYS transpose2
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::transpose2
-#endif
- implicit none
- real(kind=8),dimension(2,2) :: a,at
- at(1,1)=a(1,1)
- at(1,2)=a(2,1)
- at(2,1)=a(1,2)
- at(2,2)=a(2,2)
- return
- end subroutine transpose2
-!-----------------------------------------------------------------------------
- subroutine transpose(n,a,at)
- implicit none
- integer :: n,i,j
- real(kind=8),dimension(n,n) :: a,at
- do i=1,n
- do j=1,n
- at(j,i)=a(i,j)
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
+ real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
+ real(kind=8),dimension(3) :: ggg1,ggg2
+ real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
+ real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
+! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
+! the respective energy moment and not to the cluster cumulant.
+!el local variables
+ integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
+ integer :: j1,j2,l1,l2,ll
+ real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
+ real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
+ s1=0.0d0
+ s8=0.0d0
+ s13=0.0d0
+!
+ eello_turn6=0.0d0
+ j=i+4
+ k=i+1
+ l=i+3
+ iti=itortyp(itype(i,1))
+ itk=itortyp(itype(k,1))
+ itk1=itortyp(itype(k+1,1))
+ itl=itortyp(itype(l,1))
+ itj=itortyp(itype(j,1))
+!d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
+!d write (2,*) 'i',i,' k',k,' j',j,' l',l
+!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
+!d eello6=0.0d0
+!d return
+!d endif
+!d write (iout,*)
+!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
+!d & ' and',k,l
+!d call checkint_turn6(i,jj,kk,eel_turn6_num)
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ derx_turn(lll,kkk,iii)=0.0d0
+ enddo
enddo
enddo
- return
- end subroutine transpose
-!-----------------------------------------------------------------------------
- subroutine prodmat3(a1,a2,kk,transp,prod)
-!DIR$ INLINEALWAYS prodmat3
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::prodmat3
+!d eij=1.0d0
+!d ekl=1.0d0
+!d ekont=1.0d0
+ eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
+!d eello6_5=0.0d0
+!d write (2,*) 'eello6_5',eello6_5
+#ifdef MOMENT
+ call transpose2(AEA(1,1,1),auxmat(1,1))
+ call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
+ ss1=scalar2(Ub2(1,i+2),b1(1,itl))
+ s1 = (auxmat(1,1)+auxmat(2,2))*ss1
#endif
- implicit none
- integer :: i,j
- real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
- logical :: transp
-!rc double precision auxmat(2,2),prod_(2,2)
-
- if (transp) then
-!rc call transpose2(kk(1,1),auxmat(1,1))
-!rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
-!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
- +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
- +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
- +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
- +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
-
- else
-!rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
-!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
- +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
- +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
- +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
- +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
-
- endif
-! call transpose2(a2(1,1),a2t(1,1))
-
-!rc print *,transp
-!rc print *,((prod_(i,j),i=1,2),j=1,2)
-!rc print *,((prod(i,j),i=1,2),j=1,2)
-
- return
- end subroutine prodmat3
-!-----------------------------------------------------------------------------
-! energy_p_new_barrier.F
-!-----------------------------------------------------------------------------
- subroutine sum_gradient
-! implicit real*8 (a-h,o-z)
- use io_base, only: pdbout
-! include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-!MS$ATTRIBUTES C :: proc_proc
+ call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
+ call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
+ s2 = scalar2(b1(1,itk),vtemp1(1))
+#ifdef MOMENT
+ call transpose2(AEA(1,1,2),atemp(1,1))
+ call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
+ call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
+ s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
#endif
+ call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
+ s12 = scalar2(Ub2(1,i+2),vtemp3(1))
+#ifdef MOMENT
+ call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
+ call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
+ call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
+ call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
+ ss13 = scalar2(b1(1,itk),vtemp4(1))
+ s13 = (gtemp(1,1)+gtemp(2,2))*ss13
#endif
-#ifdef MPI
- include 'mpif.h'
+! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
+! s1=0.0d0
+! s2=0.0d0
+! s8=0.0d0
+! s12=0.0d0
+! s13=0.0d0
+ eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
+! Derivatives in gamma(i+2)
+ s1d =0.0d0
+ s8d =0.0d0
+#ifdef MOMENT
+ call transpose2(AEA(1,1,1),auxmatd(1,1))
+ call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+ call transpose2(AEAderg(1,1,2),atempd(1,1))
+ call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
+ s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
#endif
- real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
- gloc_scbuf !(3,maxres)
-
- real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
-!#endif
-!el local variables
- integer :: i,j,k,ierror,ierr
- real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
- gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
- gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
- gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
- gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
- gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
- gsccorr_max,gsccorrx_max,time00
-
-! include 'COMMON.SETUP'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CHAIN'
-! include 'COMMON.VAR'
-! include 'COMMON.CONTROL'
-! include 'COMMON.TIME1'
-! include 'COMMON.MAXGRAD'
-! include 'COMMON.SCCOR'
-#ifdef TIMING
- time01=MPI_Wtime()
+ call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
+ call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+ gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
+! Derivatives in gamma(i+3)
+#ifdef MOMENT
+ call transpose2(AEA(1,1,1),auxmatd(1,1))
+ call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
#endif
-#ifdef DEBUG
- write (iout,*) "sum_gradient gvdwc, gvdwx"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
- enddo
- call flush(iout)
+ call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
+ call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
+ s2d = scalar2(b1(1,itk),vtemp1d(1))
+#ifdef MOMENT
+ call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
+ s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
#endif
-#ifdef MPI
- gradbufc=0.0d0
- gradbufx=0.0d0
- gradbufc_sum=0.0d0
- gloc_scbuf=0.0d0
- glocbuf=0.0d0
-! FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
- call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
+ s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
+#ifdef MOMENT
+ call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
+ call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
+ s13d = (gtempd(1,1)+gtempd(2,2))*ss13
#endif
-!
-! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
-! in virtual-bond-vector coordinates
-!
-#ifdef DEBUG
-! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
-! do i=1,nres-1
-! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
-! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
-! enddo
-! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
-! do i=1,nres-1
-! write (iout,'(i5,3f10.5,2x,f10.5)')
-! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
-! enddo
- write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
- (gvdwc_scpp(j,i),j=1,3)
- enddo
- write (iout,*) "gelc_long gvdwpp gel_loc_long"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
- (gelc_loc_long(j,i),j=1,3)
- enddo
- call flush(iout)
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
+ -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+#else
+ gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
+ -0.5d0*ekont*(s2d+s12d)
#endif
-#ifdef SPLITELE
- do i=0,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+ &
- wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
- welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
- wcorr*gradcorr_long(j,i)+ &
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i)+ &
- wstrain*ghpbc(j,i) &
- +wliptran*gliptranc(j,i) &
- +gradafm(j,i) &
- +welec*gshieldc(j,i) &
- +wcorr*gshieldc_ec(j,i) &
- +wturn3*gshieldc_t3(j,i)&
- +wturn4*gshieldc_t4(j,i)&
- +wel_loc*gshieldc_ll(j,i)&
- +wtube*gg_tube(j,i) &
- +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
- wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
- wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
- wcorr_nucl*gradcorr_nucl(j,i)&
- +wcorr3_nucl*gradcorr3_nucl(j,i)+&
- wcatprot* gradpepcat(j,i)+ &
- wcatcat*gradcatcat(j,i)+ &
- wscbase*gvdwc_scbase(j,i)+ &
- wpepbase*gvdwc_pepbase(j,i)+&
- wscpho*gvdwc_scpho(j,i)+ &
- wpeppho*gvdwc_peppho(j,i)
-
-
-
-
-
- enddo
- enddo
+! Derivatives in gamma(i+4)
+ call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
+ call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+#ifdef MOMENT
+ call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
+ call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
+ s13d = (gtempd(1,1)+gtempd(2,2))*ss13
+#endif
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
#else
- do i=0,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+ &
- wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
- welec*gelc_long(j,i)+ &
- wbond*gradb(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
- wcorr*gradcorr_long(j,i)+ &
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i)+ &
- wstrain*ghpbc(j,i) &
- +wliptran*gliptranc(j,i) &
- +gradafm(j,i) &
- +welec*gshieldc(j,i)&
- +wcorr*gshieldc_ec(j,i) &
- +wturn4*gshieldc_t4(j,i) &
- +wel_loc*gshieldc_ll(j,i)&
- +wtube*gg_tube(j,i) &
- +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
- wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
- wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
- wcorr_nucl*gradcorr_nucl(j,i) &
- +wcorr3_nucl*gradcorr3_nucl(j,i) +&
- wcatprot* gradpepcat(j,i)+ &
- wcatcat*gradcatcat(j,i)+ &
- wscbase*gvdwc_scbase(j,i) &
- wpepbase*gvdwc_pepbase(j,i)+&
- wscpho*gvdwc_scpho(j,i)+&
- wpeppho*gvdwc_peppho(j,i)
-
-
- enddo
- enddo
+ gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-#ifdef DEBUG
- write (iout,*) "gradbufc before allreduce"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
+! Derivatives in gamma(i+5)
+#ifdef MOMENT
+ call transpose2(AEAderg(1,1,1),auxmatd(1,1))
+ call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
#endif
- do i=0,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
- enddo
- enddo
-! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
-! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
-! time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
-! write (iout,*) "gradbufc_sum after allreduce"
-! do i=1,nres
-! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
-! enddo
-! call flush(iout)
+ call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
+ call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
+ s2d = scalar2(b1(1,itk),vtemp1d(1))
+#ifdef MOMENT
+ call transpose2(AEA(1,1,2),atempd(1,1))
+ call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
+ s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
#endif
-#ifdef TIMING
-! time_allreduce=time_allreduce+MPI_Wtime()-time00
+ call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+#ifdef MOMENT
+ call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
+ ss13d = scalar2(b1(1,itk),vtemp4d(1))
+ s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
#endif
- do i=0,nres
- do k=1,3
- gradbufc(k,i)=0.0d0
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
- write (iout,*) (i," jgrad_start",jgrad_start(i),&
- " jgrad_end ",jgrad_end(i),&
- i=igrad_start,igrad_end)
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
+ -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+#else
+ gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
+ -0.5d0*ekont*(s2d+s12d)
#endif
-!
-! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
-! do not parallelize this part.
-!
-! do i=igrad_start,igrad_end
-! do j=jgrad_start(i),jgrad_end(i)
-! do k=1,3
-! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
-! enddo
-! enddo
-! enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,-1,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
+! Cartesian derivatives
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+#ifdef MOMENT
+ call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
+ call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
#endif
- else
+ call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
+ vtemp1d(1))
+ s2d = scalar2(b1(1,itk),vtemp1d(1))
+#ifdef MOMENT
+ call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
+ call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
+ s8d = -(atempd(1,1)+atempd(2,2))* &
+ scalar2(cc(1,1,itl),vtemp2(1))
#endif
-!el#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gradbufc"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
+ call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
+ auxmatd(1,1))
+ call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
+ - 0.5d0*(s1d+s2d)
+#else
+ derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
+ - 0.5d0*s2d
#endif
-!el#undef DEBUG
- do i=-1,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
- gradbufc(j,i)=0.0d0
- enddo
- enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,-1,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
+#ifdef MOMENT
+ derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
+ - 0.5d0*(s8d+s12d)
+#else
+ derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
+ - 0.5d0*s12d
+#endif
+ enddo
enddo
enddo
-! do i=nnt,nres-1
-! do k=1,3
-! gradbufc(k,i)=0.0d0
-! enddo
-! do j=i+1,nres
-! do k=1,3
-! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
-! enddo
-! enddo
-! enddo
-!el#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+#ifdef MOMENT
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
+ achuj_tempd(1,1))
+ call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
+ call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
+ s13d=(gtempd(1,1)+gtempd(2,2))*ss13
+ derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
+ call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
+ vtemp4d(1))
+ ss13d = scalar2(b1(1,itk),vtemp4d(1))
+ s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
+ derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
+ enddo
enddo
- call flush(iout)
#endif
-!el#undef DEBUG
-#ifdef MPI
+!d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
+!d & 16*eel_turn6_num
+!d goto 1112
+ if (j.lt.nres-1) then
+ j1=j+1
+ j2=j-1
+ else
+ j1=j-1
+ j2=j-2
endif
-#endif
- do k=1,3
- gradbufc(k,nres)=0.0d0
+ if (l.lt.nres-1) then
+ l1=l+1
+ l2=l-1
+ else
+ l1=l-1
+ l2=l-2
+ endif
+ do ll=1,3
+!grad ggg1(ll)=eel_turn6*g_contij(ll,1)
+!grad ggg2(ll)=eel_turn6*g_contij(ll,2)
+!grad ghalf=0.5d0*ggg1(ll)
+!d ghalf=0.0d0
+ gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
+ gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
+ gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
+ +ekont*derx_turn(ll,2,1)
+ gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
+ gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
+ +ekont*derx_turn(ll,4,1)
+ gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
+ gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
+ gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
+!grad ghalf=0.5d0*ggg2(ll)
+!d ghalf=0.0d0
+ gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
+ +ekont*derx_turn(ll,2,2)
+ gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
+ gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
+ +ekont*derx_turn(ll,4,2)
+ gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
+ gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
+ gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
enddo
-!el----------------
-!el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
-!el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
-!el-----------------
- do i=-1,nct
- do j=1,3
-#ifdef SPLITELE
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
- wel_loc*gel_loc(j,i)+ &
- 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
- welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
- wcorr*gradcorr_long(j,i)+ &
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i))+ &
- wbond*gradb(j,i)+ &
- wcorr*gradcorr(j,i)+ &
- wturn3*gcorr3_turn(j,i)+ &
- wturn4*gcorr4_turn(j,i)+ &
- wcorr5*gradcorr5(j,i)+ &
- wcorr6*gradcorr6(j,i)+ &
- wturn6*gcorr6_turn(j,i)+ &
- wsccor*gsccorc(j,i) &
- +wscloc*gscloc(j,i) &
- +wliptran*gliptranc(j,i) &
- +gradafm(j,i) &
- +welec*gshieldc(j,i) &
- +welec*gshieldc_loc(j,i) &
- +wcorr*gshieldc_ec(j,i) &
- +wcorr*gshieldc_loc_ec(j,i) &
- +wturn3*gshieldc_t3(j,i) &
- +wturn3*gshieldc_loc_t3(j,i) &
- +wturn4*gshieldc_t4(j,i) &
- +wturn4*gshieldc_loc_t4(j,i) &
- +wel_loc*gshieldc_ll(j,i) &
- +wel_loc*gshieldc_loc_ll(j,i) &
- +wtube*gg_tube(j,i) &
- +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
- +wvdwpsb*gvdwpsb1(j,i))&
- +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
-! if (i.eq.21) then
-! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
-! wturn4*gshieldc_t4(j,i), &
-! wturn4*gshieldc_loc_t4(j,i)
-! endif
-! if ((i.le.2).and.(i.ge.1))
-! print *,gradc(j,i,icg),&
-! gradbufc(j,i),welec*gelc(j,i), &
-! wel_loc*gel_loc(j,i), &
-! wscp*gvdwc_scpp(j,i), &
-! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
-! wel_loc*gel_loc_long(j,i), &
-! wcorr*gradcorr_long(j,i), &
-! wcorr5*gradcorr5_long(j,i), &
-! wcorr6*gradcorr6_long(j,i), &
-! wturn6*gcorr6_turn_long(j,i), &
-! wbond*gradb(j,i), &
-! wcorr*gradcorr(j,i), &
-! wturn3*gcorr3_turn(j,i), &
-! wturn4*gcorr4_turn(j,i), &
-! wcorr5*gradcorr5(j,i), &
-! wcorr6*gradcorr6(j,i), &
-! wturn6*gcorr6_turn(j,i), &
-! wsccor*gsccorc(j,i) &
-! ,wscloc*gscloc(j,i) &
-! ,wliptran*gliptranc(j,i) &
-! ,gradafm(j,i) &
-! ,welec*gshieldc(j,i) &
-! ,welec*gshieldc_loc(j,i) &
-! ,wcorr*gshieldc_ec(j,i) &
-! ,wcorr*gshieldc_loc_ec(j,i) &
-! ,wturn3*gshieldc_t3(j,i) &
-! ,wturn3*gshieldc_loc_t3(j,i) &
-! ,wturn4*gshieldc_t4(j,i) &
-! ,wturn4*gshieldc_loc_t4(j,i) &
-! ,wel_loc*gshieldc_ll(j,i) &
-! ,wel_loc*gshieldc_loc_ll(j,i) &
-! ,wtube*gg_tube(j,i) &
-! ,wbond_nucl*gradb_nucl(j,i) &
-! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
-! wvdwpsb*gvdwpsb1(j,i)&
-! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
-!
-
-#else
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
- wel_loc*gel_loc(j,i)+ &
- 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
- welec*gelc_long(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
-!el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i))+ &
- wbond*gradb(j,i)+ &
- wcorr*gradcorr(j,i)+ &
- wturn3*gcorr3_turn(j,i)+ &
- wturn4*gcorr4_turn(j,i)+ &
- wcorr5*gradcorr5(j,i)+ &
- wcorr6*gradcorr6(j,i)+ &
- wturn6*gcorr6_turn(j,i)+ &
- wsccor*gsccorc(j,i) &
- +wscloc*gscloc(j,i) &
- +gradafm(j,i) &
- +wliptran*gliptranc(j,i) &
- +welec*gshieldc(j,i) &
- +welec*gshieldc_loc(j,) &
- +wcorr*gshieldc_ec(j,i) &
- +wcorr*gshieldc_loc_ec(j,i) &
- +wturn3*gshieldc_t3(j,i) &
- +wturn3*gshieldc_loc_t3(j,i) &
- +wturn4*gshieldc_t4(j,i) &
- +wturn4*gshieldc_loc_t4(j,i) &
- +wel_loc*gshieldc_ll(j,i) &
- +wel_loc*gshieldc_loc_ll(j,i) &
- +wtube*gg_tube(j,i) &
- +wbond_nucl*gradb_nucl(j,i) &
- +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
- +wvdwpsb*gvdwpsb1(j,i))&
- +wsbloc*gsbloc(j,i)
-
-
+!d goto 1112
+!grad do m=i+1,j-1
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
+!grad enddo
+!grad enddo
+!grad do m=k+1,l-1
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
+!grad enddo
+!grad enddo
+!grad1112 continue
+!grad do m=i+2,j2
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
+!grad enddo
+!grad enddo
+!grad do m=k+2,l2
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
+!grad enddo
+!grad enddo
+!d do iii=1,nres-3
+!d write (2,*) iii,g_corr6_loc(iii)
+!d enddo
+ eello_turn6=ekont*eel_turn6
+!d write (2,*) 'ekont',ekont
+!d write (2,*) 'eel_turn6',ekont*eel_turn6
+ return
+ end function eello_turn6
+!-----------------------------------------------------------------------------
+ subroutine MATVEC2(A1,V1,V2)
+!DIR$ INLINEALWAYS MATVEC2
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
+#endif
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+ real(kind=8),dimension(2) :: V1,V2
+ real(kind=8),dimension(2,2) :: A1
+ real(kind=8) :: vaux1,vaux2
+! DO 1 I=1,2
+! VI=0.0
+! DO 3 K=1,2
+! 3 VI=VI+A1(I,K)*V1(K)
+! Vaux(I)=VI
+! 1 CONTINUE
+ vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
+ vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
+ v2(1)=vaux1
+ v2(2)=vaux2
+ end subroutine MATVEC2
+!-----------------------------------------------------------------------------
+ subroutine MATMAT2(A1,A2,A3)
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
#endif
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
- wbond*gradbx(j,i)+ &
- wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
- wsccor*gsccorx(j,i) &
- +wscloc*gsclocx(j,i) &
- +wliptran*gliptranx(j,i) &
- +welec*gshieldx(j,i) &
- +wcorr*gshieldx_ec(j,i) &
- +wturn3*gshieldx_t3(j,i) &
- +wturn4*gshieldx_t4(j,i) &
- +wel_loc*gshieldx_ll(j,i)&
- +wtube*gg_tube_sc(j,i) &
- +wbond_nucl*gradbx_nucl(j,i) &
- +wvdwsb*gvdwsbx(j,i) &
- +welsb*gelsbx(j,i) &
- +wcorr_nucl*gradxorr_nucl(j,i)&
- +wcorr3_nucl*gradxorr3_nucl(j,i) &
- +wsbloc*gsblocx(j,i) &
- +wcatprot* gradpepcatx(j,i)&
- +wscbase*gvdwx_scbase(j,i) &
- +wpepbase*gvdwx_pepbase(j,i)&
- +wscpho*gvdwx_scpho(j,i)
-! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+ real(kind=8),dimension(2,2) :: A1,A2,A3
+ real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
+! DIMENSION AI3(2,2)
+! DO J=1,2
+! A3IJ=0.0
+! DO K=1,2
+! A3IJ=A3IJ+A1(I,K)*A2(K,J)
+! enddo
+! A3(I,J)=A3IJ
+! enddo
+! enddo
+
+ ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
+ ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
+ ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
+ ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
+ A3(1,1)=AI3_11
+ A3(2,1)=AI3_21
+ A3(1,2)=AI3_12
+ A3(2,2)=AI3_22
+ end subroutine MATMAT2
+!-----------------------------------------------------------------------------
+ real(kind=8) function scalar2(u,v)
+!DIR$ INLINEALWAYS scalar2
+ implicit none
+ real(kind=8),dimension(2) :: u,v
+ real(kind=8) :: sc
+ integer :: i
+ scalar2=u(1)*v(1)+u(2)*v(2)
+ return
+ end function scalar2
+!-----------------------------------------------------------------------------
+ subroutine transpose2(a,at)
+!DIR$ INLINEALWAYS transpose2
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::transpose2
+#endif
+ implicit none
+ real(kind=8),dimension(2,2) :: a,at
+ at(1,1)=a(1,1)
+ at(1,2)=a(2,1)
+ at(2,1)=a(1,2)
+ at(2,2)=a(2,2)
+ return
+ end subroutine transpose2
+!-----------------------------------------------------------------------------
+ subroutine transpose(n,a,at)
+ implicit none
+ integer :: n,i,j
+ real(kind=8),dimension(n,n) :: a,at
+ do i=1,n
+ do j=1,n
+ at(j,i)=a(i,j)
enddo
enddo
-!#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gloc before adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
+ return
+ end subroutine transpose
+!-----------------------------------------------------------------------------
+ subroutine prodmat3(a1,a2,kk,transp,prod)
+!DIR$ INLINEALWAYS prodmat3
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::prodmat3
+#endif
+ implicit none
+ integer :: i,j
+ real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
+ logical :: transp
+!rc double precision auxmat(2,2),prod_(2,2)
+
+ if (transp) then
+!rc call transpose2(kk(1,1),auxmat(1,1))
+!rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
+!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
+
+ prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
+ +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
+ prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
+ +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
+ prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
+ +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
+ prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
+ +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
+
+ else
+!rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
+!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
+
+ prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
+ +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
+ prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
+ +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
+ prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
+ +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
+ prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
+ +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
+
+ endif
+! call transpose2(a2(1,1),a2t(1,1))
+
+!rc print *,transp
+!rc print *,((prod_(i,j),i=1,2),j=1,2)
+!rc print *,((prod(i,j),i=1,2),j=1,2)
+
+ return
+ end subroutine prodmat3
+!-----------------------------------------------------------------------------
+! energy_p_new_barrier.F
+!-----------------------------------------------------------------------------
+ subroutine sum_gradient
+! implicit real*8 (a-h,o-z)
+ use io_base, only: pdbout
+! include 'DIMENSIONS'
+#ifndef ISNAN
+ external proc_proc
+#ifdef WINPGI
+!MS$ATTRIBUTES C :: proc_proc
#endif
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
- +wcorr5*g_corr5_loc(i) &
- +wcorr6*g_corr6_loc(i) &
- +wturn4*gel_loc_turn4(i) &
- +wturn3*gel_loc_turn3(i) &
- +wturn6*gel_loc_turn6(i) &
- +wel_loc*gel_loc_loc(i)
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc after adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
#endif
-!#undef DEBUG
#ifdef MPI
- if (nfgtasks.gt.1) then
- do j=1,3
- do i=0,nres
- gradbufc(j,i)=gradc(j,i,icg)
- gradbufx(j,i)=gradx(j,i,icg)
- enddo
- enddo
- do i=1,4*nres
- glocbuf(i)=gloc(i,icg)
- enddo
-!#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gloc_sc before reduce"
- do i=1,nres
- do j=1,1
- write (iout,*) i,j,gloc_sc(j,i,icg)
- enddo
- enddo
+ include 'mpif.h'
+#endif
+ real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
+ gloc_scbuf !(3,maxres)
+
+ real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
+!#endif
+!el local variables
+ integer :: i,j,k,ierror,ierr
+ real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
+ gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
+ gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
+ gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
+ gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
+ gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
+ gsccorr_max,gsccorrx_max,time00
+
+! include 'COMMON.SETUP'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.FFIELD'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.CHAIN'
+! include 'COMMON.VAR'
+! include 'COMMON.CONTROL'
+! include 'COMMON.TIME1'
+! include 'COMMON.MAXGRAD'
+! include 'COMMON.SCCOR'
+#ifdef TIMING
+ time01=MPI_Wtime()
#endif
-!#undef DEBUG
- do i=1,nres
- do j=1,3
- gloc_scbuf(j,i)=gloc_sc(j,i,icg)
- enddo
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_g=time_barrier_g+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
- call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
!#define DEBUG
-! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
#ifdef DEBUG
- write (iout,*) "gloc_sc after reduce"
+ write (iout,*) "sum_gradient gvdwc, gvdwx"
do i=1,nres
- do j=1,1
- write (iout,*) i,j,gloc_sc(j,i,icg)
- enddo
- enddo
-#endif
-!#undef DEBUG
-#ifdef DEBUG
- write (iout,*) "gloc after reduce"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
+ write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
+ i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
enddo
+ call flush(iout)
#endif
- endif
+#ifdef MPI
+ gradbufc=0.0d0
+ gradbufx=0.0d0
+ gradbufc_sum=0.0d0
+ gloc_scbuf=0.0d0
+ glocbuf=0.0d0
+! FG slaves call the following matching MPI_Bcast in ERGASTULUM
+ if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
+ call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
#endif
- if (gnorm_check) then
!
-! Compute the maximum elements of the gradient
+! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
+! in virtual-bond-vector coordinates
!
- gvdwc_max=0.0d0
- gvdwc_scp_max=0.0d0
- gelc_max=0.0d0
- gvdwpp_max=0.0d0
- gradb_max=0.0d0
- ghpbc_max=0.0d0
- gradcorr_max=0.0d0
- gel_loc_max=0.0d0
- gcorr3_turn_max=0.0d0
- gcorr4_turn_max=0.0d0
- gradcorr5_max=0.0d0
- gradcorr6_max=0.0d0
- gcorr6_turn_max=0.0d0
- gsccorc_max=0.0d0
- gscloc_max=0.0d0
- gvdwx_max=0.0d0
- gradx_scp_max=0.0d0
- ghpbx_max=0.0d0
- gradxorr_max=0.0d0
- gsccorx_max=0.0d0
- gsclocx_max=0.0d0
- do i=1,nct
- gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
- if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
- gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
- if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
- gvdwc_scp_max=gvdwc_scp_norm
- gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
- if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
- gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
- if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
- gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
- if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
- ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
- if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
- gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
- if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
- gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
- if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
- gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
- gcorr3_turn(1,i)))
- if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
- gcorr3_turn_max=gcorr3_turn_norm
- gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
- gcorr4_turn(1,i)))
- if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
- gcorr4_turn_max=gcorr4_turn_norm
- gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
- if (gradcorr5_norm.gt.gradcorr5_max) &
- gradcorr5_max=gradcorr5_norm
- gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
- if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
- gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
- gcorr6_turn(1,i)))
- if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
- gcorr6_turn_max=gcorr6_turn_norm
- gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
- if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
- gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
- if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
- gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
- if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
- gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
- if (gradx_scp_norm.gt.gradx_scp_max) &
- gradx_scp_max=gradx_scp_norm
- ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
- if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
- gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
- if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
- gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
- if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
- gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
- if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
+#ifdef DEBUG
+! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
+! do i=1,nres-1
+! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
+! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
+! enddo
+! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
+! do i=1,nres-1
+! write (iout,'(i5,3f10.5,2x,f10.5)')
+! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
+! enddo
+! write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
+! do i=1,nres
+! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
+! i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
+! (gvdwc_scpp(j,i),j=1,3)
+! enddo
+! write (iout,*) "gelc_long gvdwpp gel_loc_long"
+! do i=1,nres
+! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
+! i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
+! (gelc_loc_long(j,i),j=1,3)
+! enddo
+ call flush(iout)
+#endif
+#ifdef SPLITELE
+ do i=0,nct
+ do j=1,3
+ gradbufc(j,i)=wsc*gvdwc(j,i)+ &
+ wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
+ welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+ wcorr*gradcorr_long(j,i)+ &
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i)+ &
+ wstrain*ghpbc(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +gradafm(j,i) &
+ +welec*gshieldc(j,i) &
+ +wcorr*gshieldc_ec(j,i) &
+ +wturn3*gshieldc_t3(j,i)&
+ +wturn4*gshieldc_t4(j,i)&
+ +wel_loc*gshieldc_ll(j,i)&
+ +wtube*gg_tube(j,i) &
+ +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
+ wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
+ wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
+ wcorr_nucl*gradcorr_nucl(j,i)&
+ +wcorr3_nucl*gradcorr3_nucl(j,i)+&
+ wcatprot* gradpepcat(j,i)+ &
+ wcatcat*gradcatcat(j,i)+ &
+ wscbase*gvdwc_scbase(j,i)+ &
+ wpepbase*gvdwc_pepbase(j,i)+&
+ wscpho*gvdwc_scpho(j,i)+ &
+ wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)
+
+
+
+
+
+ enddo
enddo
- if (gradout) then
-#ifdef AIX
- open(istat,file=statname,position="append")
#else
- open(istat,file=statname,access="append")
+ do i=0,nct
+ do j=1,3
+ gradbufc(j,i)=wsc*gvdwc(j,i)+ &
+ wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
+ welec*gelc_long(j,i)+ &
+ wbond*gradb(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+ wcorr*gradcorr_long(j,i)+ &
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i)+ &
+ wstrain*ghpbc(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +gradafm(j,i) &
+ +welec*gshieldc(j,i)&
+ +wcorr*gshieldc_ec(j,i) &
+ +wturn4*gshieldc_t4(j,i) &
+ +wel_loc*gshieldc_ll(j,i)&
+ +wtube*gg_tube(j,i) &
+ +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
+ wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
+ wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
+ wcorr_nucl*gradcorr_nucl(j,i) &
+ +wcorr3_nucl*gradcorr3_nucl(j,i) +&
+ wcatprot* gradpepcat(j,i)+ &
+ wcatcat*gradcatcat(j,i)+ &
+ wscbase*gvdwc_scbase(j,i)+ &
+ wpepbase*gvdwc_pepbase(j,i)+&
+ wscpho*gvdwc_scpho(j,i)+&
+ wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)
+
+
+ enddo
+ enddo
#endif
- write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
- gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
- gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
- gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
- gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
- gsccorx_max,gsclocx_max
- close(istat)
- if (gvdwc_max.gt.1.0d4) then
- write (iout,*) "gvdwc gvdwx gradb gradbx"
- do i=nnt,nct
- write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
- gradb(j,i),gradbx(j,i),j=1,3)
- enddo
- call pdbout(0.0d0,'cipiszcze',iout)
- call flush(iout)
- endif
- endif
- endif
-!#define DEBUG
+#ifdef MPI
+ if (nfgtasks.gt.1) then
+ time00=MPI_Wtime()
#ifdef DEBUG
- write (iout,*) "gradc gradx gloc"
+ write (iout,*) "gradbufc before allreduce"
do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
- enddo
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+ do i=0,nres
+ do j=1,3
+ gradbufc_sum(j,i)=gradbufc(j,i)
+ enddo
+ enddo
+! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
+! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
+! time_reduce=time_reduce+MPI_Wtime()-time00
+#ifdef DEBUG
+! write (iout,*) "gradbufc_sum after allreduce"
+! do i=1,nres
+! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
+! enddo
+! call flush(iout)
#endif
-!#undef DEBUG
#ifdef TIMING
- time_sumgradient=time_sumgradient+MPI_Wtime()-time01
+! time_allreduce=time_allreduce+MPI_Wtime()-time00
#endif
- return
- end subroutine sum_gradient
-!-----------------------------------------------------------------------------
- subroutine sc_grad
-! implicit real*8 (a-h,o-z)
- use calc_data
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.CALC'
-! include 'COMMON.IOUNITS'
- real(kind=8), dimension(3) :: dcosom1,dcosom2
-! print *,"wchodze"
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
- +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
- +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
-
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
- -2.0D0*alf12*eps3der+sigder*sigsq_om12&
- +dCAVdOM12+ dGCLdOM12
-! diagnostics only
-! eom1=0.0d0
-! eom2=0.0d0
-! eom12=evdwij*eps1_om12
-! end diagnostics
-! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
-! " sigder",sigder
-! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
-!C print *,sss_ele_cut,'in sc_grad'
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
+ do i=0,nres
+ do k=1,3
+ gradbufc(k,i)=0.0d0
+ enddo
enddo
- do k=1,3
- gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
-!C print *,'gg',k,gg(k)
- enddo
-! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
-! write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
- *sss_ele_cut
-
- gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
- *sss_ele_cut
-
-! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
-! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
-! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-!
-! Calculate the components of the gradient in DC and X
-!
-!grad do k=i,j-1
-!grad do l=1,3
-!grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-!grad enddo
-!grad enddo
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
- enddo
- return
- end subroutine sc_grad
-#ifdef CRYST_THETA
-!-----------------------------------------------------------------------------
- subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
-
- use comm_calcthet
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.LOCAL'
-! include 'COMMON.IOUNITS'
-!el real(kind=8) :: term1,term2,termm,diffak,ratak,&
-!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
-!el delthe0,sig0inv,sigtc,sigsqtc,delthec,
- real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
- real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
-!el integer :: it
-!el common /calcthet/ term1,term2,termm,diffak,ratak,&
-!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
-!el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
-!el local variables
-
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
-! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
- t3 = thetai-thet_pred_mean
- t6 = t3**2
- t9 = term1
- t12 = t3*sigcsq
- t14 = t12+t6*sigsqtc
- t16 = 1.0d0
- t21 = thetai-theta0i
- t23 = t21**2
- t26 = term2
- t27 = t21*t26
- t32 = termexp
- t40 = t32**2
- E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
- -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
- *(-t12*t9-ak*sig0inv*t27)
- return
- end subroutine mixder
+#ifdef DEBUG
+ write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
+ write (iout,*) (i," jgrad_start",jgrad_start(i),&
+ " jgrad_end ",jgrad_end(i),&
+ i=igrad_start,igrad_end)
#endif
-!-----------------------------------------------------------------------------
-! cartder.F
-!-----------------------------------------------------------------------------
- subroutine cartder
-!-----------------------------------------------------------------------------
-! This subroutine calculates the derivatives of the consecutive virtual
-! bond vectors and the SC vectors in the virtual-bond angles theta and
-! virtual-torsional angles phi, as well as the derivatives of SC vectors
-! in the angles alpha and omega, describing the location of a side chain
-! in its local coordinate system.
-!
-! The derivatives are stored in the following arrays:
-!
-! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
-! The structure is as follows:
-!
-! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
-! dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4)
-! . . . . . . . . . . . . . . . . . .
-! dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4)
-! .
-! .
-! .
-! dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N)
-!
-! DXDV - the derivatives of the side-chain vectors in theta and phi.
-! The structure is same as above.
-!
-! DCDS - the derivatives of the side chain vectors in the local spherical
-! andgles alph and omega:
-!
-! dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2)
-! dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3)
-! .
-! .
-! .
-! dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1)
-!
-! Version of March '95, based on an early version of November '91.
-!
-!**********************************************************************
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.VAR'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
-! include 'COMMON.INTERACT'
- real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
- real(kind=8),dimension(3,3) :: dp,temp
-!el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
- real(kind=8),dimension(3) :: xx,xx1
-!el local variables
- integer :: i,k,l,j,m,ind,ind1,jjj
- real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
- tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
- sint2,xp,yp,xxp,yyp,zzp,dj
-
-! common /przechowalnia/ fromto
- if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
-! get the position of the jth ijth fragment of the chain coordinate system
-! in the fromto array.
-! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
!
-! maxdim=(nres-1)*(nres-2)/2
-! allocate(dcdv(6,maxdim),dxds(6,nres))
-! calculate the derivatives of transformation matrix elements in theta
+! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
+! do not parallelize this part.
!
-
-!el call flush(iout) !el
- do i=1,nres-2
- rdt(1,1,i)=-rt(1,2,i)
- rdt(1,2,i)= rt(1,1,i)
- rdt(1,3,i)= 0.0d0
- rdt(2,1,i)=-rt(2,2,i)
- rdt(2,2,i)= rt(2,1,i)
- rdt(2,3,i)= 0.0d0
- rdt(3,1,i)=-rt(3,2,i)
- rdt(3,2,i)= rt(3,1,i)
- rdt(3,3,i)= 0.0d0
+! do i=igrad_start,igrad_end
+! do j=jgrad_start(i),jgrad_end(i)
+! do k=1,3
+! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
+! enddo
+! enddo
+! enddo
+ do j=1,3
+ gradbufc(j,nres-1)=gradbufc_sum(j,nres)
enddo
-!
-! derivatives in phi
-!
- do i=2,nres-2
- drt(1,1,i)= 0.0d0
- drt(1,2,i)= 0.0d0
- drt(1,3,i)= 0.0d0
- drt(2,1,i)= rt(3,1,i)
- drt(2,2,i)= rt(3,2,i)
- drt(2,3,i)= rt(3,3,i)
- drt(3,1,i)=-rt(2,1,i)
- drt(3,2,i)=-rt(2,2,i)
- drt(3,3,i)=-rt(2,3,i)
- enddo
-!
-! generate the matrix products of type r(i)t(i)...r(j)t(j)
-!
- do i=2,nres-2
- ind=indmat(i,i+1)
- do k=1,3
- do l=1,3
- temp(k,l)=rt(k,l,i)
- enddo
- enddo
- do k=1,3
- do l=1,3
- fromto(k,l,ind)=temp(k,l)
- enddo
- enddo
- do j=i+1,nres-2
- ind=indmat(i,j+1)
- do k=1,3
- do l=1,3
- dpkl=0.0d0
- do m=1,3
- dpkl=dpkl+temp(k,m)*rt(m,l,j)
- enddo
- dp(k,l)=dpkl
- fromto(k,l,ind)=dpkl
- enddo
- enddo
- do k=1,3
- do l=1,3
- temp(k,l)=dp(k,l)
- enddo
- enddo
+ do i=nres-2,-1,-1
+ do j=1,3
+ gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
enddo
-!
-! Calculate derivatives.
-!
- ind1=0
- do i=1,nres-2
- ind1=ind1+1
-!
-! Derivatives of DC(i+1) in theta(i+2)
-!
+#ifdef DEBUG
+ write (iout,*) "gradbufc after summing"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+ else
+#endif
+!el#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gradbufc"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+!el#undef DEBUG
+ do i=-1,nres
do j=1,3
- do k=1,2
- dpjk=0.0D0
- do l=1,3
- dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
- enddo
- dp(j,k)=dpjk
- prordt(j,k,i)=dp(j,k)
- enddo
- dp(j,3)=0.0D0
- dcdv(j,ind1)=vbld(i+1)*dp(j,1)
+ gradbufc_sum(j,i)=gradbufc(j,i)
+ gradbufc(j,i)=0.0d0
enddo
-!
-! Derivatives of SC(i+1) in theta(i+2)
-!
- xx1(1)=-0.5D0*xloc(2,i+1)
- xx1(2)= 0.5D0*xloc(1,i+1)
+ enddo
+ do j=1,3
+ gradbufc(j,nres-1)=gradbufc_sum(j,nres)
+ enddo
+ do i=nres-2,-1,-1
do j=1,3
- xj=0.0D0
- do k=1,2
- xj=xj+r(j,k,i)*xx1(k)
- enddo
- xx(j)=xj
+ gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
+ enddo
+! do i=nnt,nres-1
+! do k=1,3
+! gradbufc(k,i)=0.0d0
+! enddo
+! do j=i+1,nres
+! do k=1,3
+! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
+! enddo
+! enddo
+! enddo
+!el#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gradbufc after summing"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+!el#undef DEBUG
+#ifdef MPI
+ endif
+#endif
+ do k=1,3
+ gradbufc(k,nres)=0.0d0
+ enddo
+!el----------------
+!el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
+!el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
+!el-----------------
+ do i=-1,nct
do j=1,3
- rj=0.0D0
- do k=1,3
- rj=rj+prod(j,k,i)*xx(k)
- enddo
- dxdv(j,ind1)=rj
- enddo
-!
-! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
-! than the other off-diagonal derivatives.
+#ifdef SPLITELE
+ gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
+ wel_loc*gel_loc(j,i)+ &
+ 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
+ welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+ wcorr*gradcorr_long(j,i)+ &
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i))+ &
+ wbond*gradb(j,i)+ &
+ wcorr*gradcorr(j,i)+ &
+ wturn3*gcorr3_turn(j,i)+ &
+ wturn4*gcorr4_turn(j,i)+ &
+ wcorr5*gradcorr5(j,i)+ &
+ wcorr6*gradcorr6(j,i)+ &
+ wturn6*gcorr6_turn(j,i)+ &
+ wsccor*gsccorc(j,i) &
+ +wscloc*gscloc(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +gradafm(j,i) &
+ +welec*gshieldc(j,i) &
+ +welec*gshieldc_loc(j,i) &
+ +wcorr*gshieldc_ec(j,i) &
+ +wcorr*gshieldc_loc_ec(j,i) &
+ +wturn3*gshieldc_t3(j,i) &
+ +wturn3*gshieldc_loc_t3(j,i) &
+ +wturn4*gshieldc_t4(j,i) &
+ +wturn4*gshieldc_loc_t4(j,i) &
+ +wel_loc*gshieldc_ll(j,i) &
+ +wel_loc*gshieldc_loc_ll(j,i) &
+ +wtube*gg_tube(j,i) &
+ +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
+ +wvdwpsb*gvdwpsb1(j,i))&
+ +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
+! if (i.eq.21) then
+! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
+! wturn4*gshieldc_t4(j,i), &
+! wturn4*gshieldc_loc_t4(j,i)
+! endif
+! if ((i.le.2).and.(i.ge.1))
+! print *,gradc(j,i,icg),&
+! gradbufc(j,i),welec*gelc(j,i), &
+! wel_loc*gel_loc(j,i), &
+! wscp*gvdwc_scpp(j,i), &
+! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
+! wel_loc*gel_loc_long(j,i), &
+! wcorr*gradcorr_long(j,i), &
+! wcorr5*gradcorr5_long(j,i), &
+! wcorr6*gradcorr6_long(j,i), &
+! wturn6*gcorr6_turn_long(j,i), &
+! wbond*gradb(j,i), &
+! wcorr*gradcorr(j,i), &
+! wturn3*gcorr3_turn(j,i), &
+! wturn4*gcorr4_turn(j,i), &
+! wcorr5*gradcorr5(j,i), &
+! wcorr6*gradcorr6(j,i), &
+! wturn6*gcorr6_turn(j,i), &
+! wsccor*gsccorc(j,i) &
+! ,wscloc*gscloc(j,i) &
+! ,wliptran*gliptranc(j,i) &
+! ,gradafm(j,i) &
+! ,welec*gshieldc(j,i) &
+! ,welec*gshieldc_loc(j,i) &
+! ,wcorr*gshieldc_ec(j,i) &
+! ,wcorr*gshieldc_loc_ec(j,i) &
+! ,wturn3*gshieldc_t3(j,i) &
+! ,wturn3*gshieldc_loc_t3(j,i) &
+! ,wturn4*gshieldc_t4(j,i) &
+! ,wturn4*gshieldc_loc_t4(j,i) &
+! ,wel_loc*gshieldc_ll(j,i) &
+! ,wel_loc*gshieldc_loc_ll(j,i) &
+! ,wtube*gg_tube(j,i) &
+! ,wbond_nucl*gradb_nucl(j,i) &
+! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
+! wvdwpsb*gvdwpsb1(j,i)&
+! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
!
- do j=1,3
- dxoiij=0.0D0
- do k=1,3
- dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
- enddo
- dxdv(j,ind1+1)=dxoiij
+
+#else
+ gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
+ wel_loc*gel_loc(j,i)+ &
+ 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
+ welec*gelc_long(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+!el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i))+ &
+ wbond*gradb(j,i)+ &
+ wcorr*gradcorr(j,i)+ &
+ wturn3*gcorr3_turn(j,i)+ &
+ wturn4*gcorr4_turn(j,i)+ &
+ wcorr5*gradcorr5(j,i)+ &
+ wcorr6*gradcorr6(j,i)+ &
+ wturn6*gcorr6_turn(j,i)+ &
+ wsccor*gsccorc(j,i) &
+ +wscloc*gscloc(j,i) &
+ +gradafm(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +welec*gshieldc(j,i) &
+ +welec*gshieldc_loc(j,i) &
+ +wcorr*gshieldc_ec(j,i) &
+ +wcorr*gshieldc_loc_ec(j,i) &
+ +wturn3*gshieldc_t3(j,i) &
+ +wturn3*gshieldc_loc_t3(j,i) &
+ +wturn4*gshieldc_t4(j,i) &
+ +wturn4*gshieldc_loc_t4(j,i) &
+ +wel_loc*gshieldc_ll(j,i) &
+ +wel_loc*gshieldc_loc_ll(j,i) &
+ +wtube*gg_tube(j,i) &
+ +wbond_nucl*gradb_nucl(j,i) &
+ +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
+ +wvdwpsb*gvdwpsb1(j,i))&
+ +wsbloc*gsbloc(j,i)+wcatnucl*gradnuclcat(j,i)
+
+
+
+
+#endif
+ gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
+ wbond*gradbx(j,i)+ &
+ wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
+ wsccor*gsccorx(j,i) &
+ +wscloc*gsclocx(j,i) &
+ +wliptran*gliptranx(j,i) &
+ +welec*gshieldx(j,i) &
+ +wcorr*gshieldx_ec(j,i) &
+ +wturn3*gshieldx_t3(j,i) &
+ +wturn4*gshieldx_t4(j,i) &
+ +wel_loc*gshieldx_ll(j,i)&
+ +wtube*gg_tube_sc(j,i) &
+ +wbond_nucl*gradbx_nucl(j,i) &
+ +wvdwsb*gvdwsbx(j,i) &
+ +welsb*gelsbx(j,i) &
+ +wcorr_nucl*gradxorr_nucl(j,i)&
+ +wcorr3_nucl*gradxorr3_nucl(j,i) &
+ +wsbloc*gsblocx(j,i) &
+ +wcatprot* gradpepcatx(j,i)&
+ +wscbase*gvdwx_scbase(j,i) &
+ +wpepbase*gvdwx_pepbase(j,i)&
+ +wscpho*gvdwx_scpho(j,i)+wcatnucl*gradnuclcatx(j,i)
+! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
+
enddo
-!d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
-!
-! Derivatives of DC(i+1) in phi(i+2)
-!
- do j=1,3
- do k=1,3
- dpjk=0.0
- do l=2,3
- dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
- enddo
- dp(j,k)=dpjk
- prodrt(j,k,i)=dp(j,k)
- enddo
- dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
+ enddo
+! write(iout,*), "const_homol",constr_homology
+ if (constr_homology.gt.0) then
+ do i=1,nct
+ do j=1,3
+ gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i)
+! write(iout,*) "duscdiff",duscdiff(j,i)
+ gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i)
+ enddo
enddo
-!
-! Derivatives of SC(i+1) in phi(i+2)
-!
- xx(1)= 0.0D0
- xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
- xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
+ endif
+!#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc before adding corr"
+ do i=1,4*nres
+ write (iout,*) i,gloc(i,icg)
+ enddo
+#endif
+ do i=1,nres-3
+ gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
+ +wcorr5*g_corr5_loc(i) &
+ +wcorr6*g_corr6_loc(i) &
+ +wturn4*gel_loc_turn4(i) &
+ +wturn3*gel_loc_turn3(i) &
+ +wturn6*gel_loc_turn6(i) &
+ +wel_loc*gel_loc_loc(i)
+ enddo
+#ifdef DEBUG
+ write (iout,*) "gloc after adding corr"
+ do i=1,4*nres
+ write (iout,*) i,gloc(i,icg)
+ enddo
+#endif
+!#undef DEBUG
+#ifdef MPI
+ if (nfgtasks.gt.1) then
do j=1,3
- rj=0.0D0
- do k=2,3
- rj=rj+prod(j,k,i)*xx(k)
+ do i=0,nres
+ gradbufc(j,i)=gradc(j,i,icg)
+ gradbufx(j,i)=gradx(j,i,icg)
enddo
- dxdv(j+3,ind1)=-rj
enddo
-!
-! Derivatives of SC(i+1) in phi(i+3).
-!
- do j=1,3
- dxoiij=0.0D0
- do k=1,3
- dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
- enddo
- dxdv(j+3,ind1+1)=dxoiij
- enddo
-!
-! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
-! theta(nres) and phi(i+3) thru phi(nres).
-!
- do j=i+1,nres-2
- ind1=ind1+1
- ind=indmat(i+1,j+1)
-!d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
- do k=1,3
- do l=1,3
- tempkl=0.0D0
- do m=1,2
- tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
- enddo
- temp(k,l)=tempkl
- enddo
- enddo
-!d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
-!d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
-!d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
-! Derivatives of virtual-bond vectors in theta
- do k=1,3
- dcdv(k,ind1)=vbld(i+1)*temp(k,1)
- enddo
-!d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
-! Derivatives of SC vectors in theta
- do k=1,3
- dxoijk=0.0D0
- do l=1,3
- dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
- enddo
- dxdv(k,ind1+1)=dxoijk
- enddo
-!
-!--- Calculate the derivatives in phi
-!
- do k=1,3
- do l=1,3
- tempkl=0.0D0
- do m=1,3
- tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
- enddo
- temp(k,l)=tempkl
- enddo
- enddo
- do k=1,3
- dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
+ do i=1,4*nres
+ glocbuf(i)=gloc(i,icg)
enddo
- do k=1,3
- dxoijk=0.0D0
- do l=1,3
- dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
- enddo
- dxdv(k+3,ind1+1)=dxoijk
- enddo
+!#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc_sc before reduce"
+ do i=1,nres
+ do j=1,1
+ write (iout,*) i,j,gloc_sc(j,i,icg)
+ enddo
+ enddo
+#endif
+!#undef DEBUG
+ do i=0,nres
+ do j=1,3
+ gloc_scbuf(j,i)=gloc_sc(j,i,icg)
+ enddo
enddo
+ time00=MPI_Wtime()
+ call MPI_Barrier(FG_COMM,IERR)
+ time_barrier_g=time_barrier_g+MPI_Wtime()-time00
+ time00=MPI_Wtime()
+ call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ time_reduce=time_reduce+MPI_Wtime()-time00
+ call MPI_Reduce(gloc_scbuf(1,0),gloc_sc(1,0,icg),3*nres+3,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ time_reduce=time_reduce+MPI_Wtime()-time00
+!#define DEBUG
+! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
+#ifdef DEBUG
+ write (iout,*) "gloc_sc after reduce"
+ do i=0,nres
+ do j=1,1
+ write (iout,*) i,j,gloc_sc(j,i,icg)
+ enddo
+ enddo
+#endif
+!#undef DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc after reduce"
+ do i=1,4*nres
+ write (iout,*) i,gloc(i,icg)
enddo
+#endif
+ endif
+#endif
+ if (gnorm_check) then
!
-! Derivatives in alpha and omega:
+! Compute the maximum elements of the gradient
!
- do i=2,nres-1
-! dsci=dsc(itype(i,1))
- dsci=vbld(i+nres)
-#ifdef OSF
- alphi=alph(i)
- omegi=omeg(i)
- if(alphi.ne.alphi) alphi=100.0
- if(omegi.ne.omegi) omegi=-100.0
+ gvdwc_max=0.0d0
+ gvdwc_scp_max=0.0d0
+ gelc_max=0.0d0
+ gvdwpp_max=0.0d0
+ gradb_max=0.0d0
+ ghpbc_max=0.0d0
+ gradcorr_max=0.0d0
+ gel_loc_max=0.0d0
+ gcorr3_turn_max=0.0d0
+ gcorr4_turn_max=0.0d0
+ gradcorr5_max=0.0d0
+ gradcorr6_max=0.0d0
+ gcorr6_turn_max=0.0d0
+ gsccorc_max=0.0d0
+ gscloc_max=0.0d0
+ gvdwx_max=0.0d0
+ gradx_scp_max=0.0d0
+ ghpbx_max=0.0d0
+ gradxorr_max=0.0d0
+ gsccorx_max=0.0d0
+ gsclocx_max=0.0d0
+ do i=1,nct
+ gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
+ if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
+ gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
+ if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
+ gvdwc_scp_max=gvdwc_scp_norm
+ gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
+ if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
+ gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
+ if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
+ gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
+ if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
+ ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
+ if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
+ gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
+ if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
+ gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
+ if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
+ gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
+ gcorr3_turn(1,i)))
+ if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
+ gcorr3_turn_max=gcorr3_turn_norm
+ gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
+ gcorr4_turn(1,i)))
+ if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
+ gcorr4_turn_max=gcorr4_turn_norm
+ gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
+ if (gradcorr5_norm.gt.gradcorr5_max) &
+ gradcorr5_max=gradcorr5_norm
+ gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
+ if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
+ gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
+ gcorr6_turn(1,i)))
+ if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
+ gcorr6_turn_max=gcorr6_turn_norm
+ gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
+ if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
+ gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
+ if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
+ gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
+ if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
+ gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
+ if (gradx_scp_norm.gt.gradx_scp_max) &
+ gradx_scp_max=gradx_scp_norm
+ ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
+ if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
+ gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
+ if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
+ gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
+ if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
+ gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
+ if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
+ enddo
+ if (gradout) then
+#ifdef AIX
+ open(istat,file=statname,position="append")
#else
- alphi=alph(i)
- omegi=omeg(i)
+ open(istat,file=statname,access="append")
#endif
-!d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
- cosalphi=dcos(alphi)
- sinalphi=dsin(alphi)
- cosomegi=dcos(omegi)
- sinomegi=dsin(omegi)
- temp(1,1)=-dsci*sinalphi
- temp(2,1)= dsci*cosalphi*cosomegi
- temp(3,1)=-dsci*cosalphi*sinomegi
- temp(1,2)=0.0D0
- temp(2,2)=-dsci*sinalphi*sinomegi
- temp(3,2)=-dsci*sinalphi*cosomegi
- theta2=pi-0.5D0*theta(i+1)
- cost2=dcos(theta2)
- sint2=dsin(theta2)
- jjj=0
-!d print *,((temp(l,k),l=1,3),k=1,2)
- do j=1,2
- xp=temp(1,j)
- yp=temp(2,j)
- xxp= xp*cost2+yp*sint2
- yyp=-xp*sint2+yp*cost2
- zzp=temp(3,j)
- xx(1)=xxp
- xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
- xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
- do k=1,3
- dj=0.0D0
- do l=1,3
- dj=dj+prod(k,l,i-1)*xx(l)
- enddo
- dxds(jjj+k,i)=dj
+ write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
+ gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
+ gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
+ gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
+ gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
+ gsccorx_max,gsclocx_max
+ close(istat)
+ if (gvdwc_max.gt.1.0d4) then
+ write (iout,*) "gvdwc gvdwx gradb gradbx"
+ do i=nnt,nct
+ write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
+ gradb(j,i),gradbx(j,i),j=1,3)
enddo
- jjj=jjj+3
- enddo
- enddo
- return
- end subroutine cartder
-!-----------------------------------------------------------------------------
-! checkder_p.F
-!-----------------------------------------------------------------------------
- subroutine check_cartgrad
-! Check the gradient of Cartesian coordinates in internal coordinates.
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
+ call pdbout(0.0d0,'cipiszcze',iout)
+ call flush(iout)
+ endif
+ endif
+ endif
+!#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gradc gradx gloc"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
+ i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
+ enddo
+#endif
+!#undef DEBUG
+#ifdef TIMING
+ time_sumgradient=time_sumgradient+MPI_Wtime()-time01
+#endif
+ return
+ end subroutine sum_gradient
+!-----------------------------------------------------------------------------
+ subroutine sc_grad
+! implicit real*8 (a-h,o-z)
+ use calc_data
+! include 'DIMENSIONS'
! include 'COMMON.CHAIN'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
! include 'COMMON.DERIV'
- real(kind=8),dimension(6,nres) :: temp
- real(kind=8),dimension(3) :: xx,gg
- integer :: i,k,j,ii
- real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
-! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
-!
-! Check the gradient of the virtual-bond and SC vectors in the internal
-! coordinates.
-!
- aincr=1.0d-6
- aincr2=5.0d-7
- call cartder
- write (iout,'(a)') '**************** dx/dalpha'
- write (iout,'(a)')
- do i=2,nres-1
- alphi=alph(i)
- alph(i)=alph(i)+aincr
+! include 'COMMON.CALC'
+! include 'COMMON.IOUNITS'
+ real(kind=8), dimension(3) :: dcosom1,dcosom2
+! print *,"wchodze"
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
+ +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
+ +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
+
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
+! " sigder",sigder
+! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
+! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
+!C print *,sss_ele_cut,'in sc_grad'
do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
+ dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+ dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
+ enddo
do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
- i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- alph(i)=alphi
- call chainbuild
+ gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
+!C print *,'gg',k,gg(k)
+ enddo
+! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
+! write (iout,*) "gg",(gg(k),k=1,3)
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
+ *sss_ele_cut
+
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
+ +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
+ *sss_ele_cut
+
+! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/domega'
- write (iout,'(a)')
- do i=2,nres-1
- omegi=omeg(i)
- omeg(i)=omeg(i)+aincr
+!
+! Calculate the components of the gradient in DC and X
+!
+!grad do k=i,j-1
+!grad do l=1,3
+!grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
+!grad enddo
+!grad enddo
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
+ enddo
+ return
+ end subroutine sc_grad
+
+ subroutine sc_grad_cat
+ use calc_data
+ real(kind=8), dimension(3) :: dcosom1,dcosom2
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
+ +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
+ +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
+
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+
do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
+ dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+ dcosom2(k)=rij*(dc_norm(k,j)-om2*erij(k))
+ enddo
do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
- (aincr*dabs(dxds(k+3,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
- i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- omeg(i)=omegi
- call chainbuild
+ gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))
+! print *,'gg',k,gg(k)
+ enddo
+! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
+! write (iout,*) "gg",(gg(k),k=1,3)
+ do k=1,3
+ gradpepcatx(k,i)=gradpepcatx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+
+! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) &
+! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv
+
+! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/dtheta'
- write (iout,'(a)')
- do i=3,nres
- theti=theta(i)
- theta(i)=theta(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-! print *,'i=',i-2,' j=',j-1,' ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
- (aincr*dabs(dxdv(k,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- write (iout,'(a)')
- theta(i)=theti
- call chainbuild
+!
+! Calculate the components of the gradient in DC and X
+!
+ do l=1,3
+ gradpepcat(l,i)=gradpepcat(l,i)-gg(l)
+ gradpepcat(l,j)=gradpepcat(l,j)+gg(l)
enddo
- write (iout,'(a)') '***************** dx/dphi'
- write (iout,'(a)')
- do i=4,nres
- phi(i)=phi(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-! print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
- (aincr*dabs(dxdv(k+3,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- phi(i)=phi(i)-aincr
- call chainbuild
+ end subroutine sc_grad_cat
+
+ subroutine sc_grad_cat_pep
+ use calc_data
+ real(kind=8), dimension(3) :: dcosom1,dcosom2
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
+ +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
+ +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
+
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+
+ do k=1,3
+ dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
+ + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
+ *dsci_inv*2.0 &
+ - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
+ - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
+ *dsci_inv*2.0 &
+ + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ gradpepcat(k,j)=gradpepcat(k,j)+gg(k)
enddo
- write (iout,'(a)') '****************** ddc/dtheta'
- do i=1,nres-2
- thet=theta(i+2)
- theta(i+2)=thet+aincr
- do j=i,nres
- do k=1,3
- temp(k,j)=dc(k,j)
- enddo
- enddo
- call chainbuild
- do j=i+1,nres-1
- ii = indmat(i,j)
-! print *,'ii=',ii
+ end subroutine sc_grad_cat_pep
+
+#ifdef CRYST_THETA
+!-----------------------------------------------------------------------------
+ subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
+
+ use comm_calcthet
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.LOCAL'
+! include 'COMMON.IOUNITS'
+!el real(kind=8) :: term1,term2,termm,diffak,ratak,&
+!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
+!el delthe0,sig0inv,sigtc,sigsqtc,delthec,
+ real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
+ real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
+!el integer :: it
+!el common /calcthet/ term1,term2,termm,diffak,ratak,&
+!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
+!el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
+!el local variables
+
+ delthec=thetai-thet_pred_mean
+ delthe0=thetai-theta0i
+! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
+ t3 = thetai-thet_pred_mean
+ t6 = t3**2
+ t9 = term1
+ t12 = t3*sigcsq
+ t14 = t12+t6*sigsqtc
+ t16 = 1.0d0
+ t21 = thetai-theta0i
+ t23 = t21**2
+ t26 = term2
+ t27 = t21*t26
+ t32 = termexp
+ t40 = t32**2
+ E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
+ -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
+ *(-t12*t9-ak*sig0inv*t27)
+ return
+ end subroutine mixder
+#endif
+!-----------------------------------------------------------------------------
+! cartder.F
+!-----------------------------------------------------------------------------
+ subroutine cartder
+!-----------------------------------------------------------------------------
+! This subroutine calculates the derivatives of the consecutive virtual
+! bond vectors and the SC vectors in the virtual-bond angles theta and
+! virtual-torsional angles phi, as well as the derivatives of SC vectors
+! in the angles alpha and omega, describing the location of a side chain
+! in its local coordinate system.
+!
+! The derivatives are stored in the following arrays:
+!
+! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
+! The structure is as follows:
+!
+! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
+! dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4)
+! . . . . . . . . . . . . . . . . . .
+! dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4)
+! .
+! .
+! .
+! dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N)
+!
+! DXDV - the derivatives of the side-chain vectors in theta and phi.
+! The structure is same as above.
+!
+! DCDS - the derivatives of the side chain vectors in the local spherical
+! andgles alph and omega:
+!
+! dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2)
+! dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3)
+! .
+! .
+! .
+! dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1)
+!
+! Version of March '95, based on an early version of November '91.
+!
+!**********************************************************************
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.VAR'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.INTERACT'
+ real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
+ real(kind=8),dimension(3,3) :: dp,temp
+!el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+ real(kind=8),dimension(3) :: xx,xx1
+!el local variables
+ integer :: i,k,l,j,m,ind,ind1,jjj
+ real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
+ tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
+ sint2,xp,yp,xxp,yyp,zzp,dj
+
+! common /przechowalnia/ fromto
+ if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
+! get the position of the jth ijth fragment of the chain coordinate system
+! in the fromto array.
+! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
+!
+! maxdim=(nres-1)*(nres-2)/2
+! allocate(dcdv(6,maxdim),dxds(6,nres))
+! calculate the derivatives of transformation matrix elements in theta
+!
+
+!el call flush(iout) !el
+ do i=1,nres-2
+ rdt(1,1,i)=-rt(1,2,i)
+ rdt(1,2,i)= rt(1,1,i)
+ rdt(1,3,i)= 0.0d0
+ rdt(2,1,i)=-rt(2,2,i)
+ rdt(2,2,i)= rt(2,1,i)
+ rdt(2,3,i)= 0.0d0
+ rdt(3,1,i)=-rt(3,2,i)
+ rdt(3,2,i)= rt(3,1,i)
+ rdt(3,3,i)= 0.0d0
+ enddo
+!
+! derivatives in phi
+!
+ do i=2,nres-2
+ drt(1,1,i)= 0.0d0
+ drt(1,2,i)= 0.0d0
+ drt(1,3,i)= 0.0d0
+ drt(2,1,i)= rt(3,1,i)
+ drt(2,2,i)= rt(3,2,i)
+ drt(2,3,i)= rt(3,3,i)
+ drt(3,1,i)=-rt(2,1,i)
+ drt(3,2,i)=-rt(2,2,i)
+ drt(3,3,i)=-rt(2,3,i)
+ enddo
+!
+! generate the matrix products of type r(i)t(i)...r(j)t(j)
+!
+ do i=2,nres-2
+ ind=indmat(i,i+1)
do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
- (aincr*dabs(dcdv(k,ii))+aincr))
+ do l=1,3
+ temp(k,l)=rt(k,l,i)
enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
enddo
- do j=1,nres
+ do k=1,3
+ do l=1,3
+ fromto(k,l,ind)=temp(k,l)
+ enddo
+ enddo
+ do j=i+1,nres-2
+ ind=indmat(i,j+1)
do k=1,3
- dc(k,j)=temp(k,j)
- enddo
+ do l=1,3
+ dpkl=0.0d0
+ do m=1,3
+ dpkl=dpkl+temp(k,m)*rt(m,l,j)
+ enddo
+ dp(k,l)=dpkl
+ fromto(k,l,ind)=dpkl
+ enddo
+ enddo
+ do k=1,3
+ do l=1,3
+ temp(k,l)=dp(k,l)
+ enddo
+ enddo
enddo
- theta(i+2)=thet
- enddo
- write (iout,'(a)') '******************* ddc/dphi'
- do i=1,nres-3
- phii=phi(i+3)
- phi(i+3)=phii+aincr
- do j=1,nres
- do k=1,3
- temp(k,j)=dc(k,j)
+ enddo
+!
+! Calculate derivatives.
+!
+ ind1=0
+ do i=1,nres-2
+ ind1=ind1+1
+!
+! Derivatives of DC(i+1) in theta(i+2)
+!
+ do j=1,3
+ do k=1,2
+ dpjk=0.0D0
+ do l=1,3
+ dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
+ enddo
+ dp(j,k)=dpjk
+ prordt(j,k,i)=dp(j,k)
enddo
+ dp(j,3)=0.0D0
+ dcdv(j,ind1)=vbld(i+1)*dp(j,1)
enddo
- call chainbuild
- do j=i+2,nres-1
- ii = indmat(i+1,j)
-! print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
- (aincr*dabs(dcdv(k+3,ii))+aincr))
+!
+! Derivatives of SC(i+1) in theta(i+2)
+!
+ xx1(1)=-0.5D0*xloc(2,i+1)
+ xx1(2)= 0.5D0*xloc(1,i+1)
+ do j=1,3
+ xj=0.0D0
+ do k=1,2
+ xj=xj+r(j,k,i)*xx1(k)
enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
+ xx(j)=xj
enddo
- do j=1,nres
+ do j=1,3
+ rj=0.0D0
do k=1,3
- dc(k,j)=temp(k,j)
+ rj=rj+prod(j,k,i)*xx(k)
enddo
+ dxdv(j,ind1)=rj
enddo
- phi(i+3)=phii
- enddo
- return
- end subroutine check_cartgrad
-!-----------------------------------------------------------------------------
- subroutine check_ecart
-! Check the gradient of the energy in Cartesian coordinates.
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
-! include 'COMMON.CONTACTS'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- real(kind=8),dimension(6) :: ggg
- real(kind=8),dimension(3) :: cc,xx,ddc,ddx
- real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
- real(kind=8),dimension(6,nres) :: grad_s
- real(kind=8),dimension(0:n_ene) :: energia,energia1
- integer :: uiparm(1)
- real(kind=8) :: urparm(1)
-!EL external fdum
- integer :: nf,i,j,k
- real(kind=8) :: aincr,etot,etot1
- icg=1
- nf=0
- nfl=0
- call zerograd
- aincr=1.0D-5
- print '(a)','CG processor',me,' calling CHECK_CART.',aincr
- nf=0
- icall=0
- call geom_to_var(nvar,x)
- call etotal(energia)
- etot=energia(0)
-!el call enerprint(energia)
- call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gradc(j,i,icg)
- grad_s(j+3,i)=gradx(j,i,icg)
+!
+! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
+! than the other off-diagonal derivatives.
+!
+ do j=1,3
+ dxoiij=0.0D0
+ do k=1,3
+ dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
+ enddo
+ dxdv(j,ind1+1)=dxoiij
enddo
- enddo
- call flush(iout)
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
- do i=1,nres
+!d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
+!
+! Derivatives of DC(i+1) in phi(i+2)
+!
do j=1,3
- xx(j)=c(j,i+nres)
- ddc(j)=dc(j,i)
- ddx(j)=dc(j,i+nres)
+ do k=1,3
+ dpjk=0.0
+ do l=2,3
+ dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
+ enddo
+ dp(j,k)=dpjk
+ prodrt(j,k,i)=dp(j,k)
+ enddo
+ dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
enddo
- do j=1,3
- dc(j,i)=dc(j,i)+aincr
- do k=i+1,nres
- c(j,k)=c(j,k)+aincr
- c(j,k+nres)=c(j,k+nres)+aincr
+!
+! Derivatives of SC(i+1) in phi(i+2)
+!
+ xx(1)= 0.0D0
+ xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
+ xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
+ do j=1,3
+ rj=0.0D0
+ do k=2,3
+ rj=rj+prod(j,k,i)*xx(k)
enddo
- call zerograd
- call etotal(energia1)
- etot1=energia1(0)
- ggg(j)=(etot1-etot)/aincr
- dc(j,i)=ddc(j)
- do k=i+1,nres
- c(j,k)=c(j,k)-aincr
- c(j,k+nres)=c(j,k+nres)-aincr
+ dxdv(j+3,ind1)=-rj
+ enddo
+!
+! Derivatives of SC(i+1) in phi(i+3).
+!
+ do j=1,3
+ dxoiij=0.0D0
+ do k=1,3
+ dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
enddo
+ dxdv(j+3,ind1+1)=dxoiij
enddo
- do j=1,3
- c(j,i+nres)=c(j,i+nres)+aincr
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call zerograd
- call etotal(energia1)
- etot1=energia1(0)
- ggg(j+3)=(etot1-etot)/aincr
- c(j,i+nres)=xx(j)
- dc(j,i+nres)=ddx(j)
+!
+! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
+! theta(nres) and phi(i+3) thru phi(nres).
+!
+ do j=i+1,nres-2
+ ind1=ind1+1
+ ind=indmat(i+1,j+1)
+!d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
+ do k=1,3
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,2
+ tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
+ enddo
+ temp(k,l)=tempkl
+ enddo
+ enddo
+!d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
+!d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
+!d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
+! Derivatives of virtual-bond vectors in theta
+ do k=1,3
+ dcdv(k,ind1)=vbld(i+1)*temp(k,1)
+ enddo
+!d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
+! Derivatives of SC vectors in theta
+ do k=1,3
+ dxoijk=0.0D0
+ do l=1,3
+ dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
+ enddo
+ dxdv(k,ind1+1)=dxoijk
+ enddo
+!
+!--- Calculate the derivatives in phi
+!
+ do k=1,3
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,3
+ tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
+ enddo
+ temp(k,l)=tempkl
+ enddo
+ enddo
+ do k=1,3
+ dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
+ do k=1,3
+ dxoijk=0.0D0
+ do l=1,3
+ dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
+ enddo
+ dxdv(k+3,ind1+1)=dxoijk
+ enddo
+ enddo
+ enddo
+!
+! Derivatives in alpha and omega:
+!
+ do i=2,nres-1
+! dsci=dsc(itype(i,1))
+ dsci=vbld(i+nres)
+#ifdef OSF
+ alphi=alph(i)
+ omegi=omeg(i)
+ if(alphi.ne.alphi) alphi=100.0
+ if(omegi.ne.omegi) omegi=-100.0
+#else
+ alphi=alph(i)
+ omegi=omeg(i)
+#endif
+!d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
+ cosalphi=dcos(alphi)
+ sinalphi=dsin(alphi)
+ cosomegi=dcos(omegi)
+ sinomegi=dsin(omegi)
+ temp(1,1)=-dsci*sinalphi
+ temp(2,1)= dsci*cosalphi*cosomegi
+ temp(3,1)=-dsci*cosalphi*sinomegi
+ temp(1,2)=0.0D0
+ temp(2,2)=-dsci*sinalphi*sinomegi
+ temp(3,2)=-dsci*sinalphi*cosomegi
+ theta2=pi-0.5D0*theta(i+1)
+ cost2=dcos(theta2)
+ sint2=dsin(theta2)
+ jjj=0
+!d print *,((temp(l,k),l=1,3),k=1,2)
+ do j=1,2
+ xp=temp(1,j)
+ yp=temp(2,j)
+ xxp= xp*cost2+yp*sint2
+ yyp=-xp*sint2+yp*cost2
+ zzp=temp(3,j)
+ xx(1)=xxp
+ xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
+ xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
+ do k=1,3
+ dj=0.0D0
+ do l=1,3
+ dj=dj+prod(k,l,i-1)*xx(l)
+ enddo
+ dxds(jjj+k,i)=dj
+ enddo
+ jjj=jjj+3
+ enddo
enddo
return
- end subroutine check_ecart
-#ifdef CARGRAD
+ end subroutine cartder
!-----------------------------------------------------------------------------
- subroutine check_ecartint
-! Check the gradient of the energy in Cartesian coordinates.
- use io_base, only: intout
+! checkder_p.F
+!-----------------------------------------------------------------------------
+ subroutine check_cartgrad
+! Check the gradient of Cartesian coordinates in internal coordinates.
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
! include 'COMMON.IOUNITS'
! include 'COMMON.VAR'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.MD'
+! include 'COMMON.CHAIN'
+! include 'COMMON.GEO'
! include 'COMMON.LOCAL'
-! include 'COMMON.SPLITELE'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- real(kind=8),dimension(6) :: ggg,ggg1
- real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
- real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
- real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
- real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
- real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
- real(kind=8),dimension(0:n_ene) :: energia,energia1
- integer :: uiparm(1)
- real(kind=8) :: urparm(1)
-!EL external fdum
- integer :: i,j,k,nf
- real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
- etot21,etot22
- r_cut=2.0d0
- rlambd=0.3d0
- icg=1
- nf=0
- nfl=0
- call intout
-! call intcartderiv
-! call checkintcartgrad
- call zerograd
- aincr=1.0D-4
- write(iout,*) 'Calling CHECK_ECARTINT.'
- nf=0
- icall=0
- call geom_to_var(nvar,x)
- write (iout,*) "split_ene ",split_ene
- call flush(iout)
- if (.not.split_ene) then
- call zerograd
- call etotal(energia)
- etot=energia(0)
- call cartgrad
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
+! include 'COMMON.DERIV'
+ real(kind=8),dimension(6,nres) :: temp
+ real(kind=8),dimension(3) :: xx,gg
+ integer :: i,k,j,ii
+ real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
+! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
+!
+! Check the gradient of the virtual-bond and SC vectors in the internal
+! coordinates.
+!
+ aincr=1.0d-6
+ aincr2=5.0d-7
+ call cartder
+ write (iout,'(a)') '**************** dx/dalpha'
+ write (iout,'(a)')
+ do i=2,nres-1
+ alphi=alph(i)
+ alph(i)=alph(i)+aincr
+ do k=1,3
+ temp(k,i)=dc(k,nres+i)
enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
+ call chainbuild
+ do k=1,3
+ gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
+ xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
+ write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
+ i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
+ alph(i)=alphi
+ call chainbuild
+ enddo
+ write (iout,'(a)')
+ write (iout,'(a)') '**************** dx/domega'
+ write (iout,'(a)')
+ do i=2,nres-1
+ omegi=omeg(i)
+ omeg(i)=omeg(i)+aincr
+ do k=1,3
+ temp(k,i)=dc(k,nres+i)
+ enddo
+ call chainbuild
+ do k=1,3
+ gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
+ xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
+ (aincr*dabs(dxds(k+3,i))+aincr))
+ enddo
+ write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
+ i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
+ omeg(i)=omegi
+ call chainbuild
+ enddo
+ write (iout,'(a)')
+ write (iout,'(a)') '**************** dx/dtheta'
+ write (iout,'(a)')
+ do i=3,nres
+ theti=theta(i)
+ theta(i)=theta(i)+aincr
+ do j=i-1,nres-1
+ do k=1,3
+ temp(k,j)=dc(k,nres+j)
enddo
enddo
- else
-!- split gradient check
- call zerograd
- call etotal_long(energia)
-!el call enerprint(energia)
- call cartgrad
- icall =1
- 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)
+ call chainbuild
+ do j=i-1,nres-1
+ ii = indmat(i-2,j)
+! print *,'i=',i-2,' j=',j-1,' ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
+ (aincr*dabs(dxdv(k,ii))+aincr))
+ enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
+ write(iout,'(a)')
enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
+ write (iout,'(a)')
+ theta(i)=theti
+ call chainbuild
+ enddo
+ write (iout,'(a)') '***************** dx/dphi'
+ write (iout,'(a)')
+ do i=4,nres
+ phi(i)=phi(i)+aincr
+ do j=i-1,nres-1
+ do k=1,3
+ temp(k,j)=dc(k,nres+j)
+ enddo
enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
+ call chainbuild
+ do j=i-1,nres-1
+ ii = indmat(i-2,j)
+! print *,'ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
+ (aincr*dabs(dxdv(k+3,ii))+aincr))
enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
+ write(iout,'(a)')
enddo
- call zerograd
- call etotal_short(energia)
- call enerprint(energia)
- call cartgrad
- icall =1
- 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)
+ phi(i)=phi(i)-aincr
+ call chainbuild
+ enddo
+ write (iout,'(a)') '****************** ddc/dtheta'
+ do i=1,nres-2
+ thet=theta(i+2)
+ theta(i+2)=thet+aincr
+ do j=i,nres
+ do k=1,3
+ temp(k,j)=dc(k,j)
+ enddo
enddo
- do j=1,3
- grad_s1(j,0)=gcart(j,0)
+ call chainbuild
+ do j=i+1,nres-1
+ ii = indmat(i,j)
+! print *,'ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
+ (aincr*dabs(dcdv(k,ii))+aincr))
+ enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
enddo
- do i=1,nres
- do j=1,3
- grad_s1(j,i)=gcart(j,i)
- grad_s1(j+3,i)=gxcart(j,i)
+ do j=1,nres
+ do k=1,3
+ dc(k,j)=temp(k,j)
+ enddo
+ enddo
+ theta(i+2)=thet
+ enddo
+ write (iout,'(a)') '******************* ddc/dphi'
+ do i=1,nres-3
+ phii=phi(i+3)
+ phi(i+3)=phii+aincr
+ do j=1,nres
+ do k=1,3
+ temp(k,j)=dc(k,j)
enddo
enddo
- endif
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
-! do i=1,nres
- do i=nnt,nct
- 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)
+ call chainbuild
+ do j=i+2,nres-1
+ ii = indmat(i+1,j)
+! print *,'ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
+ (aincr*dabs(dcdv(k+3,ii))+aincr))
+ enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
+ enddo
+ do j=1,nres
+ do k=1,3
+ dc(k,j)=temp(k,j)
+ enddo
enddo
+ phi(i+3)=phii
+ enddo
+ return
+ end subroutine check_cartgrad
+!-----------------------------------------------------------------------------
+ subroutine check_ecart
+! Check the gradient of the energy in Cartesian coordinates.
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.VAR'
+! include 'COMMON.CONTACTS'
+ use comm_srutu
+!el integer :: icall
+!el common /srutu/ icall
+ real(kind=8),dimension(6) :: ggg
+ real(kind=8),dimension(3) :: cc,xx,ddc,ddx
+ real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
+ real(kind=8),dimension(6,nres) :: grad_s
+ real(kind=8),dimension(0:n_ene) :: energia,energia1
+ integer :: uiparm(1)
+ real(kind=8) :: urparm(1)
+!EL external fdum
+ integer :: nf,i,j,k
+ real(kind=8) :: aincr,etot,etot1
+ icg=1
+ nf=0
+ nfl=0
+ call zerograd
+ aincr=1.0D-5
+ print '(a)','CG processor',me,' calling CHECK_CART.',aincr
+ nf=0
+ icall=0
+ call geom_to_var(nvar,x)
+ call etotal(energia)
+ etot=energia(0)
+!el call enerprint(energia)
+ call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
+ enddo
+ do i=1,nres
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
+ grad_s(j,i)=gradc(j,i,icg)
+ grad_s(j+3,i)=gradx(j,i,icg)
+ enddo
+ enddo
+ call flush(iout)
+ write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
+ do i=1,nres
+ do j=1,3
+ xx(j)=c(j,i+nres)
+ ddc(j)=dc(j,i)
+ ddx(j)=dc(j,i+nres)
+ enddo
+ do j=1,3
+ dc(j,i)=dc(j,i)+aincr
+ do k=i+1,nres
+ c(j,k)=c(j,k)+aincr
+ c(j,k+nres)=c(j,k+nres)+aincr
+ enddo
+ call zerograd
+ call etotal(energia1)
+ etot1=energia1(0)
+ ggg(j)=(etot1-etot)/aincr
+ dc(j,i)=ddc(j)
+ do k=i+1,nres
+ c(j,k)=c(j,k)-aincr
+ c(j,k+nres)=c(j,k+nres)-aincr
+ enddo
+ enddo
+ do j=1,3
+ c(j,i+nres)=c(j,i+nres)+aincr
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call zerograd
+ call etotal(energia1)
+ etot1=energia1(0)
+ ggg(j+3)=(etot1-etot)/aincr
+ c(j,i+nres)=xx(j)
+ dc(j,i+nres)=ddx(j)
+ enddo
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
+ enddo
+ return
+ end subroutine check_ecart
+#ifdef CARGRAD
+!-----------------------------------------------------------------------------
+ subroutine check_ecartint
+! Check the gradient of the energy in Cartesian coordinates.
+ use io_base, only: intout
+ use MD_data, only: iset
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.VAR'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.MD'
+! include 'COMMON.LOCAL'
+! include 'COMMON.SPLITELE'
+ use comm_srutu
+!el integer :: icall
+!el common /srutu/ icall
+ real(kind=8),dimension(6) :: ggg,ggg1
+ real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
+ real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
+ real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
+ real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
+ real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
+ real(kind=8),dimension(0:n_ene) :: energia,energia1
+ integer :: uiparm(1)
+ real(kind=8) :: urparm(1)
+!EL external fdum
+ integer :: i,j,k,nf
+ real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
+ etot21,etot22
+ r_cut=2.0d0
+ rlambd=0.3d0
+ icg=1
+ nf=0
+ nfl=0
+ if (iset.eq.0) iset=1
+ call intout
+! call intcartderiv
+! call checkintcartgrad
+ call zerograd
+ aincr=1.0D-5
+ write(iout,*) 'Calling CHECK_ECARTINT.'
+ nf=0
+ icall=0
+ call geom_to_var(nvar,x)
+ write (iout,*) "split_ene ",split_ene
+ call flush(iout)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia)
+ etot=energia(0)
+ call cartgrad
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5)') i,(gradxorr(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)
+ write(iout,*) "before movement analytical gradient"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+
+ enddo
+ enddo
+ else
+!- split gradient check
+ call zerograd
+ call etotal_long(energia)
+!el call enerprint(energia)
+ call cartgrad
+ icall =1
+ 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)
+ call cartgrad
+ icall =1
+ 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
+ do i=nnt,nct
+ 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 zerograd
call etotal(energia1)
etot1=energia1(0)
subroutine check_ecartint
! Check the gradient of the energy in Cartesian coordinates.
use io_base, only: intout
+ use MD_data, only: iset
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
icg=1
nf=0
nfl=0
+ if (iset.eq.0) iset=1
call intout
! call intcartderiv
! call checkintcartgrad
call zerograd
- aincr=2.0D-5
+ aincr=1.0D-6
write(iout,*) 'Calling CHECK_ECARTINT.',aincr
nf=0
icall=0
enddo
do j=1,3
grad_s(j,0)=gcart(j,0)
+ grad_s(j+3,0)=gxcart(j,0)
enddo
do i=1,nres
do j=1,3
grad_s(j,i)=gcart(j,i)
-! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
-
-! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
grad_s(j+3,i)=gxcart(j,i)
enddo
enddo
+ write(iout,*) "before movement analytical gradient"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+
else
!- split gradient check
call zerograd
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj
real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
- real(kind=8) :: e1,e2,evdwij,evdw
+ real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,aa,bb
! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
if (sss.lt.1.0d0) then
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
- real(kind=8) :: e1,e2,evdwij,evdw
+ real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj
! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
! Change 12/1/95
num_conti=0
!
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj
real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
- fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
+ fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij,&
+ sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
return
end subroutine eljk_short
!-----------------------------------------------------------------------------
- subroutine ebp_long(evdw)
-!
+ subroutine ebp_long(evdw)
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the Berne-Pechukas potential of interaction.
!
- use calc_data
+ use calc_data
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
! include 'COMMON.CALC'
- use comm_srutu
+ use comm_srutu
!el integer :: icall
!el common /srutu/ icall
! double precision rrsave(maxdim)
- logical :: lprn
+ logical :: lprn
!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac
- real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
- evdw=0.0D0
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,aa,bb
+ real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
+ evdw=0.0D0
! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
+ evdw=0.0D0
! if (icall.eq.0) then
! lprn=.true.
! else
- lprn=.false.
+ lprn=.false.
! endif
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+!el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+chi1=chi(itypi,itypj)
+chi2=chi(itypj,itypi)
+chi12=chi1*chi2
+chip1=chip(itypi)
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ 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)))
+
+ if (sss.lt.1.0d0) then
+
+ ! Calculate the angle-dependent terms of energy & contributions to derivatives.
+ call sc_angular
+ ! Calculate whole angle-dependent part of epsilon and contributions
+ ! to its derivatives
+ fac=(rrij*sigsq)**expon2
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=evdwij*eps3rt
+ eps3der=evdwij*eps2rt
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+evdwij*(1.0d0-sss)
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+ !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
+ !d & restyp(itypi,1),i,restyp(itypj,1),j,
+ !d & epsi,sigm,chi1,chi2,chip1,chip2,
+ !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
+ !d & om1,om2,om12,1.0D0/dsqrt(rrij),
+ !d & evdwij
+ endif
+ ! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)
+ sigder=fac/sigsq
+ fac=rrij*fac
+ ! Calculate radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+ ! Calculate the angular part of the gradient and sum add the contributions
+ ! to the appropriate components of the Cartesian gradient.
+ call sc_grad_scale(1.0d0-sss)
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ ! stop
+ return
+ end subroutine ebp_long
+ !-----------------------------------------------------------------------------
+ subroutine ebp_short(evdw)
+ !
+ ! This subroutine calculates the interaction energy of nonbonded side chains
+ ! assuming the Berne-Pechukas potential of interaction.
+ !
+ use calc_data
+! implicit real*8 (a-h,o-z)
+ ! include 'DIMENSIONS'
+ ! include 'COMMON.GEO'
+ ! include 'COMMON.VAR'
+ ! include 'COMMON.LOCAL'
+ ! include 'COMMON.CHAIN'
+ ! include 'COMMON.DERIV'
+ ! include 'COMMON.NAMES'
+ ! include 'COMMON.INTERACT'
+ ! include 'COMMON.IOUNITS'
+ ! include 'COMMON.CALC'
+ use comm_srutu
+ !el integer :: icall
+ !el common /srutu/ icall
+! double precision rrsave(maxdim)
+ logical :: lprn
+ !el local variables
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
+ real(kind=8) :: sss,e1,e2,evdw,aa,bb, &
+ sslipi,ssgradlipi,sslipj,ssgradlipj
+ evdw=0.0D0
+ ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ ! if (icall.eq.0) then
+ ! lprn=.true.
+ ! else
+ lprn=.false.
+ ! endif
+ !el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-!
-! Calculate SC interaction energy.
-!
+ ! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+ !
+ ! Calculate SC interaction energy.
+ !
do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ do j=istart(i,iint),iend(i,iint)
+ !el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+ ! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
rij=dsqrt(rrij)
sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- if (sss.lt.1.0d0) then
-
-! Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-! Calculate whole angle-dependent part of epsilon and contributions
-! to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
-!d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-!d & restyp(itypi,1),i,restyp(itypj,1),j,
-!d & epsi,sigm,chi1,chi2,chip1,chip2,
-!d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-!d & om1,om2,om12,1.0D0/dsqrt(rrij),
-!d & evdwij
- endif
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-! Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-! Calculate the angular part of the gradient and sum add the contributions
-! to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-! stop
- return
- end subroutine ebp_long
-!-----------------------------------------------------------------------------
- subroutine ebp_short(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Berne-Pechukas potential of interaction.
-!
- use calc_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.NAMES'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
-! double precision rrsave(maxdim)
- logical :: lprn
-!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
- real(kind=8) :: sss,e1,e2,evdw
- evdw=0.0D0
-! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-! if (icall.eq.0) then
-! lprn=.true.
-! else
- lprn=.false.
-! endif
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
+ if (sss.gt.0.0d0) then
! Calculate the angle-dependent terms of energy & contributions to derivatives.
call sc_angular
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
yj=c(2,nres+j)
zj=c(3,nres+j)
! Searching for nearest neighbour
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-
- 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
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
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)))
- sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
- sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
if (sss_ele_cut.le.0.0) cycle
if (sss.lt.1.0d0) then
sigder=fac*sigder
fac=rij*fac
fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
- /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
+ *rij-sss_grad/(1.0-sss)*rij &
/sigmaii(itypi,itypj))
! fac=0.0d0
! Calculate the radial part of the gradient
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(i+nres)
-! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-!
-! Calculate SC interaction energy.
-!
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
'evdw',i,j,evdwij,'tss'
endif!dyn_ss_mask(k)
enddo! k
-
-! if (energy_dec) write (iout,*) &
-! 'evdw',i,j,evdwij,' ss'
ELSE
-!el ind=ind+1
- itypj=itype(j,1)
+
+! typj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
+ dscj_inv=dsc_inv(itypj)
! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
! & 1.0d0/vbld(j+nres)
! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
yj=c(2,nres+j)
zj=c(3,nres+j)
! Searching for nearest neighbour
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-
- 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
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
rij=dsqrt(rrij)
sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
- sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
- sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
if (sss_ele_cut.le.0.0) cycle
if (sss.gt.0.0d0) then
sigder=fac*sigder
fac=rij*fac
fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
- /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
+ *rij+sss_grad/sss*rij &
/sigmaii(itypi,itypj))
! fac=0.0d0
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij,&
+ sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
evdw=0.0D0
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
+
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(i+nres)
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift,&
+ sslipi,ssgradlipi, sslipj,ssgradlipj,aa,bb
real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
evdw=0.0D0
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(i+nres)
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=0
call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+
num_conti=num_cont_hb(i)
call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
do j=ielstart(i),ielend(i)
ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
- ecosam,ecosbm,ecosgm,ghalf,time00
+ ecosam,ecosbm,ecosgm,ghalf,time00,faclipij,faclipij2
! integer :: maxconts
! maxconts = nres/4
! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
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
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- 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
-!C print *,i,j
- 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
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,sss_grad
+ dist_temp, dist_init,sss_grad,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,faclipij2
integer xshift,yshift,zshift
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=0
! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
! & ' ielend',ielend_vdw(i)
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
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- 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
-!C print *,i,j
- 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
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
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
-
+ call to_box(xi,yi,zi)
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
xj=c(1,j)
yj=c(2,j)
zj=c(3,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
- 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
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(1.0d0/rrij)
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
+ call to_box(xi,yi,zi)
+ if (zi.lt.0) zi=zi+boxzsize
do iint=1,nscp_gr(i)
xj=c(1,j)
yj=c(2,j)
zj=c(3,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
- 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
-
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(1.0d0/rrij)
sss_ele_cut=sscale_ele(rij)
integer :: i,n_corr,n_corr1,ierror,ierr
real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
- ecorr,ecorr5,ecorr6,eturn6,time00
+ ecorr,ecorr5,ecorr6,eturn6,time00, ehomology_constr
! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
!elwrite(iout,*)"in etotal long"
#endif
endif
!elwrite(iout,*)"in etotal long"
-
+ ehomology_constr=0.0d0
#ifdef MPI
! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
! & " absolute rank",myrank," nfgtasks",nfgtasks
energia(9)=eello_turn4
energia(10)=eturn6
energia(20)=Uconst+Uconst_back
+ energia(51)=ehomology_constr
call sum_energy(energia,.true.)
! write (iout,*) "Exit ETOTAL_LONG"
call flush(iout)
!el local variables
integer :: i,nres6
real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
- real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
+ real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr, &
+ ehomology_constr
nres6=6*nres
! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
! Calculate the short-range part of ESCp
!
if (ipot.lt.6) then
- call escp_short(evdw2,evdw2_14)
+ call escp_short(evdw2,evdw2_14)
endif
!
! Calculate the bond-stretching energy
!
! Calculate the virtual-bond-angle energy.
!
- call ebend(ebe,ethetacnstr)
-!
! Calculate the SC local energy.
!
call vec_and_deriv
call esc(escloc)
!
+ if (wang.gt.0d0) then
+ if (tor_mode.eq.0) then
+ call ebend(ebe)
+ else
+!C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call ebend_kcc(ebe)
+ endif
+ else
+ ebe=0.0d0
+ endif
+ ethetacnstr=0.0d0
+ if (with_theta_constr) call etheta_constr(ethetacnstr)
+
+! write(iout,*) "in etotal afer ebe",ipot
+
+! print *,"Processor",myrank," computed UB"
+!
+! Calculate the SC local energy.
+!
+ call esc(escloc)
+!elwrite(iout,*) "in etotal afer esc",ipot
+! print *,"Processor",myrank," computed USC"
+!
+! Calculate the virtual-bond torsional energy.
+!
+!d print *,'nterm=',nterm
+! if (wtor.gt.0) then
+! call etor(etors,edihcnstr)
+! else
+! etors=0
+! edihcnstr=0
+! endif
+ if (wtor.gt.0.0d0) then
+ if (tor_mode.eq.0) then
+ call etor(etors)
+ else
+!C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call etor_kcc(etors)
+ endif
+ else
+ etors=0.0d0
+ endif
+ edihcnstr=0.0d0
+ if (ndih_constr.gt.0) call etor_constr(edihcnstr)
+
! Calculate the virtual-bond torsional energy.
!
- call etor(etors,edihcnstr)
!
! 6/23/01 Calculate double-torsional energy
!
+ if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
call etor_d(etors_d)
+ endif
+!
+! Homology restraints
+!
+ if (constr_homology.ge.1) then
+ call e_modeller(ehomology_constr)
+! print *,"tu"
+ else
+ ehomology_constr=0.0d0
+ endif
+
!
! 21/5/07 Calculate local sicdechain correlation energy
!
if (wsccor.gt.0.0d0) then
- call eback_sc_corr(esccor)
+ call eback_sc_corr(esccor)
else
- esccor=0.0d0
+ esccor=0.0d0
endif
!
! Put energy components into an array
!
do i=1,n_ene
- energia(i)=0.0d0
+ energia(i)=0.0d0
enddo
energia(1)=evdw
#ifdef SCP14
energia(17)=estr
energia(19)=edihcnstr
energia(21)=esccor
+ energia(51)=ehomology_constr
! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
call flush(iout)
call sum_energy(energia,.true.)
if (y.lt.ymin) then
gnmr1=(ymin-y)**wykl/wykl
else if (y.gt.ymax) then
- gnmr1=(y-ymax)**wykl/wykl
+ gnmr1=(y-ymax)**wykl/wykl
else
- gnmr1=0.0d0
+ gnmr1=0.0d0
endif
return
end function gnmr1
real(kind=8) :: y,ymin,ymax
real(kind=8) :: wykl=4.0d0
if (y.lt.ymin) then
- gnmr1prim=-(ymin-y)**(wykl-1)
+ gnmr1prim=-(ymin-y)**(wykl-1)
else if (y.gt.ymax) then
- gnmr1prim=(y-ymax)**(wykl-1)
+ gnmr1prim=(y-ymax)**(wykl-1)
else
- gnmr1prim=0.0d0
+ gnmr1prim=0.0d0
endif
return
end function gnmr1prim
if (y.lt.ymin) then
rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
else if (y.gt.ymax) then
- rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
+ rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
else
rlornmr1=0.0d0
endif
rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
((ymin-y)**wykl+sigma**wykl)**2
else if (y.gt.ymax) then
- rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
+ rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
((y-ymax)**wykl+sigma**wykl)**2
else
- rlornmr1prim=0.0d0
+ rlornmr1prim=0.0d0
endif
return
end function rlornmr1prim
gthetai=0.0D0
gphii=0.0D0
do j=i+1,nres-1
- ind=ind+1
+ ind=ind+1
! ind=indmat(i,j)
! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- enddo
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- enddo
+ do k=1,3
+ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
enddo
- do j=i+1,nres-1
- ind1=ind1+1
+ do k=1,3
+ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
+ enddo
+ enddo
+ do j=i+1,nres-1
+ ind1=ind1+1
! ind1=indmat(i,j)
! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
do k=1,3
! include 'COMMON.TIME1'
!
integer :: i,j
+ real(kind=8) :: time00,time01
! This subrouting calculates total Cartesian coordinate gradient.
! The subroutine chainbuild_cart and energy MUST be called beforehand.
!
!#define DEBUG
-#ifdef TIMING
+#ifdef TIMINGtime01
time00=MPI_Wtime()
#endif
icg=1
#endif
!#define DEBUG
!el write (iout,*) "After sum_gradient"
-#ifdef DEBUG
-!el write (iout,*) "After sum_gradient"
- do i=1,nres-1
- write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
- write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
- enddo
-#endif
+!#ifdef DEBUG
+! write (iout,*) "After sum_gradient"
+! do i=1,nres-1
+! write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
+! write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
+! enddo
+!#endif
!#undef DEBUG
! If performing constraint dynamics, add the gradients of the constraint energy
if(usampl.and.totT.gt.eq_time) then
! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
enddo
#ifdef DEBUG
- write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3),gloc(i,icg)
+ write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3),gloc(i,icg),(gloc_sc(j,i,icg),j=1,3)
#endif
enddo
#ifdef TIMING
write (iout,*) "gcart and gxcart after int_to_cart"
do i=0,nres-1
write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3)
+ (gxcart(j,i),j=1,3)
enddo
#endif
!#undef DEBUG
if (nnt.gt.1) then
do j=1,3
! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
- gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
- enddo
- endif
- if (nct.lt.nres) 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
+ gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
+ enddo
+ endif
#endif
#ifdef TIMING
- time_cartgrad=time_cartgrad+MPI_Wtime()-time00
+ time_cartgrad=time_cartgrad+MPI_Wtime()-time00
#endif
!#undef DEBUG
- return
- end subroutine cartgrad
+ return
+ end subroutine cartgrad
!-----------------------------------------------------------------------------
- subroutine zerograd
+ subroutine zerograd
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.DERIV'
! include 'COMMON.SCCOR'
!
!el local variables
- integer :: i,j,intertyp,k
+ integer :: i,j,intertyp,k
! Initialize Cartesian-coordinate gradient
!
! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
! common /mpgrad/
! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
-
-
+
+
! gradc(j,i,icg)=0.0d0
! gradx(j,i,icg)=0.0d0
! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
!elwrite(iout,*) "icg",icg
- do i=-1,nres
- do j=1,3
- gvdwx(j,i)=0.0D0
- gradx_scp(j,i)=0.0D0
- gvdwc(j,i)=0.0D0
- gvdwc_scp(j,i)=0.0D0
- gvdwc_scpp(j,i)=0.0d0
- gelc(j,i)=0.0D0
- gelc_long(j,i)=0.0D0
- gradb(j,i)=0.0d0
- gradbx(j,i)=0.0d0
- gvdwpp(j,i)=0.0d0
- gel_loc(j,i)=0.0d0
- gel_loc_long(j,i)=0.0d0
- ghpbc(j,i)=0.0D0
- ghpbx(j,i)=0.0D0
- gcorr3_turn(j,i)=0.0d0
- gcorr4_turn(j,i)=0.0d0
- gradcorr(j,i)=0.0d0
- gradcorr_long(j,i)=0.0d0
- gradcorr5_long(j,i)=0.0d0
- gradcorr6_long(j,i)=0.0d0
- gcorr6_turn_long(j,i)=0.0d0
- gradcorr5(j,i)=0.0d0
- gradcorr6(j,i)=0.0d0
- gcorr6_turn(j,i)=0.0d0
- gsccorc(j,i)=0.0d0
- gsccorx(j,i)=0.0d0
- gradc(j,i,icg)=0.0d0
- gradx(j,i,icg)=0.0d0
- gscloc(j,i)=0.0d0
- gsclocx(j,i)=0.0d0
- gliptran(j,i)=0.0d0
- gliptranx(j,i)=0.0d0
- gliptranc(j,i)=0.0d0
- gshieldx(j,i)=0.0d0
- gshieldc(j,i)=0.0d0
- gshieldc_loc(j,i)=0.0d0
- gshieldx_ec(j,i)=0.0d0
- gshieldc_ec(j,i)=0.0d0
- gshieldc_loc_ec(j,i)=0.0d0
- gshieldx_t3(j,i)=0.0d0
- gshieldc_t3(j,i)=0.0d0
- gshieldc_loc_t3(j,i)=0.0d0
- gshieldx_t4(j,i)=0.0d0
- gshieldc_t4(j,i)=0.0d0
- gshieldc_loc_t4(j,i)=0.0d0
- gshieldx_ll(j,i)=0.0d0
- gshieldc_ll(j,i)=0.0d0
- gshieldc_loc_ll(j,i)=0.0d0
- gg_tube(j,i)=0.0d0
- gg_tube_sc(j,i)=0.0d0
- gradafm(j,i)=0.0d0
- gradb_nucl(j,i)=0.0d0
- gradbx_nucl(j,i)=0.0d0
- gvdwpp_nucl(j,i)=0.0d0
- gvdwpp(j,i)=0.0d0
- gelpp(j,i)=0.0d0
- gvdwpsb(j,i)=0.0d0
- gvdwpsb1(j,i)=0.0d0
- gvdwsbc(j,i)=0.0d0
- gvdwsbx(j,i)=0.0d0
- gelsbc(j,i)=0.0d0
- gradcorr_nucl(j,i)=0.0d0
- gradcorr3_nucl(j,i)=0.0d0
- gradxorr_nucl(j,i)=0.0d0
- gradxorr3_nucl(j,i)=0.0d0
- gelsbx(j,i)=0.0d0
- gsbloc(j,i)=0.0d0
- gsblocx(j,i)=0.0d0
- gradpepcat(j,i)=0.0d0
- gradpepcatx(j,i)=0.0d0
- gradcatcat(j,i)=0.0d0
- gvdwx_scbase(j,i)=0.0d0
- gvdwc_scbase(j,i)=0.0d0
- gvdwx_pepbase(j,i)=0.0d0
- gvdwc_pepbase(j,i)=0.0d0
- gvdwx_scpho(j,i)=0.0d0
- gvdwc_scpho(j,i)=0.0d0
- gvdwc_peppho(j,i)=0.0d0
- enddo
- enddo
- do i=0,nres
- do j=1,3
- do intertyp=1,3
- gloc_sc(intertyp,i,icg)=0.0d0
- enddo
- enddo
+ do i=-1,nres
+ do j=1,3
+ gvdwx(j,i)=0.0D0
+ gradx_scp(j,i)=0.0D0
+ gvdwc(j,i)=0.0D0
+ gvdwc_scp(j,i)=0.0D0
+ gvdwc_scpp(j,i)=0.0d0
+ gelc(j,i)=0.0D0
+ gelc_long(j,i)=0.0D0
+ gradb(j,i)=0.0d0
+ gradbx(j,i)=0.0d0
+ gvdwpp(j,i)=0.0d0
+ gel_loc(j,i)=0.0d0
+ gel_loc_long(j,i)=0.0d0
+ ghpbc(j,i)=0.0D0
+ ghpbx(j,i)=0.0D0
+ gcorr3_turn(j,i)=0.0d0
+ gcorr4_turn(j,i)=0.0d0
+ gradcorr(j,i)=0.0d0
+ gradcorr_long(j,i)=0.0d0
+ gradcorr5_long(j,i)=0.0d0
+ gradcorr6_long(j,i)=0.0d0
+ gcorr6_turn_long(j,i)=0.0d0
+ gradcorr5(j,i)=0.0d0
+ gradcorr6(j,i)=0.0d0
+ gcorr6_turn(j,i)=0.0d0
+ gsccorc(j,i)=0.0d0
+ gsccorx(j,i)=0.0d0
+ gradc(j,i,icg)=0.0d0
+ gradx(j,i,icg)=0.0d0
+ gscloc(j,i)=0.0d0
+ gsclocx(j,i)=0.0d0
+ gliptran(j,i)=0.0d0
+ gliptranx(j,i)=0.0d0
+ gliptranc(j,i)=0.0d0
+ gshieldx(j,i)=0.0d0
+ gshieldc(j,i)=0.0d0
+ gshieldc_loc(j,i)=0.0d0
+ gshieldx_ec(j,i)=0.0d0
+ gshieldc_ec(j,i)=0.0d0
+ gshieldc_loc_ec(j,i)=0.0d0
+ gshieldx_t3(j,i)=0.0d0
+ gshieldc_t3(j,i)=0.0d0
+ gshieldc_loc_t3(j,i)=0.0d0
+ gshieldx_t4(j,i)=0.0d0
+ gshieldc_t4(j,i)=0.0d0
+ gshieldc_loc_t4(j,i)=0.0d0
+ gshieldx_ll(j,i)=0.0d0
+ gshieldc_ll(j,i)=0.0d0
+ gshieldc_loc_ll(j,i)=0.0d0
+ gg_tube(j,i)=0.0d0
+ gg_tube_sc(j,i)=0.0d0
+ gradafm(j,i)=0.0d0
+ gradb_nucl(j,i)=0.0d0
+ gradbx_nucl(j,i)=0.0d0
+ gvdwpp_nucl(j,i)=0.0d0
+ gvdwpp(j,i)=0.0d0
+ gelpp(j,i)=0.0d0
+ gvdwpsb(j,i)=0.0d0
+ gvdwpsb1(j,i)=0.0d0
+ gvdwsbc(j,i)=0.0d0
+ gvdwsbx(j,i)=0.0d0
+ gelsbc(j,i)=0.0d0
+ gradcorr_nucl(j,i)=0.0d0
+ gradcorr3_nucl(j,i)=0.0d0
+ gradxorr_nucl(j,i)=0.0d0
+ gradxorr3_nucl(j,i)=0.0d0
+ gelsbx(j,i)=0.0d0
+ gsbloc(j,i)=0.0d0
+ gsblocx(j,i)=0.0d0
+ gradpepcat(j,i)=0.0d0
+ gradpepcatx(j,i)=0.0d0
+ gradcatcat(j,i)=0.0d0
+ gvdwx_scbase(j,i)=0.0d0
+ gvdwc_scbase(j,i)=0.0d0
+ gvdwx_pepbase(j,i)=0.0d0
+ gvdwc_pepbase(j,i)=0.0d0
+ gvdwx_scpho(j,i)=0.0d0
+ gvdwc_scpho(j,i)=0.0d0
+ gvdwc_peppho(j,i)=0.0d0
+ gradnuclcatx(j,i)=0.0d0
+ gradnuclcat(j,i)=0.0d0
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
+ enddo
+ enddo
+ do i=0,nres
+ do j=1,3
+ do intertyp=1,3
+ gloc_sc(intertyp,i,icg)=0.0d0
enddo
- do i=1,nres
- do j=1,maxcontsshi
- shield_list(j,i)=0
- do k=1,3
+ enddo
+ enddo
+ do i=1,nres
+ do j=1,maxcontsshi
+ shield_list(j,i)=0
+ do k=1,3
!C print *,i,j,k
- grad_shield_side(k,j,i)=0.0d0
- grad_shield_loc(k,j,i)=0.0d0
- enddo
- enddo
- ishield_list(i)=0
- enddo
+ grad_shield_side(k,j,i)=0.0d0
+ grad_shield_loc(k,j,i)=0.0d0
+ enddo
+ enddo
+ ishield_list(i)=0
+ enddo
!
! Initialize the gradient of local energy terms.
! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
! allocate(gsccor_loc(nres)) !(maxres)
- do i=1,4*nres
- gloc(i,icg)=0.0D0
- enddo
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- g_corr5_loc(i)=0.0d0
- g_corr6_loc(i)=0.0d0
- gel_loc_turn3(i)=0.0d0
- gel_loc_turn4(i)=0.0d0
- gel_loc_turn6(i)=0.0d0
- gsccor_loc(i)=0.0d0
- enddo
+ do i=1,4*nres
+ gloc(i,icg)=0.0D0
+ enddo
+ do i=1,nres
+ gel_loc_loc(i)=0.0d0
+ gcorr_loc(i)=0.0d0
+ g_corr5_loc(i)=0.0d0
+ g_corr6_loc(i)=0.0d0
+ gel_loc_turn3(i)=0.0d0
+ gel_loc_turn4(i)=0.0d0
+ gel_loc_turn6(i)=0.0d0
+ gsccor_loc(i)=0.0d0
+ enddo
! initialize gcart and gxcart
! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
- do i=0,nres
- do j=1,3
- gcart(j,i)=0.0d0
- gxcart(j,i)=0.0d0
- enddo
- enddo
- return
- end subroutine zerograd
+ do i=0,nres
+ do j=1,3
+ gcart(j,i)=0.0d0
+ gxcart(j,i)=0.0d0
+ enddo
+ enddo
+ return
+ end subroutine zerograd
!-----------------------------------------------------------------------------
- real(kind=8) function fdum()
- fdum=0.0D0
- return
- end function fdum
+ real(kind=8) function fdum()
+ fdum=0.0D0
+ return
+ end function fdum
!-----------------------------------------------------------------------------
! intcartderiv.F
!-----------------------------------------------------------------------------
- subroutine intcartderiv
+ subroutine intcartderiv
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
- include 'mpif.h'
+ include 'mpif.h'
#endif
! include 'COMMON.SETUP'
! include 'COMMON.CHAIN'
! include 'COMMON.IOUNITS'
! include 'COMMON.LOCAL'
! include 'COMMON.SCCOR'
- real(kind=8) :: pi4,pi34
- real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
- real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
- dcosomega,dsinomega !(3,3,maxres)
- real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
-
- integer :: i,j,k
- real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
- fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
- fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
- fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
- integer :: nres2
- nres2=2*nres
+ real(kind=8) :: pi4,pi34
+ real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
+ real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
+ dcosomega,dsinomega !(3,3,maxres)
+ real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
+
+ integer :: i,j,k
+ real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
+ fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
+ fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
+ fac17,coso_inv,fac10,fac11,fac12,fac13,fac14,IERROR
+ integer :: nres2
+ nres2=2*nres
!el from module energy-------------
!el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1 .and. me.eq.king) &
- call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
+ if (nfgtasks.gt.1 .and. me.eq.king) &
+ call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
#endif
- pi4 = 0.5d0*pipol
- pi34 = 3*pi4
+ pi4 = 0.5d0*pipol
+ pi34 = 3*pi4
! allocate(dtheta(3,2,nres)) !(3,2,maxres)
! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
- do i=1,nres
- do j=1,3
- dtheta(j,1,i)=0.0d0
- dtheta(j,2,i)=0.0d0
- dphi(j,1,i)=0.0d0
- dphi(j,2,i)=0.0d0
- dphi(j,3,i)=0.0d0
- enddo
- enddo
+ do i=1,nres
+ do j=1,3
+ dtheta(j,1,i)=0.0d0
+ dtheta(j,2,i)=0.0d0
+ dphi(j,1,i)=0.0d0
+ dphi(j,2,i)=0.0d0
+ dphi(j,3,i)=0.0d0
+ dcosomicron(j,1,1,i)=0.0d0
+ dcosomicron(j,1,2,i)=0.0d0
+ dcosomicron(j,2,1,i)=0.0d0
+ dcosomicron(j,2,2,i)=0.0d0
+ enddo
+ enddo
! Derivatives of theta's
#if defined(MPI) && defined(PARINTDER)
! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
+ do i=max0(ithet_start-1,3),ithet_end
#else
- do i=3,nres
+ do i=3,nres
#endif
- cost=dcos(theta(i))
- sint=sqrt(1-cost*cost)
- do j=1,3
- dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
- vbld(i-1)
- if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
- dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
- vbld(i)
- if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
- enddo
- enddo
+ cost=dcos(theta(i))
+ sint=sqrt(1-cost*cost)
+ do j=1,3
+ dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
+ vbld(i-1)
+ if (((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))) &
+ dtheta(j,1,i)=-dcostheta(j,1,i)/sint
+ dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
+ vbld(i)
+ if ((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))&
+ dtheta(j,2,i)=-dcostheta(j,2,i)/sint
+ enddo
+ enddo
#if defined(MPI) && defined(PARINTDER)
! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
+ do i=max0(ithet_start-1,3),ithet_end
#else
- do i=3,nres
+ do i=3,nres
#endif
- if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
- cost1=dcos(omicron(1,i))
- sint1=sqrt(1-cost1*cost1)
- cost2=dcos(omicron(2,i))
- sint2=sqrt(1-cost2*cost2)
- do j=1,3
+ if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).ne.5) then
+ cost1=dcos(omicron(1,i))
+ sint1=sqrt(1-cost1*cost1)
+ cost2=dcos(omicron(2,i))
+ sint2=sqrt(1-cost2*cost2)
+ do j=1,3
!C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
- dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
- cost1*dc_norm(j,i-2))/ &
- vbld(i-1)
- domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
- dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
- +cost1*(dc_norm(j,i-1+nres)))/ &
- vbld(i-1+nres)
- domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
+ dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
+ cost1*dc_norm(j,i-2))/ &
+ vbld(i-1)
+ domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
+ dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
+ +cost1*(dc_norm(j,i-1+nres)))/ &
+ vbld(i-1+nres)
+ domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
!C Calculate derivative over second omicron Sci-1,Cai-1 Cai
!C Looks messy but better than if in loop
- dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
- +cost2*dc_norm(j,i-1))/ &
- vbld(i)
- domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
- dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
- +cost2*(-dc_norm(j,i-1+nres)))/ &
- vbld(i-1+nres)
+ dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
+ +cost2*dc_norm(j,i-1))/ &
+ vbld(i)
+ domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
+ dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
+ +cost2*(-dc_norm(j,i-1+nres)))/ &
+ vbld(i-1+nres)
! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
- domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
- enddo
- endif
- enddo
+ domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
+ enddo
+ endif
+ enddo
!elwrite(iout,*) "after vbld write"
! Derivatives of phi:
! If phi is 0 or 180 degrees, then the formulas
! have to be derived by power series expansion of the
! conventional formulas around 0 and 180.
#ifdef PARINTDER
- do i=iphi1_start,iphi1_end
+ do i=iphi1_start,iphi1_end
#else
- do i=4,nres
+ do i=4,nres
#endif
! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
! the conventional case
- sint=dsin(theta(i))
- sint1=dsin(theta(i-1))
- sing=dsin(phi(i))
- cost=dcos(theta(i))
- cost1=dcos(theta(i-1))
- cosg=dcos(phi(i))
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
+ sint=dsin(theta(i))
+ sint1=dsin(theta(i-1))
+ sing=dsin(phi(i))
+ cost=dcos(theta(i))
+ cost1=dcos(theta(i-1))
+ cosg=dcos(phi(i))
+ scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
! Obtaining the gamma derivatives from sine derivative
- if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
- phi(i).gt.pi34.and.phi(i).le.pi.or. &
- phi(i).ge.-pi.and.phi(i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
- dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
- -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
- dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
- dsinphi(j,2,i)= &
- -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
- dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
+ if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
+ phi(i).gt.pi34.and.phi(i).le.pi.or. &
+ phi(i).ge.-pi.and.phi(i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
+ do j=1,3
+ if (sint.ne.0.0d0) then
+ ctgt=cost/sint
+ else
+ ctgt=0.0d0
+ endif
+ if (sint1.ne.0.0d0) then
+ ctgt1=cost1/sint1
+ else
+ ctgt1=0.0d0
+ endif
+ cosg_inv=1.0d0/cosg
+ if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
+ dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
+ -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
+ dsinphi(j,2,i)= &
+ -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
+ dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
- endif
+ dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
+ endif
+! write(iout,*) "just after,close to pi",dphi(j,3,i),&
+! sing*(ctgt1*dtheta(j,2,i-1)),ctgt*dtheta(j,1,i), &
+! (fac0*vp2(j)+sing*dc_norm(j,i-2)),vbld_inv(i-1)
+
! Bug fixed 3/24/05 (AL)
- enddo
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
- dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
- dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
- dc_norm(j,i-3))/vbld(i-2)
- dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
- dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
- dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
- dcostheta(j,1,i)
- dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
- dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
- dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
- dc_norm(j,i-1))/vbld(i)
- dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
+ else
+ do j=1,3
+ if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
+ dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
+ dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
+ dc_norm(j,i-3))/vbld(i-2)
+ dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
+ dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
+ dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
+ dcostheta(j,1,i)
+ dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
+ dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
+ dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
+ dc_norm(j,i-1))/vbld(i)
+ dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
!#define DEBUG
#ifdef DEBUG
- write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
+ write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
#endif
!#undef DEBUG
- endif
- enddo
- endif
- enddo
+ endif
+ enddo
+ endif
+ enddo
!alculate derivative of Tauangle
#ifdef PARINTDER
- do i=itau_start,itau_end
+ do i=itau_start,itau_end
#else
- do i=3,nres
+ do i=3,nres
!elwrite(iout,*) " vecpr",i,nres
#endif
- if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
+ if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
!c dtauangle(j,intertyp,dervityp,residue number)
!c INTERTYP=1 SC...Ca...Ca..Ca
! the conventional case
- sint=dsin(theta(i))
- sint1=dsin(omicron(2,i-1))
- sing=dsin(tauangle(1,i))
- cost=dcos(theta(i))
- cost1=dcos(omicron(2,i-1))
- cosg=dcos(tauangle(1,i))
+ sint=dsin(theta(i))
+ sint1=dsin(omicron(2,i-1))
+ sing=dsin(tauangle(1,i))
+ cost=dcos(theta(i))
+ cost1=dcos(omicron(2,i-1))
+ cosg=dcos(tauangle(1,i))
!elwrite(iout,*) " vecpr5",i,nres
- do j=1,3
+ do j=1,3
!elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
!elwrite(iout,*) " vecpr5",dc_norm2(1,1)
- dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
+ dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
- enddo
- scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
- ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
+ enddo
+ scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
+ ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
+
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
- tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
- tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
- -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
- *vbld_inv(i-2+nres)
- dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
- dsintau(j,1,2,i)= &
- -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
+ tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
+ tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
+ -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
+ *vbld_inv(i-2+nres)
+ dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
+ dsintau(j,1,2,i)= &
+ -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
! write(iout,*) "dsintau", dsintau(j,1,2,i)
- dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
+ dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
! Bug fixed 3/24/05 (AL)
- dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
+ dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
- enddo
+ dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
- dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
- (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
- dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
- dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
- dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
- dcostheta(j,1,i)
- dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
- dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
- dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
- dc_norm(j,i-1))/vbld(i)
- dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
+ else
+ do j=1,3
+ dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
+ dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
+ (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
+ dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
+ dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
+ dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
+ dcostheta(j,1,i)
+ dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
+ dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
+ dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
+ dc_norm(j,i-1))/vbld(i)
+ dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
! write (iout,*) "else",i
- enddo
- endif
+ enddo
+ endif
! do k=1,3
! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
! enddo
- enddo
+ enddo
!C Second case Ca...Ca...Ca...SC
#ifdef PARINTDER
- do i=itau_start,itau_end
+ do i=itau_start,itau_end
#else
- do i=4,nres
+ do i=4,nres
#endif
- if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
- (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
+ if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
+ (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
! the conventional case
- sint=dsin(omicron(1,i))
- sint1=dsin(theta(i-1))
- sing=dsin(tauangle(2,i))
- cost=dcos(omicron(1,i))
- cost1=dcos(theta(i-1))
- cosg=dcos(tauangle(2,i))
+ sint=dsin(omicron(1,i))
+ sint1=dsin(theta(i-1))
+ sing=dsin(tauangle(2,i))
+ cost=dcos(omicron(1,i))
+ cost1=dcos(theta(i-1))
+ cosg=dcos(tauangle(2,i))
! do j=1,3
! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
! enddo
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
+ scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
- tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
- tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
- call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
- +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
+ tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
+ tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
+ call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
+ +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
- dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
- dsintau(j,2,2,i)= &
- -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
+ dsintau(j,2,2,i)= &
+ -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
! & sing*ctgt*domicron(j,1,2,i),
! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
+ dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
! Bug fixed 3/24/05 (AL)
- dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
+ dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
- enddo
+ dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
- dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
- dc_norm(j,i-3))/vbld(i-2)
- dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
- dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
- dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
- dcosomicron(j,1,1,i)
- dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
- dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
- dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
- dc_norm(j,i-1+nres))/vbld(i-1+nres)
- dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
+ else
+ do j=1,3
+ dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
+ dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
+ dc_norm(j,i-3))/vbld(i-2)
+ dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
+ dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
+ dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
+ dcosomicron(j,1,1,i)
+ dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
+ dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
+ dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
+ dc_norm(j,i-1+nres))/vbld(i-1+nres)
+ dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
- enddo
- endif
- enddo
+ enddo
+ endif
+ enddo
!CC third case SC...Ca...Ca...SC
#ifdef PARINTDER
- do i=itau_start,itau_end
+ do i=itau_start,itau_end
#else
- do i=3,nres
+ do i=3,nres
#endif
! the conventional case
- if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
- (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
- sint=dsin(omicron(1,i))
- sint1=dsin(omicron(2,i-1))
- sing=dsin(tauangle(3,i))
- cost=dcos(omicron(1,i))
- cost1=dcos(omicron(2,i-1))
- cosg=dcos(tauangle(3,i))
- do j=1,3
- dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
+ if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
+ (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
+ sint=dsin(omicron(1,i))
+ sint1=dsin(omicron(2,i-1))
+ sing=dsin(tauangle(3,i))
+ cost=dcos(omicron(1,i))
+ cost1=dcos(omicron(2,i-1))
+ cosg=dcos(tauangle(3,i))
+ do j=1,3
+ dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
- enddo
- scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
+ enddo
+ scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
- tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
- tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
- -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
- *vbld_inv(i-2+nres)
- dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
- dsintau(j,3,2,i)= &
- -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
+ if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
+ tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
+ tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
+ -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
+ *vbld_inv(i-2+nres)
+ dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
+ dsintau(j,3,2,i)= &
+ -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
! Bug fixed 3/24/05 (AL)
- dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
- *vbld_inv(i-1+nres)
+ dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
+ *vbld_inv(i-1+nres)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
- enddo
+ dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
- dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
- dc_norm2(j,i-2+nres))/vbld(i-2+nres)
- dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
- dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
- dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
- dcosomicron(j,1,1,i)
- dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
- dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
- dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
- dc_norm(j,i-1+nres))/vbld(i-1+nres)
- dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
+ else
+ do j=1,3
+ dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
+ dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
+ dc_norm2(j,i-2+nres))/vbld(i-2+nres)
+ dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
+ dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
+ dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
+ dcosomicron(j,1,1,i)
+ dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
+ dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
+ dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
+ dc_norm(j,i-1+nres))/vbld(i-1+nres)
+ dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
! write(iout,*) "else",i
- enddo
- endif
- enddo
+ enddo
+ endif
+ enddo
#ifdef CRYST_SC
! Derivatives of side-chain angles alpha and omega
#if defined(MPI) && defined(PARINTDER)
- do i=ibond_start,ibond_end
+ do i=ibond_start,ibond_end
#else
- do i=2,nres-1
-#endif
- if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
- fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
- fac6=fac5/vbld(i)
- fac7=fac5*fac5
- fac8=fac5/vbld(i+1)
- fac9=fac5/vbld(i+nres)
- scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
- scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
- cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
- (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
- -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
- sina=sqrt(1-cosa*cosa)
- sino=dsin(omeg(i))
+ do i=2,nres-1
+#endif
+ if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
+ fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
+ fac6=fac5/vbld(i)
+ fac7=fac5*fac5
+ fac8=fac5/vbld(i+1)
+ fac9=fac5/vbld(i+nres)
+ scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
+ scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
+ cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
+ (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
+ -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
+ sina=sqrt(1-cosa*cosa)
+ sino=dsin(omeg(i))
! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
- do j=1,3
- dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
- dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
- dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
- dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
- scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
- dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
- dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
- dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
- vbld(i+nres))
- dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
- enddo
+ do j=1,3
+ dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
+ dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
+ dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
+ dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
+ scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
+ dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
+ dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
+ dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
+ vbld(i+nres))
+ dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
+ enddo
! obtaining the derivatives of omega from sines
- if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
- omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
- omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
- fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
- dsin(theta(i+1)))
- fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
- fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
- coso_inv=1.0d0/dcos(omeg(i))
- do j=1,3
- dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
- +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
- (sino*dc_norm(j,i-1))/vbld(i)
- domega(j,1,i)=coso_inv*dsinomega(j,1,i)
- dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
- +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
- -sino*dc_norm(j,i)/vbld(i+1)
- domega(j,2,i)=coso_inv*dsinomega(j,2,i)
- dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
- fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
- vbld(i+nres)
- domega(j,3,i)=coso_inv*dsinomega(j,3,i)
- enddo
- else
- ! obtaining the derivatives of omega from cosines
- fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
- fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
- fac12=fac10*sina
- fac13=fac12*fac12
- fac14=sina*sina
- do j=1,3
- dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
- dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
- (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
- fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
- domega(j,1,i)=-1/sino*dcosomega(j,1,i)
- dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
- dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
- dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
- (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
- dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
- domega(j,2,i)=-1/sino*dcosomega(j,2,i)
- dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
- scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
- (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
- domega(j,3,i)=-1/sino*dcosomega(j,3,i)
- enddo
- endif
- else
+ if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
+ omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
+ omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
+ fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
+ dsin(theta(i+1)))
+ fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
+ fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
+ call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
+ call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
+ call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
+ coso_inv=1.0d0/dcos(omeg(i))
do j=1,3
- do k=1,3
- dalpha(k,j,i)=0.0d0
- domega(k,j,i)=0.0d0
- enddo
- enddo
- endif
- enddo
+ dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
+ +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
+ (sino*dc_norm(j,i-1))/vbld(i)
+ domega(j,1,i)=coso_inv*dsinomega(j,1,i)
+ dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
+ +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
+ -sino*dc_norm(j,i)/vbld(i+1)
+ domega(j,2,i)=coso_inv*dsinomega(j,2,i)
+ dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
+ fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
+ vbld(i+nres)
+ domega(j,3,i)=coso_inv*dsinomega(j,3,i)
+ enddo
+ else
+ ! obtaining the derivatives of omega from cosines
+ fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
+ fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
+ fac12=fac10*sina
+ fac13=fac12*fac12
+ fac14=sina*sina
+ do j=1,3
+ dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
+ dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
+ (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
+ fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
+ domega(j,1,i)=-1/sino*dcosomega(j,1,i)
+ dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
+ dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
+ dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
+ (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
+ dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
+ domega(j,2,i)=-1/sino*dcosomega(j,2,i)
+ dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
+ scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
+ (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
+ domega(j,3,i)=-1/sino*dcosomega(j,3,i)
+ enddo
+ endif
+ else
+ do j=1,3
+ do k=1,3
+ dalpha(k,j,i)=0.0d0
+ domega(k,j,i)=0.0d0
+ enddo
+ enddo
+ endif
+ enddo
#endif
#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1) then
+ if (nfgtasks.gt.1) then
#ifdef DEBUG
!d write (iout,*) "Gather dtheta"
!d call flush(iout)
- write (iout,*) "dtheta before gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
- enddo
+ write (iout,*) "dtheta before gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
+ enddo
#endif
- call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
- MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
+ MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
+ king,FG_COMM,IERROR)
!#define DEBUG
#ifdef DEBUG
!d write (iout,*) "Gather dphi"
!d call flush(iout)
- write (iout,*) "dphi before gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
- enddo
+ write (iout,*) "dphi before gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
+ enddo
#endif
!#undef DEBUG
- call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
- MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
+ MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
!d write (iout,*) "Gather dalpha"
!d call flush(iout)
#ifdef CRYST_SC
- call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
- MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
+ MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
!d write (iout,*) "Gather domega"
!d call flush(iout)
- call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
- MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
+ MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
#endif
- endif
+ endif
#endif
!#define DEBUG
#ifdef DEBUG
- write (iout,*) "dtheta after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
- enddo
- write (iout,*) "dphi after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
- enddo
- write (iout,*) "dalpha after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
- enddo
- write (iout,*) "domega after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
- enddo
+ write (iout,*) "dtheta after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
+ enddo
+ write (iout,*) "dphi after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
+ enddo
+ write (iout,*) "dalpha after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
+ enddo
+ write (iout,*) "domega after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
+ enddo
#endif
!#undef DEBUG
- return
- end subroutine intcartderiv
+ return
+ end subroutine intcartderiv
!-----------------------------------------------------------------------------
- subroutine checkintcartgrad
+ subroutine checkintcartgrad
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
- include 'mpif.h'
+ include 'mpif.h'
#endif
! include 'COMMON.CHAIN'
! include 'COMMON.VAR'
! include 'COMMON.DERIV'
! include 'COMMON.IOUNITS'
! include 'COMMON.SETUP'
- real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
- real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
- real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
- real(kind=8),dimension(3) :: dc_norm_s
- real(kind=8) :: aincr=1.0d-5
- integer :: i,j
- real(kind=8) :: dcji
- do i=1,nres
- phi_s(i)=phi(i)
- theta_s(i)=theta(i)
- alph_s(i)=alph(i)
- omeg_s(i)=omeg(i)
- enddo
+ real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
+ real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
+ real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
+ real(kind=8),dimension(3) :: dc_norm_s
+ real(kind=8) :: aincr=1.0d-5
+ integer :: i,j
+ real(kind=8) :: dcji
+ do i=1,nres
+ phi_s(i)=phi(i)
+ theta_s(i)=theta(i)
+ alph_s(i)=alph(i)
+ omeg_s(i)=omeg(i)
+ enddo
! Check theta gradient
- write (iout,*) &
- "Analytical (upper) and numerical (lower) gradient of theta"
- write (iout,*)
- do i=3,nres
- do j=1,3
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- call int_from_cart1(.false.)
- dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
+ write (iout,*) &
+ "Analytical (upper) and numerical (lower) gradient of theta"
+ write (iout,*)
+ do i=3,nres
+ do j=1,3
+ dcji=dc(j,i-2)
+ dc(j,i-2)=dcji+aincr
+ call chainbuild_cart
+ call int_from_cart1(.false.)
+ dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
!el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
!el (dtheta(j,2,i),j=1,3)
!el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
write (iout,*) &
"Analytical (upper) and numerical (lower) gradient of gamma"
do i=4,nres
- do j=1,3
- dcji=dc(j,i-3)
- dc(j,i-3)=dcji+aincr
- call chainbuild_cart
- dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-3)=dcji
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
+ do j=1,3
+ dcji=dc(j,i-3)
+ dc(j,i-3)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-3)=dcji
+ dcji=dc(j,i-2)
+ dc(j,i-2)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
!el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
!el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
"Analytical (upper) and numerical (lower) gradient of alpha"
do i=2,nres-1
if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
!el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
!el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
"Analytical (upper) and numerical (lower) gradient of omega"
do i=2,nres-1
if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
!el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
!el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
qq = 0.0d0
nl=0
if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
+ do il=seg1+nsep,seg2
+ do jl=seg1,il-nsep
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
- enddo
- qq = qq/nl
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
+ enddo
+ enddo
+ qq = qq/nl
else
do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
+ if((seg3-il).lt.3) then
+ secseg=il+3
+ else
+ secseg=seg3
+ endif
+ do jl=secseg,seg4
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
enddo
+ enddo
qq = qq/nl
endif
if (qqmax.le.qq) qqmax=qq
!el sigm(x)=0.25d0*x ! local function
do kkk=1,nperm
do i=0,nres
- do j=1,3
- dqwol(j,i)=0.0d0
- dxqwol(j,i)=0.0d0
- enddo
+ do j=1,3
+ dqwol(j,i)=0.0d0
+ dxqwol(j,i)=0.0d0
+ enddo
enddo
nl=0
if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
- nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
- sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
-
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim = sim*sim
- dd0=dijCM-d0ijCM
- fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
+ do il=seg1+nsep,seg2
+ do jl=seg1,il-nsep
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ sim = 1.0d0/sigm(d0ij)
+ sim = sim*sim
+ dd0 = dij-d0ij
+ fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il)-c(k,jl))*fac
+ dqwol(k,il)=dqwol(k,il)+ddqij
+ dqwol(k,jl)=dqwol(k,jl)-ddqij
enddo
- enddo
- else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
+
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ sim = 1.0d0/sigm(d0ijCM)
sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ dd0=dijCM-d0ijCM
+ fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
+ ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
+ dxqwol(k,il)=dxqwol(k,il)+ddqij
+ dxqwol(k,jl)=dxqwol(k,jl)-ddqij
enddo
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim=sim*sim
- dd0 = dijCM-d0ijCM
- fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
+ endif
+ enddo
+ enddo
+ else
+ do il=seg1,seg2
+ if((seg3-il).lt.3) then
+ secseg=il+3
+ else
+ secseg=seg3
+ endif
+ do jl=secseg,seg4
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ sim = 1.0d0/sigm(d0ij)
+ sim = sim*sim
+ dd0 = dij-d0ij
+ fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il)-c(k,jl))*fac
+ dqwol(k,il)=dqwol(k,il)+ddqij
+ dqwol(k,jl)=dqwol(k,jl)-ddqij
enddo
- enddo
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
+ nl=nl+1
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ sim = 1.0d0/sigm(d0ijCM)
+ sim=sim*sim
+ dd0 = dijCM-d0ijCM
+ fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
+ dxqwol(k,il)=dxqwol(k,il)+ddqij
+ dxqwol(k,jl)=dxqwol(k,jl)-ddqij
+ enddo
+ endif
+ enddo
+ enddo
endif
enddo
do i=0,nres
- do j=1,3
- dqwol(j,i)=dqwol(j,i)/nl
- dxqwol(j,i)=dxqwol(j,i)/nl
- enddo
+ do j=1,3
+ dqwol(j,i)=dqwol(j,i)/nl
+ dxqwol(j,i)=dxqwol(j,i)/nl
+ enddo
enddo
return
end subroutine qwolynes_prim
integer :: i,j
do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i)=c(j,i)
- c(j,i)=c(j,i)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolan(j,i)=(q2-q1)/delta
- c(j,i)=cdummy(j,i)
- enddo
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i)=c(j,i)
+ c(j,i)=c(j,i)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolan(j,i)=(q2-q1)/delta
+ c(j,i)=cdummy(j,i)
+ enddo
enddo
do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i+nres)=c(j,i+nres)
- c(j,i+nres)=c(j,i+nres)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolxan(j,i)=(q2-q1)/delta
- c(j,i+nres)=cdummy(j,i+nres)
- enddo
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i+nres)=c(j,i+nres)
+ c(j,i+nres)=c(j,i+nres)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolxan(j,i)=(q2-q1)/delta
+ c(j,i+nres)=cdummy(j,i+nres)
+ enddo
enddo
! write(iout,*) "Numerical Q carteisan gradients backbone: "
! do i=0,nct
! include 'COMMON.TIME1'
real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
- duconst,duxconst
+ duconst,duxconst
integer :: kstart,kend,lstart,lend,idummy
real(kind=8) :: delta=1.0d-7
integer :: i,j,k,ii
do i=0,nres
- do j=1,3
- duconst(j,i)=0.0d0
- dudconst(j,i)=0.0d0
- duxconst(j,i)=0.0d0
- dudxconst(j,i)=0.0d0
- enddo
+ do j=1,3
+ duconst(j,i)=0.0d0
+ dudconst(j,i)=0.0d0
+ duxconst(j,i)=0.0d0
+ dudxconst(j,i)=0.0d0
+ enddo
enddo
Uconst=0.0d0
do i=1,nfrag
- qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
- Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
+ qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
+ Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
! Calculating the derivatives of Constraint energy with respect to Q
- Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
- qinfrag(i,iset))
+ Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
+ qinfrag(i,iset))
! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
! hmnum=(hm2-hm1)/delta
! & qinfrag(i,iset))
! write(iout,*) "harmonicnum frag", hmnum
! Calculating the derivatives of Q with respect to cartesian coordinates
- call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
+ call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
! write(iout,*) "dqwol "
! do ii=1,nres
! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
! & ,idummy,idummy)
! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
- enddo
- enddo
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
+ enddo
+ enddo
enddo
do i=1,npair
- kstart=ifrag(1,ipair(1,i,iset),iset)
- kend=ifrag(2,ipair(1,i,iset),iset)
- lstart=ifrag(1,ipair(2,i,iset),iset)
- lend=ifrag(2,ipair(2,i,iset),iset)
- qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
- Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
+ kstart=ifrag(1,ipair(1,i,iset),iset)
+ kend=ifrag(2,ipair(1,i,iset),iset)
+ lstart=ifrag(1,ipair(2,i,iset),iset)
+ lend=ifrag(2,ipair(2,i,iset),iset)
+ qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
+ Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
! Calculating dU/dQ
- Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
+ Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
! hm1=harmonic(qpair(i),qinpair(i,iset))
! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
! hmnum=(hm2-hm1)/delta
! & qinpair(i,iset))
! write(iout,*) "harmonicnum pair ", hmnum
! Calculating dQ/dXi
- call qwolynes_prim(kstart,kend,.false.,&
- lstart,lend)
+ call qwolynes_prim(kstart,kend,.false.,&
+ lstart,lend)
! write(iout,*) "dqwol "
! do ii=1,nres
! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
! call qwol_num(kstart,kend,.false.
! & ,lstart,lend)
! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
- enddo
- enddo
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
+ enddo
+ enddo
enddo
! write(iout,*) "Uconst inside subroutine ", Uconst
! Transforming the gradients from Cs to dCs for the backbone
do i=0,nres
- do j=i+1,nres
- do k=1,3
- dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
- enddo
+ do j=i+1,nres
+ do k=1,3
+ dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
enddo
+ enddo
enddo
! Transforming the gradients from Cs to dCs for the side chains
do i=1,nres
- do j=1,3
- dudxconst(j,i)=duxconst(j,i)
- enddo
+ do j=1,3
+ dudxconst(j,i)=duxconst(j,i)
+ enddo
enddo
! write(iout,*) "dU/ddc backbone "
! do ii=0,nres
! real(kind=8) ::
! For the backbone
do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
+ do j=1,3
+ dUcartan(j,i)=0.0d0
+ cdummy(j,i)=dc(j,i)
+ dc(j,i)=dc(j,i)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ ducartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
enddo
! Calculating numerical gradients for dU/ddx
do i=0,nres-1
- duxcartan(j,i)=0.0d0
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
- ifrag(2,ii,iset),.true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
+ duxcartan(j,i)=0.0d0
+ do j=1,3
+ cdummy(j,i)=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i+nres)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
+ ifrag(2,ii,iset),.true.,idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ duxcartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
enddo
write(iout,*) "Numerical dUconst/ddc backbone "
do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
+ write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
enddo
! write(iout,*) "Numerical dUconst/ddx side-chain "
! do ii=1,nres
pmax=1
do k=1,3
- c(k,i)=0.0D0
- c(k,j)=0.0D0
- c(k,nres+i)=0.0D0
- c(k,nres+j)=0.0D0
+ c(k,i)=0.0D0
+ c(k,j)=0.0D0
+ c(k,nres+i)=0.0D0
+ c(k,nres+j)=0.0D0
enddo
do l=1,lmax
! pj=ran_number(0.0D0,pi/6.0D0)
! pj=0.0D0
- do p=1,pmax
+ do p=1,pmax
!t rij=ran_number(rmin,rmax)
- c(1,j)=d*sin(pj)*cos(tj)
- c(2,j)=d*sin(pj)*sin(tj)
- c(3,j)=d*cos(pj)
+ c(1,j)=d*sin(pj)*cos(tj)
+ c(2,j)=d*sin(pj)*sin(tj)
+ c(3,j)=d*cos(pj)
- c(3,nres+i)=-rij
+ c(3,nres+i)=-rij
- c(1,i)=d*sin(wi)
- c(3,i)=-rij-d*cos(wi)
+ c(1,i)=d*sin(wi)
+ c(3,i)=-rij-d*cos(wi)
- do k=1,3
- dc(k,nres+i)=c(k,nres+i)-c(k,i)
- dc_norm(k,nres+i)=dc(k,nres+i)/d
- dc(k,nres+j)=c(k,nres+j)-c(k,j)
- dc_norm(k,nres+j)=dc(k,nres+j)/d
- enddo
+ do k=1,3
+ dc(k,nres+i)=c(k,nres+i)-c(k,i)
+ dc_norm(k,nres+i)=dc(k,nres+i)/d
+ dc(k,nres+j)=c(k,nres+j)-c(k,j)
+ dc_norm(k,nres+j)=dc(k,nres+j)/d
+ enddo
- call dyn_ssbond_ene(i,j,eij)
- enddo
+ call dyn_ssbond_ene(i,j,eij)
+ enddo
enddo
call exit(1)
return
ssA=akcm
ssB=akct*deltat12
ssC=ss_depth &
- +akth*(deltat1*deltat1+deltat2*deltat2) &
- +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
+ +akth*(deltat1*deltat1+deltat2*deltat2) &
+ +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
ssxm=ssXs-0.5D0*ssB/ssA
!-------TESTING CODE
!-------TESTING CODE
! Stop and plot energy and derivative as a function of distance
if (checkstop) then
- ssm=ssC-0.25D0*ssB*ssB/ssA
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- if (ssm.lt.ljm .and. &
- dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
- nicheck=1000
- njcheck=1
- deps=0.5d-7
- else
- checkstop=.false.
- endif
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ if (ssm.lt.ljm .and. &
+ dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
+ nicheck=1000
+ njcheck=1
+ deps=0.5d-7
+ else
+ checkstop=.false.
+ endif
endif
if (.not.checkstop) then
- nicheck=0
- njcheck=-1
+ nicheck=0
+ njcheck=-1
endif
do icheck=0,nicheck
do jcheck=-1,njcheck
if (checkstop) rij=(ssxm-1.0d0)+ &
- ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
+ ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
!-------END TESTING CODE
if (rij.gt.ljxm) then
- havebond=.false.
- ljd=rij-ljXs
- fac=(1.0D0/ljd)**expon
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- eij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=eij*eps3rt
- eps3der=eij*eps2rt
- eij=eij*eps2rt*eps3rt
-
- sigder=-sig/sigsq
- e1=e1*eps1*eps2rt**2*eps3rt**2
- ed=-expon*(e1+eij)/ljd
- sigder=ed*sigder
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
- -2.0D0*alf12*eps3der+sigder*sigsq_om12
+ havebond=.false.
+ ljd=rij-ljXs
+ fac=(1.0D0/ljd)**expon
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ eij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=eij*eps3rt
+ eps3der=eij*eps2rt
+ eij=eij*eps2rt*eps3rt
+
+ sigder=-sig/sigsq
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ ed=-expon*(e1+eij)/ljd
+ sigder=ed*sigder
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
+ eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12
else if (rij.lt.ssxm) then
- havebond=.true.
- ssd=rij-ssXs
- eij=ssA*ssd*ssd+ssB*ssd+ssC
-
- ed=2*akcm*ssd+akct*deltat12
- pom1=akct*ssd
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
+ havebond=.true.
+ ssd=rij-ssXs
+ eij=ssA*ssd*ssd+ssB*ssd+ssC
+
+ ed=2*akcm*ssd+akct*deltat12
+ pom1=akct*ssd
+ pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
+ eom1=-2*akth*deltat1-pom1-om2*pom2
+ eom2= 2*akth*deltat2+pom1-om1*pom2
+ eom12=pom2
else
- omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
+ omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
- d_ssxm(1)=0.5D0*akct/ssA
- d_ssxm(2)=-d_ssxm(1)
- d_ssxm(3)=0.0D0
+ d_ssxm(1)=0.5D0*akct/ssA
+ d_ssxm(2)=-d_ssxm(1)
+ d_ssxm(3)=0.0D0
- d_ljxm(1)=sig0ij/sqrt(sigsq**3)
- d_ljxm(2)=d_ljxm(1)*sigsq_om2
- d_ljxm(3)=d_ljxm(1)*sigsq_om12
- d_ljxm(1)=d_ljxm(1)*sigsq_om1
+ d_ljxm(1)=sig0ij/sqrt(sigsq**3)
+ d_ljxm(2)=d_ljxm(1)*sigsq_om2
+ d_ljxm(3)=d_ljxm(1)*sigsq_om12
+ d_ljxm(1)=d_ljxm(1)*sigsq_om1
!-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
- xm=0.5d0*(ssxm+ljxm)
- do k=1,3
- d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
- enddo
- if (rij.lt.xm) then
- havebond=.true.
- ssm=ssC-0.25D0*ssB*ssB/ssA
- d_ssm(1)=0.5D0*akct*ssB/ssA
- d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
- d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
- d_ssm(3)=omega
- f1=(rij-xm)/(ssxm-xm)
- f2=(rij-ssxm)/(xm-ssxm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=ssm*h1+Ht*h2
- delta_inv=1.0d0/(xm-ssxm)
- deltasq_inv=delta_inv*delta_inv
- fac=ssm*hd1-Ht*hd2
- fac1=deltasq_inv*fac*(xm-rij)
- fac2=deltasq_inv*fac*(rij-ssxm)
- ed=delta_inv*(Ht*hd2-ssm*hd1)
- eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
- eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
- eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
- else
- havebond=.false.
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
- d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
- d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
- alf12/eps3rt)
- d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
- f1=(rij-ljxm)/(xm-ljxm)
- f2=(rij-xm)/(ljxm-xm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=Ht*h1+ljm*h2
- delta_inv=1.0d0/(ljxm-xm)
- deltasq_inv=delta_inv*delta_inv
- fac=Ht*hd1-ljm*hd2
- fac1=deltasq_inv*fac*(ljxm-rij)
- fac2=deltasq_inv*fac*(rij-xm)
- ed=delta_inv*(ljm*hd2-Ht*hd1)
- eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
- eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
- eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
- endif
+ xm=0.5d0*(ssxm+ljxm)
+ do k=1,3
+ d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
+ enddo
+ if (rij.lt.xm) then
+ havebond=.true.
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ d_ssm(1)=0.5D0*akct*ssB/ssA
+ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+ d_ssm(3)=omega
+ f1=(rij-xm)/(ssxm-xm)
+ f2=(rij-ssxm)/(xm-ssxm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=ssm*h1+Ht*h2
+ delta_inv=1.0d0/(xm-ssxm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=ssm*hd1-Ht*hd2
+ fac1=deltasq_inv*fac*(xm-rij)
+ fac2=deltasq_inv*fac*(rij-ssxm)
+ ed=delta_inv*(Ht*hd2-ssm*hd1)
+ eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
+ eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
+ eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
+ else
+ havebond=.false.
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
+ d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
+ d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
+ alf12/eps3rt)
+ d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
+ f1=(rij-ljxm)/(xm-ljxm)
+ f2=(rij-xm)/(ljxm-xm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=Ht*h1+ljm*h2
+ delta_inv=1.0d0/(ljxm-xm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=Ht*hd1-ljm*hd2
+ fac1=deltasq_inv*fac*(ljxm-rij)
+ fac2=deltasq_inv*fac*(rij-xm)
+ ed=delta_inv*(ljm*hd2-Ht*hd1)
+ eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
+ eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
+ eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
+ endif
!-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
!-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
! endif
!#endif
!#endif
- dyn_ssbond_ij(i,j)=eij
+ dyn_ssbond_ij(i,j)=eij
else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
- dyn_ssbond_ij(i,j)=1.0d300
+ dyn_ssbond_ij(i,j)=1.0d300
!#ifndef CLUST
!#ifndef WHAM
! write(iout,'(a15,f12.2,f8.1,2i5)')
!-------TESTING CODE
!el if (checkstop) then
- if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
- "CHECKSTOP",rij,eij,ed
- echeck(jcheck)=eij
+ if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
+ "CHECKSTOP",rij,eij,ed
+ echeck(jcheck)=eij
!el endif
enddo
if (checkstop) then
- write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
+ write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
endif
enddo
if (checkstop) then
- transgrad=.true.
- checkstop=.false.
+ transgrad=.true.
+ checkstop=.false.
endif
!-------END TESTING CODE
do k=1,3
- dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
- dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
+ dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
+ dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
enddo
do k=1,3
- gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
enddo
do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k) &
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k) &
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwx(k,i)=gvdwx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)=gvdwx(k,j)+gg(k) &
+ +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
!grad do k=i,j-1
!grad do l=1,3
!grad enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
enddo
return
end subroutine dyn_ssbond_ene
!--------------------------------------------------------------------------
- subroutine triple_ssbond_ene(resi,resj,resk,eij)
+ subroutine triple_ssbond_ene(resi,resj,resk,eij)
! implicit none
! Includes
use calc_data
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
itypj=itype(j,1)
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
-
+ call to_box(xj,yj,zj)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
xk=c(1,nres+k)
yk=c(2,nres+k)
zk=c(3,nres+k)
-
+ call to_box(xk,yk,zk)
dxk=dc_norm(1,nres+k)
dyk=dc_norm(2,nres+k)
dzk=dc_norm(3,nres+k)
!C derivative over rij
fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
-eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
- gg(1)=xij*fac/rij
- gg(2)=yij*fac/rij
- gg(3)=zij*fac/rij
+ gg(1)=xij*fac/rij
+ gg(2)=yij*fac/rij
+ gg(3)=zij*fac/rij
do m=1,3
- gvdwx(m,i)=gvdwx(m,i)-gg(m)
- gvdwx(m,j)=gvdwx(m,j)+gg(m)
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,j)=gvdwx(m,j)+gg(m)
enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
enddo
!C now derivative over rik
fac=-eij1**2/dtriss* &
(-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
-eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
- gg(1)=xik*fac/rik
- gg(2)=yik*fac/rik
- gg(3)=zik*fac/rik
+ gg(1)=xik*fac/rik
+ gg(2)=yik*fac/rik
+ gg(3)=zik*fac/rik
do m=1,3
- gvdwx(m,i)=gvdwx(m,i)-gg(m)
- gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
enddo
!C now derivative over rjk
fac=-eij2**2/dtriss* &
(-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
- gg(1)=xjk*fac/rjk
- gg(2)=yjk*fac/rjk
- gg(3)=zjk*fac/rjk
+ gg(1)=xjk*fac/rjk
+ gg(2)=yjk*fac/rjk
+ gg(3)=zjk*fac/rjk
do m=1,3
- gvdwx(m,j)=gvdwx(m,j)-gg(m)
- gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ gvdwx(m,j)=gvdwx(m,j)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
enddo
do l=1,3
- gvdwc(l,j)=gvdwc(l,j)-gg(l)
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ gvdwc(l,j)=gvdwc(l,j)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
enddo
return
end subroutine triple_ssbond_ene
integer :: i,j,imin,ierr
integer :: diff,allnss,newnss
integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
- newihpb,newjhpb
+ newihpb,newjhpb
logical :: found
integer,dimension(0:nfgtasks) :: i_newnss
integer,dimension(0:nfgtasks) :: displ
allnss=0
do i=1,nres-1
- do j=i+1,nres
- if (dyn_ssbond_ij(i,j).lt.1.0d300) then
- allnss=allnss+1
- allflag(allnss)=0
- allihpb(allnss)=i
- alljhpb(allnss)=j
- endif
- enddo
+ do j=i+1,nres
+ if (dyn_ssbond_ij(i,j).lt.1.0d300) then
+ allnss=allnss+1
+ allflag(allnss)=0
+ allihpb(allnss)=i
+ alljhpb(allnss)=j
+ endif
+ enddo
enddo
!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
1 emin=1.0d300
do i=1,allnss
+ if (allflag(i).eq.0 .and. &
+ dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
+ emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
+ imin=i
+ endif
+ enddo
+ if (emin.lt.1.0d300) then
+ allflag(imin)=1
+ do i=1,allnss
if (allflag(i).eq.0 .and. &
- dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
- emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
- imin=i
+ (allihpb(i).eq.allihpb(imin) .or. &
+ alljhpb(i).eq.allihpb(imin) .or. &
+ allihpb(i).eq.alljhpb(imin) .or. &
+ alljhpb(i).eq.alljhpb(imin))) then
+ allflag(i)=-1
endif
enddo
- if (emin.lt.1.0d300) then
- allflag(imin)=1
- do i=1,allnss
- if (allflag(i).eq.0 .and. &
- (allihpb(i).eq.allihpb(imin) .or. &
- alljhpb(i).eq.allihpb(imin) .or. &
- allihpb(i).eq.alljhpb(imin) .or. &
- alljhpb(i).eq.alljhpb(imin))) then
- allflag(i)=-1
- endif
- enddo
- goto 1
+ goto 1
endif
!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
newnss=0
do i=1,allnss
- if (allflag(i).eq.1) then
- newnss=newnss+1
- newihpb(newnss)=allihpb(i)
- newjhpb(newnss)=alljhpb(i)
- endif
+ if (allflag(i).eq.1) then
+ newnss=newnss+1
+ newihpb(newnss)=allihpb(i)
+ newjhpb(newnss)=alljhpb(i)
+ endif
enddo
#ifdef MPI
if (nfgtasks.gt.1)then
- call MPI_Reduce(newnss,g_newnss,1,&
- MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Gather(newnss,1,MPI_INTEGER,&
- i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
- displ(0)=0
- do i=1,nfgtasks-1,1
- displ(i)=i_newnss(i-1)+displ(i-1)
- enddo
- call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
- g_newihpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
- g_newjhpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- if(fg_rank.eq.0) then
+ call MPI_Reduce(newnss,g_newnss,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Gather(newnss,1,MPI_INTEGER,&
+ i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_newnss(i-1)+displ(i-1)
+ enddo
+ call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
+ g_newihpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
+ g_newjhpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ if(fg_rank.eq.0) then
! print *,'g_newnss',g_newnss
! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
- newnss=g_newnss
- do i=1,newnss
- newihpb(i)=g_newihpb(i)
- newjhpb(i)=g_newjhpb(i)
- enddo
- endif
+ newnss=g_newnss
+ do i=1,newnss
+ newihpb(i)=g_newihpb(i)
+ newjhpb(i)=g_newjhpb(i)
+ enddo
+ endif
endif
#endif
!mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
! print *,newnss,nss,maxdim
do i=1,nss
- found=.false.
+ found=.false.
! print *,newnss
- do j=1,newnss
+ do j=1,newnss
!! print *,j
- if (idssb(i).eq.newihpb(j) .and. &
- jdssb(i).eq.newjhpb(j)) found=.true.
- enddo
-#ifndef CLUST
-#ifndef WHAM
+ if (idssb(i).eq.newihpb(j) .and. &
+ jdssb(i).eq.newjhpb(j)) found=.true.
+ enddo
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
! write(iout,*) "found",found,i,j
- if (.not.found.and.fg_rank.eq.0) &
- write(iout,'(a15,f12.2,f8.1,2i5)') &
- "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
-#endif
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
#endif
enddo
do i=1,newnss
- found=.false.
- do j=1,nss
+ found=.false.
+ do j=1,nss
! print *,i,j
- if (newihpb(i).eq.idssb(j) .and. &
- newjhpb(i).eq.jdssb(j)) found=.true.
- enddo
-#ifndef CLUST
-#ifndef WHAM
+ if (newihpb(i).eq.idssb(j) .and. &
+ newjhpb(i).eq.jdssb(j)) found=.true.
+ enddo
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
! write(iout,*) "found",found,i,j
- if (.not.found.and.fg_rank.eq.0) &
- write(iout,'(a15,f12.2,f8.1,2i5)') &
- "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
-#endif
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
#endif
enddo
-
+!#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
nss=newnss
do i=1,nss
- idssb(i)=newihpb(i)
- jdssb(i)=newjhpb(i)
+ idssb(i)=newihpb(i)
+ jdssb(i)=newjhpb(i)
enddo
+!#else
+! nss=0
+!#endif
return
end subroutine dyn_set_nss
! print *, "I am in eliptran"
do i=ilip_start,ilip_end
!C do i=1,1
- if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
- cycle
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
+ cycle
- positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
- if (positi.le.0.0) positi=positi+boxzsize
+ positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
+ if (positi.le.0.0) positi=positi+boxzsize
!C print *,i
!C first for peptide groups
!c for each residue check if it is in lipid or lipid water border area
if ((positi.gt.bordlipbot) &
.and.(positi.lt.bordliptop)) then
!C the energy transfer exist
- if (positi.lt.buflipbot) then
+ if (positi.lt.buflipbot) then
!C what fraction I am in
- fracinbuf=1.0d0- &
- ((positi-bordlipbot)/lipbufthick)
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
!C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
!C print *,"doing sccale for lower part"
!C print *,i,sslip,fracinbuf,ssgradlip
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
!C print *, "doing sscalefor top part"
!C print *,i,sslip,fracinbuf,ssgradlip
- else
- eliptran=eliptran+pepliptran
+ else
+ eliptran=eliptran+pepliptran
!C print *,"I am in true lipid"
- endif
+ endif
!C else
!C eliptran=elpitran+0.0 ! I am in water
endif
enddo
! here starts the side chain transfer
do i=ilip_start,ilip_end
- if (itype(i,1).eq.ntyp1) cycle
- positi=(mod(c(3,i+nres),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
+ if (itype(i,1).eq.ntyp1) cycle
+ positi=(mod(c(3,i+nres),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
if ((positi.gt.bordlipbot) &
.and.(positi.lt.bordliptop)) then
!C the energy transfer exist
- if (positi.lt.buflipbot) then
- fracinbuf=1.0d0- &
- ((positi-bordlipbot)/lipbufthick)
+ if (positi.lt.buflipbot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
!C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i,1))
- gliptranx(3,i)=gliptranx(3,i) &
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i,1))
+ gliptranx(3,i)=gliptranx(3,i) &
+ssgradlip*liptranene(itype(i,1))
- gliptranc(3,i-1)= gliptranc(3,i-1) &
+ gliptranc(3,i-1)= gliptranc(3,i-1) &
+ssgradlip*liptranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0- &
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0- &
((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i,1))
- gliptranx(3,i)=gliptranx(3,i) &
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i,1))
+ gliptranx(3,i)=gliptranx(3,i) &
+ssgradlip*liptranene(itype(i,1))
- gliptranc(3,i-1)= gliptranc(3,i-1) &
+ gliptranc(3,i-1)= gliptranc(3,i-1) &
+ssgradlip*liptranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- eliptran=eliptran+liptranene(itype(i,1))
+ else
+ eliptran=eliptran+liptranene(itype(i,1))
!C print *,"I am in true lipid"
- endif
- endif ! if in lipid or buffor
+ endif
+ endif ! if in lipid or buffor
!C else
!C eliptran=elpitran+0.0 ! I am in water
- if (energy_dec) write(iout,*) i,"eliptran=",eliptran
+ if (energy_dec) write(iout,*) i,"eliptran=",eliptran
enddo
return
end subroutine Eliptransfer
integer :: i,j,iti
Etube=0.0d0
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C for UNRES
xmin=boxxsize
ymin=boxysize
! Find minimum distance in periodic box
- do j=-1,1
- vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(1)=vectube(1)-tubecenter(1)
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
!C now direction of gg_tube vector
- do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- enddo
+ do j=1,3
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ enddo
!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
!C print *,gg_tube(1,0),"TU"
do i=itube_start,itube_end
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!C in UNRES uncomment the line below as GLY has no side-chain...
!C .or.(iti.eq.10)
- ) cycle
+ ) cycle
xmin=boxxsize
ymin=boxysize
- do j=-1,1
- vectube(1)=mod((c(1,i+nres)),boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i+nres)),boxysize)
- vectube(2)=vectube(2)+boxysize*j
-
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i+nres)),boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i+nres)),boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
sc_bb_tube=sc_bb_tube_par(iti)
enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
- 6.0d0*sc_bb_tube/rdiff6/rdiff
+ 6.0d0*sc_bb_tube/rdiff6/rdiff
!C now direction of gg_tube vector
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)
- enddo
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)
+ enddo
!C print *,"ETUBE", etube
- return
- end subroutine calctube
+ return
+ end subroutine calctube
!C TO DO 1) add to total energy
!C 2) add to gradient summation
!C 3) add reading parameters (AND of course oppening of PARAM file)
!C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
!C simple Kihara potential
subroutine calctube2(Etube)
- real(kind=8),dimension(3) :: vectube
+ real(kind=8),dimension(3) :: vectube
real(kind=8) :: Etube,xtemp,xminact,yminact,&
ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
sstube,ssgradtube,sc_aa_tube,sc_bb_tube
integer:: i,j,iti
Etube=0.0d0
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C first sugare-phosphate group for NARES this would be peptide group
!C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
xmin=boxxsize
ymin=boxysize
- do j=-1,1
- vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
-
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(1)=vectube(1)-tubecenter(1)
!C and its 6 power
rdiff6=rdiff**6.0d0
!C THIS FRAGMENT MAKES TUBE FINITE
- positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
- if (positi.le.0) positi=positi+boxzsize
+ positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
!C print *,positi,bordtubebot,buftubebot,bordtubetop
if ((positi.gt.bordtubebot) &
- .and.(positi.lt.bordtubetop)) then
+ .and.(positi.lt.bordtubetop)) then
!C the energy transfer exist
- if (positi.lt.buftubebot) then
- fracinbuf=1.0d0- &
- ((positi-bordtubebot)/tubebufthick)
+ if (positi.lt.buftubebot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordtubebot)/tubebufthick)
!C lipbufthick is thickenes of lipid buffore
- sstube=sscalelip(fracinbuf)
- ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
!C print *,ssgradtube, sstube,tubetranene(itype(i,1))
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.buftubetop) then
- fracinbuf=1.0d0- &
- ((bordtubetop-positi)/tubebufthick)
- sstube=sscalelip(fracinbuf)
- ssgradtube=sscagradlip(fracinbuf)/tubebufthick
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ elseif (positi.gt.buftubetop) then
+ fracinbuf=1.0d0- &
+ ((bordtubetop-positi)/tubebufthick)
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- sstube=1.0d0
- ssgradtube=0.0d0
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ else
+ sstube=1.0d0
+ ssgradtube=0.0d0
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C print *,"I am in true lipid"
- endif
- else
+ endif
+ else
!C sstube=0.0d0
!C ssgradtube=0.0d0
- cycle
- endif ! if in lipid or buffor
+ cycle
+ endif ! if in lipid or buffor
!C for vectorization reasons we will sumup at the end to avoid depenence of previous
enetube(i)=enetube(i)+sstube* &
- (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
+ (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
!C write(iout,*) "TU13",i,rdiff6,enetube(i)
!C print *,rdiff,rdiff6,pep_aa_tube
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
!C now direction of gg_tube vector
do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- gg_tube(3,i)=gg_tube(3,i) &
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ gg_tube(3,i)=gg_tube(3,i) &
+ssgradtube*enetube(i)/sstube/2.0d0
- gg_tube(3,i-1)= gg_tube(3,i-1) &
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ssgradtube*enetube(i)/sstube/2.0d0
- enddo
+ enddo
!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
!C print *,gg_tube(1,0),"TU"
- do i=itube_start,itube_end
+ do i=itube_start,itube_end
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!!C in UNRES uncomment the line below as GLY has no side-chain...
- .or.(iti.eq.10) &
- ) cycle
- vectube(1)=c(1,i+nres)
- vectube(1)=mod(vectube(1),boxxsize)
- if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
- vectube(2)=c(2,i+nres)
- vectube(2)=mod(vectube(2),boxysize)
- if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
+ .or.(iti.eq.10) &
+ ) cycle
+ vectube(1)=c(1,i+nres)
+ vectube(1)=mod(vectube(1),boxxsize)
+ if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
+ vectube(2)=c(2,i+nres)
+ vectube(2)=mod(vectube(2),boxysize)
+ if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
vectube(1)=vectube(1)-tubecenter(1)
vectube(2)=vectube(2)-tubecenter(2)
!C THIS FRAGMENT MAKES TUBE FINITE
- positi=(mod(c(3,i+nres),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
+ positi=(mod(c(3,i+nres),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
!C print *,positi,bordtubebot,buftubebot,bordtubetop
if ((positi.gt.bordtubebot) &
- .and.(positi.lt.bordtubetop)) then
+ .and.(positi.lt.bordtubetop)) then
!C the energy transfer exist
- if (positi.lt.buftubebot) then
- fracinbuf=1.0d0- &
- ((positi-bordtubebot)/tubebufthick)
+ if (positi.lt.buftubebot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordtubebot)/tubebufthick)
!C lipbufthick is thickenes of lipid buffore
- sstube=sscalelip(fracinbuf)
- ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
!C print *,ssgradtube, sstube,tubetranene(itype(i,1))
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.buftubetop) then
- fracinbuf=1.0d0- &
- ((bordtubetop-positi)/tubebufthick)
+ elseif (positi.gt.buftubetop) then
+ fracinbuf=1.0d0- &
+ ((bordtubetop-positi)/tubebufthick)
- sstube=sscalelip(fracinbuf)
- ssgradtube=sscagradlip(fracinbuf)/tubebufthick
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- sstube=1.0d0
- ssgradtube=0.0d0
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ else
+ sstube=1.0d0
+ ssgradtube=0.0d0
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C print *,"I am in true lipid"
- endif
- else
+ endif
+ else
!C sstube=0.0d0
!C ssgradtube=0.0d0
- cycle
- endif ! if in lipid or buffor
+ cycle
+ endif ! if in lipid or buffor
!CEND OF FINITE FRAGMENT
!C as the tube is infinity we do not calculate the Z-vector use of Z
!C as chosen axis
sc_aa_tube=sc_aa_tube_par(iti)
sc_bb_tube=sc_bb_tube_par(iti)
enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
- *sstube+enetube(i+nres)
+ *sstube+enetube(i+nres)
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
- 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
+ 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
!C now direction of gg_tube vector
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- gg_tube_SC(3,i)=gg_tube_SC(3,i) &
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ gg_tube_SC(3,i)=gg_tube_SC(3,i) &
+ssgradtube*enetube(i+nres)/sstube
- gg_tube(3,i-1)= gg_tube(3,i-1) &
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ssgradtube*enetube(i+nres)/sstube
- enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)
- enddo
+ enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)
+ enddo
!C print *,"ETUBE", etube
- return
- end subroutine calctube2
+ return
+ end subroutine calctube2
!=====================================================================================================================================
subroutine calcnano(Etube)
real(kind=8),dimension(3) :: vectube
Etube=0.0d0
! print *,itube_start,itube_end,"poczatek"
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C first sugare-phosphate group for NARES this would be peptide group
ymin=boxysize
zmin=boxzsize
- do j=-1,1
- vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
- vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
- vectube(3)=vectube(3)+boxzsize*j
+ do j=-1,1
+ vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+ vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
+ vectube(3)=vectube(3)+boxzsize*j
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
+ xminact=dabs(vectube(1)-tubecenter(1))
+ yminact=dabs(vectube(2)-tubecenter(2))
+ zminact=dabs(vectube(3)-tubecenter(3))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ if (zmin.gt.zminact) then
+ zmin=zminact
+ ztemp=vectube(3)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(3)=ztemp
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
- if (acavtubpep.eq.0.0d0) then
+ if (acavtubpep.eq.0.0d0) then
!C go to 667
- enecavtube(i)=0.0
- faccav=0.0
- else
- denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
- enecavtube(i)= &
- (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
- /denominator
- enecavtube(i)=0.0
- faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
- *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
- +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
- /denominator**2.0d0
+ enecavtube(i)=0.0
+ faccav=0.0
+ else
+ denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
+ enecavtube(i)= &
+ (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
+ /denominator
+ enecavtube(i)=0.0
+ faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
+ *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
+ +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
+ /denominator**2.0d0
!C faccav=0.0
!C fac=fac+faccav
!C 667 continue
- endif
- if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
- do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- enddo
+ endif
+ if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
+ do j=1,3
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ enddo
do i=itube_start,itube_end
- enecavtube(i)=0.0d0
+ enecavtube(i)=0.0d0
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!C in UNRES uncomment the line below as GLY has no side-chain...
!C .or.(iti.eq.10)
- ) cycle
+ ) cycle
xmin=boxxsize
ymin=boxysize
zmin=boxzsize
- do j=-1,1
- vectube(1)=dmod((c(1,i+nres)),boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=dmod((c(2,i+nres)),boxysize)
- vectube(2)=vectube(2)+boxysize*j
- vectube(3)=dmod((c(3,i+nres)),boxzsize)
- vectube(3)=vectube(3)+boxzsize*j
-
-
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
-
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=dmod((c(1,i+nres)),boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=dmod((c(2,i+nres)),boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+ vectube(3)=dmod((c(3,i+nres)),boxzsize)
+ vectube(3)=vectube(3)+boxzsize*j
+
+
+ xminact=dabs(vectube(1)-tubecenter(1))
+ yminact=dabs(vectube(2)-tubecenter(2))
+ zminact=dabs(vectube(3)-tubecenter(3))
+
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ if (zmin.gt.zminact) then
+ zmin=zminact
+ ztemp=vectube(3)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(3)=ztemp
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
- 6.0d0*sc_bb_tube/rdiff6/rdiff
+ 6.0d0*sc_bb_tube/rdiff6/rdiff
!C fac=0.0
!C now direction of gg_tube vector
!C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
- if (acavtub(iti).eq.0.0d0) then
+ if (acavtub(iti).eq.0.0d0) then
!C go to 667
- enecavtube(i+nres)=0.0d0
- faccav=0.0d0
- else
- denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
- enecavtube(i+nres)= &
- (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
- /denominator
+ enecavtube(i+nres)=0.0d0
+ faccav=0.0d0
+ else
+ denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
+ enecavtube(i+nres)= &
+ (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
+ /denominator
!C enecavtube(i)=0.0
- faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
- *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
- +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
- /denominator**2.0d0
+ faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
+ *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
+ +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
+ /denominator**2.0d0
!C faccav=0.0
- fac=fac+faccav
+ fac=fac+faccav
!C 667 continue
- endif
+ endif
!C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
!C & enecavtube(i),faccav
!C print *,"licz=",
!C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
!C print *,"finene=",enetube(i+nres)+enecavtube(i)
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
- enddo
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
+ enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
- +enecavtube(i+nres)
- enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
+ +enecavtube(i+nres)
+ enddo
! do i=1,20
! print *,"begin", i,"a"
! do r=1,10000
! print *,"end",i,"a"
! enddo
!C print *,"ETUBE", etube
- return
- end subroutine calcnano
+ return
+ end subroutine calcnano
!===============================================
!--------------------------------------------------------------------------------
subroutine set_shield_fac2
real(kind=8) :: div77_81=0.974996043d0, &
- div4_81=0.2222222222d0
+ div4_81=0.2222222222d0
real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
- scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
- short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
- sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
+ scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
+ short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
+ sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
!C the vector between center of side_chain and peptide group
real(kind=8),dimension(3) :: pep_side_long,side_calf, &
- pept_group,costhet_grad,cosphi_grad_long, &
- cosphi_grad_loc,pep_side_norm,side_calf_norm, &
- sh_frac_dist_grad,pep_side
- integer i,j,k
+ pept_group,costhet_grad,cosphi_grad_long, &
+ cosphi_grad_loc,pep_side_norm,side_calf_norm, &
+ sh_frac_dist_grad,pep_side
+ integer i,j,k
!C write(2,*) "ivec",ivec_start,ivec_end
do i=1,nres
- fac_shield(i)=0.0d0
- ishield_list(i)=0
- do j=1,3
- grad_shield(j,i)=0.0d0
- enddo
+ fac_shield(i)=0.0d0
+ ishield_list(i)=0
+ do j=1,3
+ grad_shield(j,i)=0.0d0
+ enddo
enddo
do i=ivec_start,ivec_end
!C do i=1,nres-1
dist_pept_group=sqrt(dist_pept_group)
dist_side_calf=sqrt(dist_side_calf)
do j=1,3
- pep_side_norm(j)=pep_side(j)/dist_pep_side
- side_calf_norm(j)=dist_side_calf
+ pep_side_norm(j)=pep_side(j)/dist_pep_side
+ side_calf_norm(j)=dist_side_calf
enddo
!C now sscale fraction
sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
! print *,buff_shield,"buff",sh_frac_dist
!C now sscale
- if (sh_frac_dist.le.0.0) cycle
+ if (sh_frac_dist.le.0.0) cycle
!C print *,ishield_list(i),i
!C If we reach here it means that this side chain reaches the shielding sphere
!C Lets add him to the list for gradient
- ishield_list(i)=ishield_list(i)+1
+ ishield_list(i)=ishield_list(i)+1
!C ishield_list is a list of non 0 side-chain that contribute to factor gradient
!C this list is essential otherwise problem would be O3
- shield_list(ishield_list(i),i)=k
+ shield_list(ishield_list(i),i)=k
!C Lets have the sscale value
- if (sh_frac_dist.gt.1.0) then
- scale_fac_dist=1.0d0
- do j=1,3
- sh_frac_dist_grad(j)=0.0d0
- enddo
- else
- scale_fac_dist=-sh_frac_dist*sh_frac_dist &
- *(2.0d0*sh_frac_dist-3.0d0)
- fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
- /dist_pep_side/buff_shield*0.5d0
- do j=1,3
- sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
+ if (sh_frac_dist.gt.1.0) then
+ scale_fac_dist=1.0d0
+ do j=1,3
+ sh_frac_dist_grad(j)=0.0d0
+ enddo
+ else
+ scale_fac_dist=-sh_frac_dist*sh_frac_dist &
+ *(2.0d0*sh_frac_dist-3.0d0)
+ fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
+ /dist_pep_side/buff_shield*0.5d0
+ do j=1,3
+ sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
!C sh_frac_dist_grad(j)=0.0d0
!C scale_fac_dist=1.0d0
!C print *,"jestem",scale_fac_dist,fac_help_scale,
!C & sh_frac_dist_grad(j)
- enddo
- endif
+ enddo
+ endif
!C this is what is now we have the distance scaling now volume...
short=short_r_sidechain(itype(k,1))
long=long_r_sidechain(itype(k,1))
!C & -short/dist_pep_side**2/costhet)
!C costhet_fac=0.0d0
do j=1,3
- costhet_grad(j)=costhet_fac*pep_side(j)
+ costhet_grad(j)=costhet_fac*pep_side(j)
enddo
!C remember for the final gradient multiply costhet_grad(j)
!C for side_chain by factor -2 !
!C cosphi=0.6
cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
- dist_pep_side**2)
+ dist_pep_side**2)
!C sinphi=0.8
do j=1,3
- cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
+ cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
*(long-short)/fac_alfa_sin*cosalfa/ &
((dist_pep_side*dist_side_calf))* &
((side_calf(j))-cosalfa* &
((pep_side(j)/dist_pep_side)*dist_side_calf))
!C cosphi_grad_long(j)=0.0d0
- cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
+ cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
*(long-short)/fac_alfa_sin*cosalfa &
/((dist_pep_side*dist_side_calf))* &
(pep_side(j)- &
enddo
!C print *,sinphi,sinthet
VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
- /VSolvSphere_div
+ /VSolvSphere_div
!C & *wshield
!C now the gradient...
do j=1,3
grad_shield(j,i)=grad_shield(j,i) &
!C gradient po skalowaniu
- +(sh_frac_dist_grad(j)*VofOverlap &
+ +(sh_frac_dist_grad(j)*VofOverlap &
!C gradient po costhet
- +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
- (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
- sinphi/sinthet*costhet*costhet_grad(j) &
- +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
- )*wshield
+ +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
+ (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
+ sinphi/sinthet*costhet*costhet_grad(j) &
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
!C grad_shield_side is Cbeta sidechain gradient
grad_shield_side(j,ishield_list(i),i)=&
- (sh_frac_dist_grad(j)*-2.0d0&
- *VofOverlap&
- -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
+ (sh_frac_dist_grad(j)*-2.0d0&
+ *VofOverlap&
+ -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
- sinphi/sinthet*costhet*costhet_grad(j)&
- +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
- )*wshield
+ sinphi/sinthet*costhet*costhet_grad(j)&
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
! sinphi/sinthet,&
! +sinthet/sinphi,"HERE"
grad_shield_loc(j,ishield_list(i),i)= &
- scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
+ scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
- sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
- ))&
- *wshield
+ sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
+ ))&
+ *wshield
! print *,grad_shield_loc(j,ishield_list(i),i)
enddo
VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
character(len=80) :: controlcard
do i=1,dyn_nssHist
- call card_concat(controlcard,.true.)
- read(controlcard,*) &
- dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
+ call card_concat(controlcard,.true.)
+ read(controlcard,*) &
+ dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
enddo
return
!el
! get the position of the jth ijth fragment of the chain coordinate system
! in the fromto array.
- integer :: i,j
+ integer :: i,j
- indmat=((2*(nres-2)-i)*(i-1))/2+j-1
+ indmat=((2*(nres-2)-i)*(i-1))/2+j-1
return
end function indmat
!-----------------------------------------------------------------------------
real(kind=8) function sigm(x)
!el
real(kind=8) :: x
- sigm=0.25d0*x
+ sigm=0.25d0*x
return
end function sigm
!-----------------------------------------------------------------------------
integer :: i,j
if(nres.lt.100) then
- maxconts=nres
+ maxconts=10*nres
elseif(nres.lt.200) then
- maxconts=0.8*nres ! Max. number of contacts per residue
+ maxconts=10*nres ! Max. number of contacts per residue
else
- maxconts=0.6*nres ! (maxconts=maxres/4)
+ maxconts=10*nres ! (maxconts=maxres/4)
endif
- maxcont=12*nres ! Max. number of SC contacts
+ maxcont=100*nres ! Max. number of SC contacts
maxvar=6*nres ! Max. number of variables
!el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
allocate(gacontm_hb3(3,maxconts,nres))
allocate(gacont_hbr(3,maxconts,nres))
allocate(grij_hb_cont(3,maxconts,nres))
-!(3,maxconts,maxres)
+ !(3,maxconts,maxres)
allocate(facont_hb(maxconts,nres))
allocate(ees0p(maxconts,nres))
allocate(Ug2DtEUgder(2,2,2,nres))
allocate(DtUg2EUgder(2,2,2,nres))
!(2,2,2,maxres)
+ allocate(b1(2,nres)) !(2,-maxtor:maxtor)
+ allocate(b2(2,nres)) !(2,-maxtor:maxtor)
+ allocate(b1tilde(2,nres)) !(2,-maxtor:maxtor)
+ allocate(b2tilde(2,nres)) !(2,-maxtor:maxtor)
+
+ allocate(ctilde(2,2,nres))
+ allocate(dtilde(2,2,nres)) !(2,2,-maxtor:maxtor)
+ allocate(gtb1(2,nres))
+ allocate(gtb2(2,nres))
+ allocate(cc(2,2,nres))
+ allocate(dd(2,2,nres))
+ allocate(ee(2,2,nres))
+ allocate(gtcc(2,2,nres))
+ allocate(gtdd(2,2,nres))
+ allocate(gtee(2,2,nres))
+ allocate(gUb2(2,nres))
+ allocate(gteUg(2,2,nres))
+
! common /rotat_old/
allocate(costab(nres))
allocate(sintab(nres))
allocate(gradpepcat(3,-1:nres))
allocate(gradpepcatx(3,-1:nres))
allocate(gradcatcat(3,-1:nres))
+ allocate(gradnuclcat(3,-1:nres))
+ allocate(gradnuclcatx(3,-1:nres))
!(3,maxres)
allocate(grad_shield_side(3,maxcontsshi,-1:nres))
allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
allocate(dutheta(nres))
allocate(dugamma(nres))
!(maxres)
- allocate(duscdiff(3,nres))
- allocate(duscdiffx(3,nres))
+ allocate(duscdiff(3,-1:nres))
+ allocate(duscdiffx(3,-1:nres))
!(3,maxres)
!el i io:read_fragments
! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
! enddo
! if (nss.gt.0) then
- allocate(idssb(maxdim),jdssb(maxdim))
+ allocate(idssb(maxdim),jdssb(maxdim))
! allocate(newihpb(nss),newjhpb(nss))
!(maxdim)
! endif
allocate(uygrad(3,3,2,nres))
allocate(uzgrad(3,3,2,nres))
!(3,3,2,maxres)
+! allocateion of lists JPRDLA
+ allocate(newcontlistppi(300*nres))
+ allocate(newcontlistscpi(350*nres))
+ allocate(newcontlisti(300*nres))
+ allocate(newcontlistppj(300*nres))
+ allocate(newcontlistscpj(350*nres))
+ allocate(newcontlistj(300*nres))
return
end subroutine alloc_ener_arrays
write (iout,*) "ibondp_start,ibondp_end",&
ibondp_nucl_start,ibondp_nucl_end
do i=ibondp_nucl_start,ibondp_nucl_end
- if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
- itype(i,2).eq.ntyp1_molec(2)) cycle
+ if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
+ itype(i,2).eq.ntyp1_molec(2)) cycle
! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
! do j=1,3
! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
! & "estr1",i,vbld(i),distchainmax,
! & gnmr1(vbld(i),-1.0d0,distchainmax)
- diff = vbld(i)-vbldp0_nucl
- if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
- vbldp0_nucl,diff,AKP_nucl*diff*diff
- estr_nucl=estr_nucl+diff*diff
+ diff = vbld(i)-vbldp0_nucl
+ if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
+ vbldp0_nucl,diff,AKP_nucl*diff*diff
+ estr_nucl=estr_nucl+diff*diff
! print *,estr_nucl
- do j=1,3
- gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
- enddo
+ do j=1,3
+ gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
+ enddo
!c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
enddo
estr_nucl=0.5d0*AKP_nucl*estr_nucl
do i=ibond_nucl_start,ibond_nucl_end
!C print *, "I am stuck",i
- iti=itype(i,2)
- if (iti.eq.ntyp1_molec(2)) cycle
- nbi=nbondterm_nucl(iti)
+ iti=itype(i,2)
+ if (iti.eq.ntyp1_molec(2)) cycle
+ nbi=nbondterm_nucl(iti)
!C print *,iti,nbi
- if (nbi.eq.1) then
- diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
+ if (nbi.eq.1) then
+ diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
- if (energy_dec) &
- write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
- AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
- estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
+ if (energy_dec) &
+ write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
+ AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
+ estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
! print *,estr_nucl
- do j=1,3
- gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
- enddo
- else
- do j=1,nbi
- diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
- ud(j)=aksc_nucl(j,iti)*diff
- u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
- enddo
- uprod=u(1)
- do j=2,nbi
- uprod=uprod*u(j)
- enddo
- usum=0.0d0
- usumsqder=0.0d0
- do j=1,nbi
- uprod1=1.0d0
- uprod2=1.0d0
- do k=1,nbi
- if (k.ne.j) then
- uprod1=uprod1*u(k)
- uprod2=uprod2*u(k)*u(k)
- endif
- enddo
- usum=usum+uprod1
- usumsqder=usumsqder+ud(j)*uprod2
- enddo
- estr_nucl=estr_nucl+uprod/usum
- do j=1,3
- gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
+ do j=1,3
+ gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
+ enddo
+ else
+ do j=1,nbi
+ diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
+ ud(j)=aksc_nucl(j,iti)*diff
+ u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
+ enddo
+ uprod=u(1)
+ do j=2,nbi
+ uprod=uprod*u(j)
+ enddo
+ usum=0.0d0
+ usumsqder=0.0d0
+ do j=1,nbi
+ uprod1=1.0d0
+ uprod2=1.0d0
+ do k=1,nbi
+ if (k.ne.j) then
+ uprod1=uprod1*u(k)
+ uprod2=uprod2*u(k)*u(k)
+ endif
enddo
- endif
+ usum=usum+uprod1
+ usumsqder=usumsqder+ud(j)*uprod2
+ enddo
+ estr_nucl=estr_nucl+uprod/usum
+ do j=1,3
+ gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
+ enddo
+ endif
enddo
!C print *,"I am about to leave ebond"
return
etheta_nucl=0.0D0
! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
do i=ithet_nucl_start,ithet_nucl_end
- if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
- (itype(i-2,2).eq.ntyp1_molec(2)).or. &
- (itype(i,2).eq.ntyp1_molec(2))) cycle
- dethetai=0.0d0
- dephii=0.0d0
- dephii1=0.0d0
- theti2=0.5d0*theta(i)
- ityp2=ithetyp_nucl(itype(i-1,2))
- do k=1,nntheterm_nucl
- coskt(k)=dcos(k*theti2)
- sinkt(k)=dsin(k*theti2)
- enddo
- if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
+ if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
+ (itype(i-2,2).eq.ntyp1_molec(2)).or. &
+ (itype(i,2).eq.ntyp1_molec(2))) cycle
+ dethetai=0.0d0
+ dephii=0.0d0
+ dephii1=0.0d0
+ theti2=0.5d0*theta(i)
+ ityp2=ithetyp_nucl(itype(i-1,2))
+ do k=1,nntheterm_nucl
+ coskt(k)=dcos(k*theti2)
+ sinkt(k)=dsin(k*theti2)
+ enddo
+ if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
+ phii=phi(i)
+ if (phii.ne.phii) phii=150.0
#else
- phii=phi(i)
+ phii=phi(i)
#endif
- ityp1=ithetyp_nucl(itype(i-2,2))
- do k=1,nsingle_nucl
- cosph1(k)=dcos(k*phii)
- sinph1(k)=dsin(k*phii)
- enddo
- else
- phii=0.0d0
- ityp1=nthetyp_nucl+1
- do k=1,nsingle_nucl
- cosph1(k)=0.0d0
- sinph1(k)=0.0d0
- enddo
- endif
+ ityp1=ithetyp_nucl(itype(i-2,2))
+ do k=1,nsingle_nucl
+ cosph1(k)=dcos(k*phii)
+ sinph1(k)=dsin(k*phii)
+ enddo
+ else
+ phii=0.0d0
+ ityp1=nthetyp_nucl+1
+ do k=1,nsingle_nucl
+ cosph1(k)=0.0d0
+ sinph1(k)=0.0d0
+ enddo
+ endif
- if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
+ if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
+ phii1=phi(i+1)
+ if (phii1.ne.phii1) phii1=150.0
+ phii1=pinorm(phii1)
#else
- phii1=phi(i+1)
+ phii1=phi(i+1)
#endif
- ityp3=ithetyp_nucl(itype(i,2))
- do k=1,nsingle_nucl
- cosph2(k)=dcos(k*phii1)
- sinph2(k)=dsin(k*phii1)
- enddo
- else
- phii1=0.0d0
- ityp3=nthetyp_nucl+1
- do k=1,nsingle_nucl
- cosph2(k)=0.0d0
- sinph2(k)=0.0d0
- enddo
- endif
- ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
- do k=1,ndouble_nucl
- do l=1,k-1
- ccl=cosph1(l)*cosph2(k-l)
- ssl=sinph1(l)*sinph2(k-l)
- scl=sinph1(l)*cosph2(k-l)
- csl=cosph1(l)*sinph2(k-l)
- cosph1ph2(l,k)=ccl-ssl
- cosph1ph2(k,l)=ccl+ssl
- sinph1ph2(l,k)=scl+csl
- sinph1ph2(k,l)=scl-csl
- enddo
+ ityp3=ithetyp_nucl(itype(i,2))
+ do k=1,nsingle_nucl
+ cosph2(k)=dcos(k*phii1)
+ sinph2(k)=dsin(k*phii1)
enddo
- if (lprn) then
- write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
- " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
- write (iout,*) "coskt and sinkt",nntheterm_nucl
- do k=1,nntheterm_nucl
- write (iout,*) k,coskt(k),sinkt(k)
+ else
+ phii1=0.0d0
+ ityp3=nthetyp_nucl+1
+ do k=1,nsingle_nucl
+ cosph2(k)=0.0d0
+ sinph2(k)=0.0d0
enddo
- endif
- do k=1,ntheterm_nucl
- ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
- dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
- *coskt(k)
- if (lprn)&
- write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
- " ethetai",ethetai
+ endif
+ ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
+ do k=1,ndouble_nucl
+ do l=1,k-1
+ ccl=cosph1(l)*cosph2(k-l)
+ ssl=sinph1(l)*sinph2(k-l)
+ scl=sinph1(l)*cosph2(k-l)
+ csl=cosph1(l)*sinph2(k-l)
+ cosph1ph2(l,k)=ccl-ssl
+ cosph1ph2(k,l)=ccl+ssl
+ sinph1ph2(l,k)=scl+csl
+ sinph1ph2(k,l)=scl-csl
enddo
- if (lprn) then
- write (iout,*) "cosph and sinph"
+ enddo
+ if (lprn) then
+ write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
+ " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
+ write (iout,*) "coskt and sinkt",nntheterm_nucl
+ do k=1,nntheterm_nucl
+ write (iout,*) k,coskt(k),sinkt(k)
+ enddo
+ endif
+ do k=1,ntheterm_nucl
+ ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
+ dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
+ *coskt(k)
+ if (lprn)&
+ write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
+ " ethetai",ethetai
+ enddo
+ if (lprn) then
+ write (iout,*) "cosph and sinph"
+ do k=1,nsingle_nucl
+ write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
+ enddo
+ write (iout,*) "cosph1ph2 and sinph2ph2"
+ do k=2,ndouble_nucl
+ do l=1,k-1
+ write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
+ sinph1ph2(l,k),sinph1ph2(k,l)
+ enddo
+ enddo
+ write(iout,*) "ethetai",ethetai
+ endif
+ do m=1,ntheterm2_nucl
do k=1,nsingle_nucl
- write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
+ aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
+ +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
+ +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
+ +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+ ethetai=ethetai+sinkt(m)*aux
+ dethetai=dethetai+0.5d0*m*aux*coskt(m)
+ dephii=dephii+k*sinkt(m)*(&
+ ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
+ bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
+ dephii1=dephii1+k*sinkt(m)*(&
+ eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
+ ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
+ if (lprn) &
+ write (iout,*) "m",m," k",k," bbthet",&
+ bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
+ ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
+ ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
+ eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
enddo
- write (iout,*) "cosph1ph2 and sinph2ph2"
+ enddo
+ if (lprn) &
+ write(iout,*) "ethetai",ethetai
+ do m=1,ntheterm3_nucl
do k=2,ndouble_nucl
do l=1,k-1
- write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
- sinph1ph2(l,k),sinph1ph2(k,l)
- enddo
- enddo
- write(iout,*) "ethetai",ethetai
- endif
- do m=1,ntheterm2_nucl
- do k=1,nsingle_nucl
- aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
- +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
- +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
- +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+ aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*aux*coskt(m)
- dephii=dephii+k*sinkt(m)*(&
- ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
- bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
- dephii1=dephii1+k*sinkt(m)*(&
- eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
- ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
- if (lprn) &
- write (iout,*) "m",m," k",k," bbthet",&
- bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
- ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
- ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
- eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- enddo
- enddo
- if (lprn) &
- write(iout,*) "ethetai",ethetai
- do m=1,ntheterm3_nucl
- do k=2,ndouble_nucl
- do l=1,k-1
- aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*coskt(m)*aux
- dephii=dephii+l*sinkt(m)*(&
- -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- dephii1=dephii1+(k-l)*sinkt(m)*( &
- -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- if (lprn) then
- write (iout,*) "m",m," k",k," l",l," ffthet", &
- ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- write (iout,*) cosph1ph2(l,k)*sinkt(m), &
- cosph1ph2(k,l)*sinkt(m),&
- sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
- endif
- enddo
+ dethetai=dethetai+0.5d0*m*coskt(m)*aux
+ dephii=dephii+l*sinkt(m)*(&
+ -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ dephii1=dephii1+(k-l)*sinkt(m)*( &
+ -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ if (lprn) then
+ write (iout,*) "m",m," k",k," l",l," ffthet", &
+ ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
+ write (iout,*) cosph1ph2(l,k)*sinkt(m), &
+ cosph1ph2(k,l)*sinkt(m),&
+ sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
+ endif
enddo
enddo
+ enddo
10 continue
- if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
- i,theta(i)*rad2deg,phii*rad2deg, &
- phii1*rad2deg,ethetai
- etheta_nucl=etheta_nucl+ethetai
+ if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
+ i,theta(i)*rad2deg,phii*rad2deg, &
+ phii1*rad2deg,ethetai
+ etheta_nucl=etheta_nucl+ethetai
! print *,i,"partial sum",etheta_nucl
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
- gloc(nphi+i-2,icg)=wang_nucl*dethetai
+ if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
+ if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
+ gloc(nphi+i-2,icg)=wang_nucl*dethetai
enddo
return
end subroutine ebend_nucl
!el local variables
integer :: i,j,iblock,itori,itori1
real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
- vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
+ vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
! Set lprn=.true. for debugging
lprn=.false.
! lprn=.true.
etors_nucl=0.0D0
! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
do i=iphi_nucl_start,iphi_nucl_end
- if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
- .or. itype(i-3,2).eq.ntyp1_molec(2) &
- .or. itype(i,2).eq.ntyp1_molec(2)) cycle
- etors_ii=0.0D0
- itori=itortyp_nucl(itype(i-2,2))
- itori1=itortyp_nucl(itype(i-1,2))
- phii=phi(i)
+ if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
+ .or. itype(i-3,2).eq.ntyp1_molec(2) &
+ .or. itype(i,2).eq.ntyp1_molec(2)) cycle
+ etors_ii=0.0D0
+ itori=itortyp_nucl(itype(i-2,2))
+ itori1=itortyp_nucl(itype(i-1,2))
+ phii=phi(i)
! print *,i,itori,itori1
- gloci=0.0D0
+ gloci=0.0D0
!C Regular cosine and sine terms
- do j=1,nterm_nucl(itori,itori1)
- v1ij=v1_nucl(j,itori,itori1)
- v2ij=v2_nucl(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
- if (energy_dec) etors_ii=etors_ii+&
- v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
+ do j=1,nterm_nucl(itori,itori1)
+ v1ij=v1_nucl(j,itori,itori1)
+ v2ij=v2_nucl(j,itori,itori1)
+ cosphi=dcos(j*phii)
+ sinphi=dsin(j*phii)
+ etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
+ if (energy_dec) etors_ii=etors_ii+&
+ v1ij*cosphi+v2ij*sinphi
+ gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
+ enddo
!C Lorentz terms
!C v1
!C E = SUM ----------------------------------- - v1
!C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
!C
- cosphi=dcos(0.5d0*phii)
- sinphi=dsin(0.5d0*phii)
- do j=1,nlor_nucl(itori,itori1)
- vl1ij=vlor1_nucl(j,itori,itori1)
- vl2ij=vlor2_nucl(j,itori,itori1)
- vl3ij=vlor3_nucl(j,itori,itori1)
- pom=vl2ij*cosphi+vl3ij*sinphi
- pom1=1.0d0/(pom*pom+1.0d0)
- etors_nucl=etors_nucl+vl1ij*pom1
- if (energy_dec) etors_ii=etors_ii+ &
- vl1ij*pom1
- pom=-pom*pom1*pom1
- gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
- enddo
+ cosphi=dcos(0.5d0*phii)
+ sinphi=dsin(0.5d0*phii)
+ do j=1,nlor_nucl(itori,itori1)
+ vl1ij=vlor1_nucl(j,itori,itori1)
+ vl2ij=vlor2_nucl(j,itori,itori1)
+ vl3ij=vlor3_nucl(j,itori,itori1)
+ pom=vl2ij*cosphi+vl3ij*sinphi
+ pom1=1.0d0/(pom*pom+1.0d0)
+ etors_nucl=etors_nucl+vl1ij*pom1
+ if (energy_dec) etors_ii=etors_ii+ &
+ vl1ij*pom1
+ pom=-pom*pom1*pom1
+ gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
+ enddo
!C Subtract the constant term
- etors_nucl=etors_nucl-v0_nucl(itori,itori1)
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
- 'etor',i,etors_ii-v0_nucl(itori,itori1)
- if (lprn) &
+ etors_nucl=etors_nucl-v0_nucl(itori,itori1)
+ if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
+ 'etor',i,etors_ii-v0_nucl(itori,itori1)
+ if (lprn) &
write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
(v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
- gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
+ gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
!c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
return
!C the orientation of the CA-CA virtual bonds.
!C
integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
- real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
+ real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbbi,sslipi,ssgradlipi, &
+ sslipj,ssgradlipj,faclipij2
real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
- dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
- dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
+ dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
+ dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,sss_grad,fac,evdw1ij
+ dist_temp, dist_init,sss_grad,fac,evdw1ij
integer xshift,yshift,zshift
real(kind=8),dimension(3):: ggg,gggp,gggm,erij
real(kind=8) :: ees,eesij
!c
! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
do i=iatel_s_nucl,iatel_e_nucl
- if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
-
- do j=ielstart_nucl(i),ielend_nucl(i)
- if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
- ind=ind+1
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
+ if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+
+ do j=ielstart_nucl(i),ielend_nucl(i)
+ if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
+ ind=ind+1
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
! xj=c(1,j)+0.5D0*dxj-xmedi
! yj=c(2,j)+0.5D0*dyj-ymedi
! zj=c(3,j)+0.5D0*dzj-zmedi
- 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
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- 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
-!C print *,i,j
- 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
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ rij=xj*xj+yj*yj+zj*zj
!c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
- fac=(r0pp**2/rij)**3
- ev1=epspp*fac*fac
- ev2=epspp*fac
- evdw1ij=ev1-2*ev2
- fac=(-ev1-evdw1ij)/rij
+ fac=(r0pp**2/rij)**3
+ ev1=epspp*fac*fac
+ ev2=epspp*fac
+ evdw1ij=ev1-2*ev2
+ fac=(-ev1-evdw1ij)/rij
! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
- if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
- evdw1=evdw1+evdw1ij
+ if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
+ evdw1=evdw1+evdw1ij
!C
!C Calculate contributions to the Cartesian gradient.
!C
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
- do k=1,3
- gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
- gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
- enddo
+ ggg(1)=fac*xj
+ ggg(2)=fac*yj
+ ggg(3)=fac*zj
+ do k=1,3
+ gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
+ gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
+ enddo
!c phoshate-phosphate electrostatic interactions
- rij=dsqrt(rij)
- fac=1.0d0/rij
- eesij=dexp(-BEES*rij)*fac
+ rij=dsqrt(rij)
+ fac=1.0d0/rij
+ eesij=dexp(-BEES*rij)*fac
! write (2,*)"fac",fac," eesijpp",eesij
- if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
- ees=ees+eesij
+ if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
+ ees=ees+eesij
!c fac=-eesij*fac
- fac=-(fac+BEES)*eesij*fac
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
+ fac=-(fac+BEES)*eesij*fac
+ ggg(1)=fac*xj
+ ggg(2)=fac*yj
+ ggg(3)=fac*zj
!c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
!c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
!c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
- do k=1,3
- gelpp(k,i)=gelpp(k,i)-ggg(k)
- gelpp(k,j)=gelpp(k,j)+ggg(k)
- enddo
- enddo ! j
+ do k=1,3
+ gelpp(k,i)=gelpp(k,i)-ggg(k)
+ gelpp(k,j)=gelpp(k,j)+ggg(k)
+ enddo
+ enddo ! j
enddo ! i
!c ees=332.0d0*ees
ees=AEES*ees
do i=nnt,nct
!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
- do k=1,3
- gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
+ do k=1,3
+ gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
!c gelpp(k,i)=332.0d0*gelpp(k,i)
- gelpp(k,i)=AEES*gelpp(k,i)
- enddo
+ gelpp(k,i)=AEES*gelpp(k,i)
+ enddo
!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
enddo
!c write (2,*) "total EES",ees
real(kind=8),dimension(3):: ggg
integer :: i,iint,j,k,iteli,itypj,subchap
real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
- e1,e2,evdwij,rij,evdwpsb,eelpsb
+ e1,e2,evdwij,rij,evdwpsb,eelpsb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init
+ dist_temp, dist_init
integer xshift,yshift,zshift
!cd print '(a)','Enter ESCP'
evdwpsb=0.0d0
! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
do i=iatscp_s_nucl,iatscp_e_nucl
- if (itype(i,2).eq.ntyp1_molec(2) &
- .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
- 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
-
- do iint=1,nscp_gr_nucl(i)
-
- do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
- itypj=itype(j,2)
- if (itypj.eq.ntyp1_molec(2)) cycle
+ if (itype(i,2).eq.ntyp1_molec(2) &
+ .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
+ 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))
+ call to_box(xi,yi,zi)
+
+ do iint=1,nscp_gr_nucl(i)
+
+ do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
+ itypj=itype(j,2)
+ if (itypj.eq.ntyp1_molec(2)) cycle
!C Uncomment following three lines for SC-p interactions
!c xj=c(1,nres+j)-xi
!c yj=c(2,nres+j)-yi
! xj=c(1,j)-xi
! yj=c(2,j)-yi
! zj=c(3,j)-zi
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,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
- 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
-
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac=rrij**expon2
- e1=fac*fac*aad_nucl(itypj)
- e2=fac*bad_nucl(itypj)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- endif
- evdwij=e1+e2
- evdwpsb=evdwpsb+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
- 'evdw2',i,j,evdwij,"tu4"
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=xj**2+yj**2+zj**2
+
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ fac=rrij**expon2
+ e1=fac*fac*aad_nucl(itypj)
+ e2=fac*bad_nucl(itypj)
+ if (iabs(j-i) .le. 2) then
+ e1=scal14*e1
+ e2=scal14*e2
+ endif
+ evdwij=e1+e2
+ evdwpsb=evdwpsb+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
+ 'evdw2',i,j,evdwij,"tu4"
!C
!C Calculate contributions to the gradient in the virtual-bond and SC vectors.
!C
- fac=-(evdwij+e1)*rrij
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
- do k=1,3
- gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
- gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
- enddo
+ fac=-(evdwij+e1)*rrij
+ ggg(1)=xj*fac
+ ggg(2)=yj*fac
+ ggg(3)=zj*fac
+ do k=1,3
+ gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
+ gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
enddo
+ enddo
- enddo ! iint
+ enddo ! iint
enddo ! i
do i=1,nct
- do j=1,3
- gvdwpsb(j,i)=expon*gvdwpsb(j,i)
- gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
- enddo
+ do j=1,3
+ gvdwpsb(j,i)=expon*gvdwpsb(j,i)
+ gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
+ enddo
enddo
return
end subroutine epsb
real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,faclip,sig0ij
+ dist_temp, dist_init,aa,bb,faclip,sig0ij
integer :: ii
logical lprn
evdw=0.0D0
ind=0
! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
do i=iatsc_s_nucl,iatsc_e_nucl
- num_conti=0
- num_conti2=0
- itypi=itype(i,2)
+ num_conti=0
+ num_conti2=0
+ itypi=itype(i,2)
! PRINT *,"I=",i,itypi
- if (itypi.eq.ntyp1_molec(2)) cycle
- itypi1=itype(i+1,2)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=vbld_inv(i+nres)
+ if (itypi.eq.ntyp1_molec(2)) cycle
+ itypi1=itype(i+1,2)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
!C
!C Calculate SC interaction energy.
!C
- do iint=1,nint_gr_nucl(i)
+ do iint=1,nint_gr_nucl(i)
! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
- do j=istart_nucl(i,iint),iend_nucl(i,iint)
- ind=ind+1
+ do j=istart_nucl(i,iint),iend_nucl(i,iint)
+ ind=ind+1
! print *,"JESTEM"
- itypj=itype(j,2)
- if (itypj.eq.ntyp1_molec(2)) cycle
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma_nucl(itypi,itypj)
- chi1=chi_nucl(itypi,itypj)
- chi2=chi_nucl(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip_nucl(itypi,itypj)
- chip2=chip_nucl(itypj,itypi)
- chip12=chip1*chip2
+ itypj=itype(j,2)
+ if (itypj.eq.ntyp1_molec(2)) cycle
+ dscj_inv=vbld_inv(j+nres)
+ sig0ij=sigma_nucl(itypi,itypj)
+ chi1=chi_nucl(itypi,itypj)
+ chi2=chi_nucl(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip_nucl(itypi,itypj)
+ chip2=chip_nucl(itypj,itypi)
+ chip12=chip1*chip2
! xj=c(1,nres+j)-xi
! yj=c(2,nres+j)-yi
! zj=c(3,nres+j)-zi
- xj=c(1,nres+j)
- yj=c(2,nres+j)
- zj=c(3,nres+j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- 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)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
!C Calculate angle-dependent terms of energy and contributions to their
!C derivatives.
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- call sc_angular_nucl
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
+ erij(1)=xj*rij
+ erij(2)=yj*rij
+ erij(3)=zj*rij
+ om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
+ om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
+ om12=dxi*dxj+dyi*dyj+dzi*dzj
+ call sc_angular_nucl
+ sigsq=1.0D0/sigsq
+ sig=sig0ij*dsqrt(sigsq)
+ rij_shift=1.0D0/rij-sig+sig0ij
! print *,rij_shift,"rij_shift"
!c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
!c & " rij_shift",rij_shift
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
+ if (rij_shift.le.0.0D0) then
+ evdw=1.0D20
+ return
+ endif
+ sigder=-sig*sigsq
!c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa_nucl(itypi,itypj)
- e2=fac*bb_nucl(itypi,itypj)
- evdwij=eps1*eps2rt*(e1+e2)
+ rij_shift=1.0D0/rij_shift
+ fac=rij_shift**expon
+ e1=fac*fac*aa_nucl(itypi,itypj)
+ e2=fac*bb_nucl(itypi,itypj)
+ evdwij=eps1*eps2rt*(e1+e2)
!c write (2,*) "eps1",eps1," eps2rt",eps2rt,
!c & " e1",e1," e2",e2," evdwij",evdwij
- eps2der=evdwij
- evdwij=evdwij*eps2rt
- evdwsb=evdwsb+evdwij
- if (lprn) then
- sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi,2),i,restyp(itypj,2),j, &
- epsi,sigm,chi1,chi2,chip1,chip2, &
- eps1,eps2rt**2,sig,sig0ij, &
- om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
- evdwij
- write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
- endif
+ eps2der=evdwij
+ evdwij=evdwij*eps2rt
+ evdwsb=evdwsb+evdwij
+ if (lprn) then
+ sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
+ write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
+ restyp(itypi,2),i,restyp(itypj,2),j, &
+ epsi,sigm,chi1,chi2,chip1,chip2, &
+ eps1,eps2rt**2,sig,sig0ij, &
+ om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
+ evdwij
+ write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
+ endif
- if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
- 'evdw',i,j,evdwij,"tu3"
+ if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
+ 'evdw',i,j,evdwij,"tu3"
!C Calculate gradient components.
- e1=e1*eps1*eps2rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
+ e1=e1*eps1*eps2rt**2
+ fac=-expon*(e1+evdwij)*rij_shift
+ sigder=fac*sigder
+ fac=rij*fac
!c fac=0.0d0
!C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
!C Calculate angular part of the gradient.
- call sc_grad_nucl
- call eelsbij(eelij,num_conti2)
- if (energy_dec .and. &
- (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
- write (istat,'(e14.5)') evdwij
- eelsb=eelsb+eelij
- enddo ! j
- enddo ! iint
- num_cont_hb(i)=num_conti2
+ call sc_grad_nucl
+ call eelsbij(eelij,num_conti2)
+ if (energy_dec .and. &
+ (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
+ write (istat,'(e14.5)') evdwij
+ eelsb=eelsb+eelij
+ enddo ! j
+ enddo ! iint
+ num_cont_hb(i)=num_conti2
enddo ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!cccc energy_dec=.false.
real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,rlocshield,fracinbuf
+ dist_temp, dist_init,rlocshield,fracinbuf
integer xshift,yshift,zshift,ilist,iresshield,num_conti2
!c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
real(kind=8) :: dx_normj,dy_normj,dz_normj,&
- r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
- el1,el2,el3,el4,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,itypi,itypj
+ r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
+ el1,el2,el3,el4,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,itypi,itypj
ind=ind+1
itypi=itype(i,2)
itypj=itype(j,2)
!c yj=c(2,j)+0.5D0*dyj-ymedi
!c zj=c(3,j)+0.5D0*dzj-zmedi
if (ipot_nucl.ne.2) then
- 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
+ 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
else
- cosa=om12
- cosb=om1
- cosg=om2
+ cosa=om12
+ cosb=om1
+ cosg=om2
endif
r3ij=rij*rrij
r6ij=r3ij*r3ij
ees0ij=4.0D0+facfac-fac1
if (energy_dec) then
- if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
- write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
- sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
- restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
- (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
- write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
+ if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
+ write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
+ sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
+ restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
+ (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
+ write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
endif
!C
ggg(2)=facel*yj
ggg(3)=facel*zj
do k=1,3
- gelsbc(k,j)=gelsbc(k,j)+ggg(k)
- gelsbc(k,i)=gelsbc(k,i)-ggg(k)
- gelsbx(k,j)=gelsbx(k,j)+ggg(k)
- gelsbx(k,i)=gelsbx(k,i)-ggg(k)
+ gelsbc(k,j)=gelsbc(k,j)+ggg(k)
+ gelsbc(k,i)=gelsbc(k,i)-ggg(k)
+ gelsbx(k,j)=gelsbx(k,j)+ggg(k)
+ gelsbx(k,i)=gelsbx(k,i)-ggg(k)
enddo
!*
!* Angular part
ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
fac6*fac1*cosb
do k=1,3
- dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
- dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
+ dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
+ dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
enddo
do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
+ ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
enddo
do k=1,3
- gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
- +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
- + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
- gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
- +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
- + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
- gelsbc(k,j)=gelsbc(k,j)+ggg(k)
- gelsbc(k,i)=gelsbc(k,i)-ggg(k)
+ gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
+ +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
+ + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
+ gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
+ +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
+ + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
+ gelsbc(k,j)=gelsbc(k,j)+ggg(k)
+ gelsbc(k,i)=gelsbc(k,i)-ggg(k)
enddo
! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
IF ( j.gt.i+1 .and.&
- num_conti.le.maxconts) THEN
+ num_conti.le.maxcont) THEN
!C
!C Calculate the contact function. The ith column of the array JCONT will
!C contain the numbers of atoms that make contacts with the atom I (of numbers
!C greater than I). The arrays FACONT and GACONT will contain the values of
!C the contact function and its derivative.
- r0ij=2.20D0*sigma(itypi,itypj)
+ r0ij=2.20D0*sigma_nucl(itypi,itypj)
!c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
- call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
+ call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
!c write (2,*) "fcont",fcont
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- num_conti2=num_conti2+1
+ if (fcont.gt.0.0D0) then
+ num_conti=num_conti+1
+ num_conti2=num_conti2+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',&
- ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
+ if (num_conti.gt.maxconts) then
+ write (iout,*) 'WARNING - max. # of contacts exceeded;',&
+ ' will skip next contacts for this conf.',maxconts
+ else
+ jcont_hb(num_conti,i)=j
!c write (iout,*) "num_conti",num_conti,
!c & " jcont_hb",jcont_hb(num_conti,i)
!C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
- fac3=dsqrt(-ael6i)*r3ij
+ cosa4=4.0D0*cosa
+ wij=cosa-3.0D0*cosb*cosg
+ cosbg1=cosb+cosg
+ cosbg2=cosb-cosg
+ fac3=dsqrt(-ael6i)*r3ij
!c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
+ ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
+ if (ees0tmp.gt.0) then
+ ees0pij=dsqrt(ees0tmp)
+ else
+ ees0pij=0
+ endif
+ ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
+ if (ees0tmp.gt.0) then
+ ees0mij=dsqrt(ees0tmp)
+ else
+ ees0mij=0
+ endif
+ ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
+ ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
!c write (iout,*) "i",i," j",j,
!c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
- 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*rrij
+ ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
+ ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
+ 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 End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
- 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
+ facont_hb(num_conti,i)=fcont
+ fprimcont=fprimcont/rij
+ do k=1,3
+ gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
+ gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
+ enddo
+ gggp(1)=gggp(1)+ees0pijp*xj
+ gggp(2)=gggp(2)+ees0pijp*yj
+ gggp(3)=gggp(3)+ees0pijp*zj
+ gggm(1)=gggm(1)+ees0mijp*xj
+ gggm(2)=gggm(2)+ees0mijp*yj
+ gggm(3)=gggm(3)+ees0mijp*zj
!C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
+ 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 Gradient of the correlation terms
!c
- gacontp_hb1(k,num_conti,i)= &
- (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
- + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
- gacontp_hb2(k,num_conti,i)= &
- (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
- + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)= &
- (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
- + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
- gacontm_hb2(k,num_conti,i)= &
- (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
- + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- enddo
- endif
+ gacontp_hb1(k,num_conti,i)= &
+ (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
+ + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
+ gacontp_hb2(k,num_conti,i)= &
+ (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
+ + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
+ gacontp_hb3(k,num_conti,i)=gggp(k)
+ gacontm_hb1(k,num_conti,i)= &
+ (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
+ + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
+ gacontm_hb2(k,num_conti,i)= &
+ (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
+ + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
+ gacontm_hb3(k,num_conti,i)=gggm(k)
+ enddo
endif
+ endif
ENDIF
return
end subroutine eelsbij
eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
+ dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+ dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
enddo
do k=1,3
- gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
enddo
do k=1,3
- gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
+ +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
!C
!C Calculate the components of the gradient in DC and X
!C
do l=1,3
- gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
- gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
+ gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
+ gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
enddo
return
end subroutine sc_grad_nucl
delta=0.02d0*pi
esbloc=0.0D0
do i=loc_start_nucl,loc_end_nucl
- if (itype(i,2).eq.ntyp1_molec(2)) cycle
- costtab(i+1) =dcos(theta(i+1))
- sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
- cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
- sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
- cosfac2=0.5d0/(1.0d0+costtab(i+1))
- cosfac=dsqrt(cosfac2)
- sinfac2=0.5d0/(1.0d0-costtab(i+1))
- sinfac=dsqrt(sinfac2)
- it=itype(i,2)
- if (it.eq.10) goto 1
+ if (itype(i,2).eq.ntyp1_molec(2)) cycle
+ costtab(i+1) =dcos(theta(i+1))
+ sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
+ cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
+ sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
+ cosfac2=0.5d0/(1.0d0+costtab(i+1))
+ cosfac=dsqrt(cosfac2)
+ sinfac2=0.5d0/(1.0d0-costtab(i+1))
+ sinfac=dsqrt(sinfac2)
+ it=itype(i,2)
+ if (it.eq.10) goto 1
!c
!C Compute the axes of tghe local cartesian coordinates system; store in
!c x_prime, y_prime and z_prime
!c
- do j=1,3
- x_prime(j) = 0.00
- y_prime(j) = 0.00
- z_prime(j) = 0.00
- enddo
+ do j=1,3
+ x_prime(j) = 0.00
+ y_prime(j) = 0.00
+ z_prime(j) = 0.00
+ enddo
!C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
!C & dc_norm(3,i+nres)
- do j = 1,3
- x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
- y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
- enddo
- do j = 1,3
- z_prime(j) = -uz(j,i-1)
+ do j = 1,3
+ x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
+ y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
+ enddo
+ do j = 1,3
+ z_prime(j) = -uz(j,i-1)
! z_prime(j)=0.0
- enddo
+ enddo
- xx=0.0d0
- yy=0.0d0
- zz=0.0d0
- do j = 1,3
- xx = xx + x_prime(j)*dc_norm(j,i+nres)
- yy = yy + y_prime(j)*dc_norm(j,i+nres)
- zz = zz + z_prime(j)*dc_norm(j,i+nres)
- enddo
+ xx=0.0d0
+ yy=0.0d0
+ zz=0.0d0
+ do j = 1,3
+ xx = xx + x_prime(j)*dc_norm(j,i+nres)
+ yy = yy + y_prime(j)*dc_norm(j,i+nres)
+ zz = zz + z_prime(j)*dc_norm(j,i+nres)
+ enddo
- xxtab(i)=xx
- yytab(i)=yy
- zztab(i)=zz
- it=itype(i,2)
- do j = 1,9
- x(j) = sc_parmin_nucl(j,it)
- enddo
+ xxtab(i)=xx
+ yytab(i)=yy
+ zztab(i)=zz
+ it=itype(i,2)
+ do j = 1,9
+ x(j) = sc_parmin_nucl(j,it)
+ enddo
#ifdef CHECK_COORD
!Cc diagnostics - remove later
- xx1 = dcos(alph(2))
- yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsin(alph(2))*dsin(omeg(2))
- write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
- alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
- xx1,yy1,zz1
+ xx1 = dcos(alph(2))
+ yy1 = dsin(alph(2))*dcos(omeg(2))
+ zz1 = -dsin(alph(2))*dsin(omeg(2))
+ write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
+ alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
+ xx1,yy1,zz1
!C," --- ", xx_w,yy_w,zz_w
!c end diagnostics
#endif
- sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- esbloc = esbloc + sumene
- sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
+ sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ esbloc = esbloc + sumene
+ sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
! print *,"enecomp",sumene,sumene2
! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
#ifdef DEBUG
- write (2,*) "x",(x(k),k=1,9)
+ write (2,*) "x",(x(k),k=1,9)
!C
!C This section to check the numerical derivatives of the energy of ith side
!C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
!C #define DEBUG in the code to turn it on.
!C
- write (2,*) "sumene =",sumene
- aincr=1.0d-7
- xxsave=xx
- xx=xx+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dxx_num=(sumenep-sumene)/aincr
- xx=xxsave
- write (2,*) "xx+ sumene from enesc=",sumenep,sumene
- yysave=yy
- yy=yy+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dyy_num=(sumenep-sumene)/aincr
- yy=yysave
- write (2,*) "yy+ sumene from enesc=",sumenep,sumene
- zzsave=zz
- zz=zz+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dzz_num=(sumenep-sumene)/aincr
- zz=zzsave
- write (2,*) "zz+ sumene from enesc=",sumenep,sumene
- costsave=cost2tab(i+1)
- sintsave=sint2tab(i+1)
- cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
- sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dt_num=(sumenep-sumene)/aincr
- write (2,*) " t+ sumene from enesc=",sumenep,sumene
- cost2tab(i+1)=costsave
- sint2tab(i+1)=sintsave
+ write (2,*) "sumene =",sumene
+ aincr=1.0d-7
+ xxsave=xx
+ xx=xx+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dxx_num=(sumenep-sumene)/aincr
+ xx=xxsave
+ write (2,*) "xx+ sumene from enesc=",sumenep,sumene
+ yysave=yy
+ yy=yy+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dyy_num=(sumenep-sumene)/aincr
+ yy=yysave
+ write (2,*) "yy+ sumene from enesc=",sumenep,sumene
+ zzsave=zz
+ zz=zz+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dzz_num=(sumenep-sumene)/aincr
+ zz=zzsave
+ write (2,*) "zz+ sumene from enesc=",sumenep,sumene
+ costsave=cost2tab(i+1)
+ sintsave=sint2tab(i+1)
+ cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
+ sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dt_num=(sumenep-sumene)/aincr
+ write (2,*) " t+ sumene from enesc=",sumenep,sumene
+ cost2tab(i+1)=costsave
+ sint2tab(i+1)=sintsave
!C End of diagnostics section.
#endif
!C
!C Compute the gradient of esc
!C
- de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
- de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
- de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
- de_dtt=0.0d0
+ de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
+ de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
+ de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
+ de_dtt=0.0d0
#ifdef DEBUG
- write (2,*) "x",(x(k),k=1,9)
- write (2,*) "xx",xx," yy",yy," zz",zz
- write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
- " de_zz ",de_zz," de_tt ",de_tt
- write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
- " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
+ write (2,*) "x",(x(k),k=1,9)
+ write (2,*) "xx",xx," yy",yy," zz",zz
+ write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
+ " de_zz ",de_zz," de_tt ",de_tt
+ write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
+ " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
#endif
!C
cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
cosfac2xx=cosfac2*xx
sinfac2yy=sinfac2*yy
do k = 1,3
- dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
- vbld_inv(i+1)
- dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
- vbld_inv(i)
- pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
- pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
+ dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
+ vbld_inv(i+1)
+ dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
+ vbld_inv(i)
+ pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
+ pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
!c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
!c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
!c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
!c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
- dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
- dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
- dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
- dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
- dZZ_Ci1(k)=0.0d0
- dZZ_Ci(k)=0.0d0
- do j=1,3
- dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
- dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
- enddo
+ dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
+ dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
+ dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
+ dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
+ dZZ_Ci1(k)=0.0d0
+ dZZ_Ci(k)=0.0d0
+ do j=1,3
+ dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
+ dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
+ enddo
- dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
- dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
- dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
+ dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
+ dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
+ dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
!c
- dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
- dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
+ dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
+ dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
enddo
do k=1,3
- dXX_Ctab(k,i)=dXX_Ci(k)
- dXX_C1tab(k,i)=dXX_Ci1(k)
- dYY_Ctab(k,i)=dYY_Ci(k)
- dYY_C1tab(k,i)=dYY_Ci1(k)
- dZZ_Ctab(k,i)=dZZ_Ci(k)
- dZZ_C1tab(k,i)=dZZ_Ci1(k)
- dXX_XYZtab(k,i)=dXX_XYZ(k)
- dYY_XYZtab(k,i)=dYY_XYZ(k)
- dZZ_XYZtab(k,i)=dZZ_XYZ(k)
+ dXX_Ctab(k,i)=dXX_Ci(k)
+ dXX_C1tab(k,i)=dXX_Ci1(k)
+ dYY_Ctab(k,i)=dYY_Ci(k)
+ dYY_C1tab(k,i)=dYY_Ci1(k)
+ dZZ_Ctab(k,i)=dZZ_Ci(k)
+ dZZ_C1tab(k,i)=dZZ_Ci1(k)
+ dXX_XYZtab(k,i)=dXX_XYZ(k)
+ dYY_XYZtab(k,i)=dYY_XYZ(k)
+ dZZ_XYZtab(k,i)=dZZ_XYZ(k)
enddo
do k = 1,3
!c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
!c & dt_dci(k)
!c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
!c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
- gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
- +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
- gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
- +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
- gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
- +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
+ gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
+ +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
+ gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
+ +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
+ gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
+ +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
enddo
!c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
!c write (2,*) "x",(x(i),i=1,9)
!c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
- + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
- + x(9)*yy*zz
+ + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
+ + x(9)*yy*zz
enesc_nucl=sumene
return
end function enesc_nucl
if (nfgtasks.le.1) goto 30
if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-1
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
- j=1,num_cont_hb(i))
- enddo
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt,nct-1
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
+ j=1,num_cont_hb(i))
+ enddo
endif
!C Caution! Following code assumes that electrostatic interactions concerning
!C a given atom are split among at most two processors!
CorrelID=fg_rank+1
ldone=.false.
do i=1,max_cont
- do j=1,max_dim
- buffer(i,j)=0.0D0
- enddo
+ do j=1,max_dim
+ buffer(i,j)=0.0D0
+ enddo
enddo
mm=mod(fg_rank,2)
!c write (*,*) 'MyRank',MyRank,' mm',mm
!c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
if (fg_rank.gt.0) then
!C Send correlation contributions to the preceding processor
- msglen=msglen1
- nn=num_cont_hb(iatel_s_nucl)
- call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
+ msglen=msglen1
+ nn=num_cont_hb(iatel_s_nucl)
+ call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
!c write (*,*) 'The BUFFER array:'
!c do i=1,nn
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
!c enddo
- if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
- msglen=msglen2
- call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
+ if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
+ msglen=msglen2
+ call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
!C Clear the contacts of the atom passed to the neighboring processor
- nn=num_cont_hb(iatel_s_nucl+1)
+ nn=num_cont_hb(iatel_s_nucl+1)
!c do i=1,nn
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
!c enddo
- num_cont_hb(iatel_s_nucl)=0
- endif
+ num_cont_hb(iatel_s_nucl)=0
+ endif
!cd write (iout,*) 'Processor ',fg_rank,MyRank,
!cd & ' is sending correlation contribution to processor',fg_rank-1,
!cd & ' msglen=',msglen
!c write (*,*) 'Processor ',fg_rank,MyRank,
!c & ' is sending correlation contribution to processor',fg_rank-1,
!c & ' msglen=',msglen,' CorrelType=',CorrelType
- time00=MPI_Wtime()
- call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
- CorrelType,FG_COMM,IERROR)
- time_sendrecv=time_sendrecv+MPI_Wtime()-time00
+ time00=MPI_Wtime()
+ call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
+ CorrelType,FG_COMM,IERROR)
+ time_sendrecv=time_sendrecv+MPI_Wtime()-time00
!cd write (iout,*) 'Processor ',fg_rank,
!cd & ' has sent correlation contribution to processor',fg_rank-1,
!cd & ' msglen=',msglen,' CorrelID=',CorrelID
!c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
if (fg_rank.lt.nfgtasks-1) then
!C Receive correlation contributions from the next processor
- msglen=msglen1
- if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
+ msglen=msglen1
+ if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
!cd write (iout,*) 'Processor',fg_rank,
!cd & ' is receiving correlation contribution from processor',fg_rank+1,
!cd & ' msglen=',msglen,' CorrelType=',CorrelType
!c write (*,*) 'Processor',fg_rank,
!c &' is receiving correlation contribution from processor',fg_rank+1,
!c & ' msglen=',msglen,' CorrelType=',CorrelType
- time00=MPI_Wtime()
- nbytes=-1
- do while (nbytes.le.0)
- call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
- call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
- enddo
+ time00=MPI_Wtime()
+ nbytes=-1
+ do while (nbytes.le.0)
+ call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
+ call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
+ enddo
!c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
- call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
- fg_rank+1,CorrelType,FG_COMM,status,IERROR)
- time_sendrecv=time_sendrecv+MPI_Wtime()-time00
+ call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
+ fg_rank+1,CorrelType,FG_COMM,status,IERROR)
+ time_sendrecv=time_sendrecv+MPI_Wtime()-time00
!c write (*,*) 'Processor',fg_rank,
!c &' has received correlation contribution from processor',fg_rank+1,
!c & ' msglen=',msglen,' nbytes=',nbytes
!c do i=1,max_cont
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
!c enddo
- if (msglen.eq.msglen1) then
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
- else if (msglen.eq.msglen2) then
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
- else
- write (iout,*) &
+ if (msglen.eq.msglen1) then
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
+ else if (msglen.eq.msglen2) then
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
+ else
+ write (iout,*) &
'ERROR!!!! message length changed while processing correlations.'
- write (*,*) &
+ write (*,*) &
'ERROR!!!! message length changed while processing correlations.'
- call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
- endif ! msglen.eq.msglen1
+ call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
+ endif ! msglen.eq.msglen1
endif ! fg_rank.lt.nfgtasks-1
if (ldone) goto 30
ldone=.true.
30 continue
#endif
if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt_molec(2),nct_molec(2)-1
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
- j=1,num_cont_hb(i))
- enddo
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt_molec(2),nct_molec(2)-1
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
+ j=1,num_cont_hb(i))
+ enddo
endif
ecorr=0.0D0
ecorr3=0.0d0
! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
!C Calculate the local-electrostatic correlation terms
do i=iatsc_s_nucl,iatsc_e_nucl
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
+ i1=i+1
+ num_conti=num_cont_hb(i)
+ num_conti1=num_cont_hb(i+1)
! print *,i,num_conti,num_conti1
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
+ do jj=1,num_conti
+ j=jcont_hb(jj,i)
+ do kk=1,num_conti1
+ j1=jcont_hb(kk,i1)
!c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1 .or. j1.eq.j-1) then
+ if (j1.eq.j+1 .or. j1.eq.j-1) then
!C
!C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
!C The system gains extra energy.
!C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
!C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
!C
- ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
+ ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
+ 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
+ n_corr=n_corr+1
+ else if (j1.eq.j) then
!C
!C Contacts I-J and I-(J+1) occur simultaneously.
!C The system loses extra energy.
!C
!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
+ ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
+ endif
+ enddo ! kk
+ do kk=1,num_conti
+ j1=jcont_hb(kk,i)
!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
+ if (j1.eq.j+1) then
!C Contacts I-J and (I+1)-J occur simultaneously.
!C The system loses extra energy.
- ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
+ ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
+ endif ! j1==j+1
+ enddo ! kk
+ enddo ! jj
enddo ! i
return
end subroutine multibody_hb_nucl
!el local variables
integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
lprn=.false.
eij=facont_hb(jj,i)
coeffpees0pkl=coeffp*ees0pkl
coeffmees0mkl=coeffm*ees0mkl
do ll=1,3
- gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
+ gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
-ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
- gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
- gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
- gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
- gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
- gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
- gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
- gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
+ gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+ gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
+ gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
+ gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
+ gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
+ gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
+ gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
+ gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
enddo
ehbcorr_nucl=ekont*ees
return
!el local variables
integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
lprn=.false.
eij=facont_hb(jj,i)
coeffpees0pkl=coeffp*ees0pkl
coeffmees0mkl=coeffm*ees0mkl
do ll=1,3
- gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
+ gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
-ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
- gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
- gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
- gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
- gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
- gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
- gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
- gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
+ gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+ gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
+ gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
+ gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
+ gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
+ gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
+ gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
+ gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
enddo
ehbcorr3_nucl=ekont*ees
return
real(kind=8):: buffer(dimen1,dimen2)
num_kont=num_cont_hb(atom)
do i=1,num_kont
- do k=1,8
- do j=1,3
- buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
- enddo ! j
- enddo ! k
- buffer(i,indx+25)=facont_hb(i,atom)
- buffer(i,indx+26)=ees0p(i,atom)
- buffer(i,indx+27)=ees0m(i,atom)
- buffer(i,indx+28)=d_cont(i,atom)
- buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
+ do k=1,8
+ do j=1,3
+ buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
+ enddo ! j
+ enddo ! k
+ buffer(i,indx+25)=facont_hb(i,atom)
+ buffer(i,indx+26)=ees0p(i,atom)
+ buffer(i,indx+27)=ees0m(i,atom)
+ buffer(i,indx+28)=d_cont(i,atom)
+ buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
enddo ! i
buffer(1,indx+30)=dfloat(num_kont)
return
num_kont_old=num_cont_hb(atom)
num_cont_hb(atom)=num_kont+num_kont_old
do i=1,num_kont
- ii=i+num_kont_old
- do k=1,8
- do j=1,3
- zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
- enddo ! j
- enddo ! k
- facont_hb(ii,atom)=buffer(i,indx+25)
- ees0p(ii,atom)=buffer(i,indx+26)
- ees0m(ii,atom)=buffer(i,indx+27)
- d_cont(i,atom)=buffer(i,indx+28)
- jcont_hb(ii,atom)=buffer(i,indx+29)
+ ii=i+num_kont_old
+ do k=1,8
+ do j=1,3
+ zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
+ enddo ! j
+ enddo ! k
+ facont_hb(ii,atom)=buffer(i,indx+25)
+ ees0p(ii,atom)=buffer(i,indx+26)
+ ees0m(ii,atom)=buffer(i,indx+27)
+ d_cont(i,atom)=buffer(i,indx+28)
+ jcont_hb(ii,atom)=buffer(i,indx+29)
enddo ! i
return
end subroutine unpack_buffer
!c------------------------------------------------------------------------------
#endif
subroutine ecatcat(ecationcation)
- integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
- real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
- r7,r4,ecationcation,k0,rcal
- real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
- dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
- real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
- gg,r
-
- ecationcation=0.0d0
- if (nres_molec(5).eq.0) return
- rcat0=3.472
- epscalc=0.05
- r06 = rcat0**6
- r012 = r06**2
- k0 = 332.0*(2.0*2.0)/80.0
- itmp=0
-
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
+ integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
+ r7,r4,ecationcation,k0,rcal,aa,bb,sslipi,ssgradlipi,sslipj,ssgradlipj
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r
+
+ ecationcation=0.0d0
+ if (nres_molec(5).eq.0) return
+ rcat0=3.472
+ epscalc=0.05
+ r06 = rcat0**6
+ r012 = r06**2
+! k0 = 332.0*(2.0*2.0)/80.0
+ itmp=0
+
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
! write(iout,*) "itmp",itmp
- do i=itmp+1,itmp+nres_molec(5)-1
+ do i=itmp+1,itmp+nres_molec(5)-1
- xi=c(1,i)
- yi=c(2,i)
- zi=c(3,i)
-
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- do j=i+1,itmp+nres_molec(5)
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
+! write (iout,*) i,"TUTUT",c(1,i)
+ itypi=itype(i,5)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=i+1,itmp+nres_molec(5)
+ itypj=itype(j,5)
+! print *,i,j,itypi,itypj
+ k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
! print *,i,j,'catcat'
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
-! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
- 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
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rcal =xj**2+yj**2+zj**2
- ract=sqrt(rcal)
+ ract=sqrt(rcal)
! rcat0=3.472
! epscalc=0.05
! r06 = rcat0**6
! r012 = r06**2
! k0 = 332*(2*2)/80
- Evan1cat=epscalc*(r012/rcal**6)
- Evan2cat=epscalc*2*(r06/rcal**3)
- Eeleccat=k0/ract
- r7 = rcal**7
- r4 = rcal**4
- r(1)=xj
- r(2)=yj
- r(3)=zj
- do k=1,3
- dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
- dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
- dEeleccat(k)=-k0*r(k)/ract**3
- enddo
- do k=1,3
- gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
- gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
- gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
- enddo
+ Evan1cat=epscalc*(r012/(rcal**6))
+ Evan2cat=epscalc*2*(r06/(rcal**3))
+ Eeleccat=k0/ract
+ r7 = rcal**7
+ r4 = rcal**4
+ r(1)=xj
+ r(2)=yj
+ r(3)=zj
+ do k=1,3
+ dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
+ dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
+ dEeleccat(k)=-k0*r(k)/ract**3
+ enddo
+ do k=1,3
+ gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
+ gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
+ gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
+ enddo
+ if (energy_dec) write (iout,*) i,j,Evan1cat,Evan2cat,Eeleccat,&
+ r012,rcal**6,ichargecat(itypi)*ichargecat(itypj)
+! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
+ ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
+ enddo
+ enddo
+ return
+ end subroutine ecatcat
+!---------------------------------------------------------------------------
+! new for K+
+ subroutine ecats_prot_amber(evdw)
+! subroutine ecat_prot2(ecation_prot)
+ use calc_data
+ use comm_momo
+
+ logical :: lprn
+!el local variables
+ integer :: iint,itypi1,subchap,isel,itmp
+ real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
+ real(kind=8) :: evdw,aa,bb
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
+ integer :: ii
+ real(kind=8) :: fracinbuf
+ real (kind=8) :: escpho
+ real (kind=8),dimension(4):: ener
+ real(kind=8) :: b1,b2,egb
+ real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
+ Lambf,&
+ Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
+ ecations_prot_amber,dFdOM2,dFdL,dFdOM12,&
+ federmaus,&
+ d1i,d1j
+! real(kind=8),dimension(3,2)::erhead_tail
+! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
+ real(kind=8) :: facd4, adler, Fgb, facd3
+ integer troll,jj,istate
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ real(kind=8) ::locbox(3)
+ locbox(1)=boxxsize
+ locbox(2)=boxysize
+ locbox(3)=boxzsize
+
+ evdw=0.0D0
+ if (nres_molec(5).eq.0) return
+ eps_out=80.0d0
+! sss_ele_cut=1.0d0
+
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! go to 17
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+ do i=ibond_start,ibond_end
+
+! print *,"I am in EVDW",i
+ itypi=iabs(itype(i,1))
+
+! if (i.ne.47) cycle
+ if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+ do j=itmp+1,itmp+nres_molec(5)
+
+! Calculate SC interaction energy.
+ itypj=iabs(itype(j,5))
+ if ((itypj.eq.ntyp1)) cycle
+ CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+
+ call to_box(xj,yj,zj)
+! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
+
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+! write(iout,*) "xj,yj,zj", xj,yj,zj,boxxsize
+
+! dxj = dc_norm( 1, nres+j )
+! dyj = dc_norm( 2, nres+j )
+! dzj = dc_norm( 3, nres+j )
+
+ itypi = itype(i,1)
+ itypj = itype(j,5)
+! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
+! sampling performed with amber package
+! alf1 = 0.0d0
+! alf2 = 0.0d0
+! alf12 = 0.0d0
+! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ chi1 = chi1cat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
+ chip1 = chipp1cat(itypi,itypj)
+! chi1=0.0d0
+! chis1=0.0d0
+! chip1=0.0d0
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
+! chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1cat(itypi,itypj)
+! sig2 = sigmap2(itypi,itypj)
+! alpha factors from Fcav/Gcav
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+
+! b1cav=0.0d0
+! b2cav=0.0d0
+! b3cav=0.0d0
+! b4cav=0.0d0
+
+! used to determine whether we want to do quadrupole calculations
+ eps_in = epsintabcat(itypi,itypj)
+ if (eps_in.eq.0.0) eps_in=1.0
+
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+! Rtail = 0.0d0
+
+ DO k = 1, 3
+ ctail(k,1)=c(k,i+nres)
+ ctail(k,2)=c(k,j)
+ END DO
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+! tail location and distance calculations
+! dhead1
+ d1 = dheadcat(1, 1, itypi, itypj)
+! d2 = dhead(2, 1, itypi, itypj)
+ DO k = 1,3
+! location of polar head is computed by taking hydrophobic centre
+! and moving by a d1 * dc_norm vector
+! see unres publications for very informative images
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
+ enddo
+ call to_box(chead(1,1),chead(2,1),chead(3,1))
+ call to_box(chead(1,2),chead(2,2),chead(3,2))
+! write(iout,*) "TEST",chead(1,1),chead(2,1),chead(3,1),dc_norm(k, i+nres),d1
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ do k=1,3
+ Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
+ END DO
+! pitagoras (root of sum of squares)
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+!-------------------------------------------------------------------
+! zero everything that should be zero'ed
+ evdwij = 0.0d0
+ ECL = 0.0d0
+ Elj = 0.0d0
+ Equad = 0.0d0
+ Epol = 0.0d0
+ Fcav=0.0d0
+ eheadtail = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+ Fcav = 0.0d0
+ Fisocav=0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
+! print *,i,j,dscj_inv,dsci_inv
+! rij holds 1/(distance of Calpha atoms)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ CALL sc_angular
+! this should be in elgrad_init but om's are calculated by sc_angular
+! which in turn is used by older potentials
+! om = omega, sqom = om^2
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
+
+! now we calculate EGB - Gey-Berne
+! It will be summed up in evdwij and saved in evdw
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+! rij_shift = 1.0D0 / rij - sig + sig0ij
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ if (evdw.gt.1.0d6) then
+ write (*,'(2(1x,a3,i3),7f7.2)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij,sigsq
+ write(*,*) facsig,faceps1_inv,om1,chiom1,chi1
+ write(*,*) "ANISO?!",chi1
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+ endif
+
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_cat(itypi,itypj)
+! print *,"ADAM",aa_aq(itypi,itypj)
+
+! c1 = 0.0d0
+ c2 = fac * bb_aq_cat(itypi,itypj)
+! c2 = 0.0d0
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
+! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
+!#ifdef TSCSC
+! IF (bb_aq(itypi,itypj).gt.0) THEN
+! evdw_p = evdw_p + evdwij
+! ELSE
+! evdw_m = evdw_m + evdwij
+! END IF
+!#else
+ evdw = evdw &
+ + evdwij
+!#endif
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
+! Calculate distance derivative
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+! print *,"GG(1),distance grad",gg(1)
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Chif = Rtail * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+
+ dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
+ dbot = 12.0d0 * b4cav * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ DO k= 1, 3
+ ertail(k) = Rtail_distance(k)/Rtail
+ END DO
+ erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
+ erdxj = scalar( ertail(1), dC_norm(1,j) )
+ facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j)
+ DO k = 1, 3
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j))
+! gvdwx(k,j) = gvdwx(k,j) &
+! + (( dFdR + gg(k) ) * pom)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
+ gg(k) = 0.0d0
+ ENDDO
+!c! Compute head-head and head-tail energies for each state
+!! if (.false.) then ! turn off electrostatic
+ if (itype(j,5).gt.0) then ! the normal cation case
+ isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
+! print *,i,itype(i,1),isel
+ IF (isel.eq.0) THEN
+!c! No charges - do nothing
+ eheadtail = 0.0d0
+
+ ELSE IF (isel.eq.1) THEN
+!c! Nonpolar-charge interactions
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+
+ CALL enq_cat(epol)
+ eheadtail = epol
+! eheadtail = 0.0d0
+
+ ELSE IF (isel.eq.3) THEN
+!c! Dipole-charge interactions
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+! write(iout,*) "KURWA0",d1
+
+ CALL edq_cat(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+! eheadtail = 0.0d0
+
+ ELSE IF ((isel.eq.2)) THEN
+
+!c! Same charge-charge interaction ( +/+ or -/- )
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+
+ CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
+! eheadtail = 0.0d0
+
+! ELSE IF ((isel.eq.2.and. &
+! iabs(Qi).eq.1).and. &
+! nstate(itypi,itypj).ne.1) THEN
+!c! Different charge-charge interaction ( +/- or -/+ )
+! if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+! Qi=Qi*2
+! Qij=Qij*2
+! endif
+! if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+! Qj=Qj*2
+! Qij=Qij*2
+! endif
+!
+! CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
+ END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
+ else
+ write(iout,*) "not yet implemented",j,itype(j,5)
+ endif
+!! endif ! turn off electrostatic
+ evdw = evdw + Fcav + eheadtail
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+
+ IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
+! evdw = evdw + Fcav + eheadtail
+! print *,"before sc_grad_cat", i,j, gradpepcat(1,j)
+! iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad_cat
+! print *,"after sc_grad_cat", i,j, gradpepcat(1,j)
+
+! END IF
+!c!-------------------------------------------------------------------
+!c! NAPISY KONCOWE
+ END DO ! j
+ END DO ! i
+!c write (iout,*) "Number of loop steps in EGB:",ind
+!c energy_dec=.false.
+! print *,"EVDW KURW",evdw,nres
+!!! return
+ 17 continue
+! go to 23
+ do i=ibond_start,ibond_end
+
+! print *,"I am in EVDW",i
+ itypi=10 ! the peptide group parameters are for glicine
+
+! if (i.ne.47) cycle
+ if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+ dxi=dc_norm(1,i)
+ dyi=dc_norm(2,i)
+ dzi=dc_norm(3,i)
+ dsci_inv=vbld_inv(i+1)/2.0
+ do j=itmp+1,itmp+nres_molec(5)
+
+! Calculate SC interaction energy.
+ itypj=iabs(itype(j,5))
+ if ((itypj.eq.ntyp1)) cycle
+ CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+
+ dxj = 0.0d0! dc_norm( 1, nres+j )
+ dyj = 0.0d0!dc_norm( 2, nres+j )
+ dzj = 0.0d0! dc_norm( 3, nres+j )
+
+ itypi = 10
+ itypj = itype(j,5)
+! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
+! sampling performed with amber package
+! alf1 = 0.0d0
+! alf2 = 0.0d0
+! alf12 = 0.0d0
+! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ chi1 = chi1cat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
+ chip1 = chipp1cat(itypi,itypj)
+! chi1=0.0d0
+! chis1=0.0d0
+! chip1=0.0d0
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
+! chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1cat(itypi,itypj)
+! sig2 = sigmap2(itypi,itypj)
+! alpha factors from Fcav/Gcav
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+
+! used to determine whether we want to do quadrupole calculations
+ eps_in = epsintabcat(itypi,itypj)
+ if (eps_in.eq.0.0) eps_in=1.0
+
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+! Rtail = 0.0d0
+
+ DO k = 1, 3
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0
+ ctail(k,2)=c(k,j)
+ END DO
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
+
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+! tail location and distance calculations
+! dhead1
+ d1 = dheadcat(1, 1, itypi, itypj)
+! print *,"d1",d1
+! d1=0.0d0
+! d2 = dhead(2, 1, itypi, itypj)
+ DO k = 1,3
+! location of polar head is computed by taking hydrophobic centre
+! and moving by a d1 * dc_norm vector
+! see unres publications for very informative images
+ chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
+ chead(k,2) = c(k, j)
+ ENDDO
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ call to_box(chead(1,1),chead(2,1),chead(3,1))
+ call to_box(chead(1,2),chead(2,2),chead(3,2))
+
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ do k=1,3
+ Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
+ END DO
+
+! pitagoras (root of sum of squares)
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+!-------------------------------------------------------------------
+! zero everything that should be zero'ed
+ evdwij = 0.0d0
+ ECL = 0.0d0
+ Elj = 0.0d0
+ Equad = 0.0d0
+ Epol = 0.0d0
+ Fcav=0.0d0
+ eheadtail = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
+! print *,i,j,dscj_inv,dsci_inv
+! rij holds 1/(distance of Calpha atoms)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ CALL sc_angular
+! this should be in elgrad_init but om's are calculated by sc_angular
+! which in turn is used by older potentials
+! om = omega, sqom = om^2
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
+
+! now we calculate EGB - Gey-Berne
+! It will be summed up in evdwij and saved in evdw
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+! rij_shift = 1.0D0 / rij - sig + sig0ij
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),6f6.2)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_cat(itypi,itypj)
+! print *,"ADAM",aa_aq(itypi,itypj)
+
+! c1 = 0.0d0
+ c2 = fac * bb_aq_cat(itypi,itypj)
+! c2 = 0.0d0
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
+! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
+!#ifdef TSCSC
+! IF (bb_aq(itypi,itypj).gt.0) THEN
+! evdw_p = evdw_p + evdwij
+! ELSE
+! evdw_m = evdw_m + evdwij
+! END IF
+!#else
+ evdw = evdw &
+ + evdwij
+!#endif
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
+! Calculate distance derivative
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
+
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+! print *,"TUT2",fac,chis1,sqom1,pom
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Chif = Rtail * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+
+ dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
+ dbot = 12.0d0 * b4cav * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ DO k= 1, 3
+ ertail(k) = Rtail_distance(k)/Rtail
+ END DO
+ erdxi = scalar( ertail(1), dC_norm(1,i) )
+ erdxj = scalar( ertail(1), dC_norm(1,j) )
+ facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i)
+ facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres)
+ DO k = 1, 3
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i))
+! gradpepcatx(k,i) = gradpepcatx(k,i) &
+! - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+! gvdwx(k,j) = gvdwx(k,j) &
+! + (( dFdR + gg(k) ) * pom)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0
+ gradpepcat(k,i+1) = gradpepcat(k,i+1) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
+ gg(k) = 0.0d0
+ ENDDO
+ if (itype(j,5).gt.0) then
+!c! Compute head-head and head-tail energies for each state
+ isel = 3
+!c! Dipole-charge interactions
+ CALL edq_cat_pep(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+! print *,"i,",i,eheadtail
+! eheadtail = 0.0d0
+ else
+!HERE WATER and other types of molecules solvents will be added
+ write(iout,*) "not yet implemented"
+! CALL edd_cat_pep
+ endif
+ evdw = evdw + Fcav + eheadtail
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+ IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
+! evdw = evdw + Fcav + eheadtail
+
+! iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad_cat_pep
+! END IF
+!c!-------------------------------------------------------------------
+!c! NAPISY KONCOWE
+ END DO ! j
+ END DO ! i
+!c write (iout,*) "Number of loop steps in EGB:",ind
+!c energy_dec=.false.
+! print *,"EVDW KURW",evdw,nres
+ 23 continue
+! print *,"before leave sc_grad_cat", i,j, gradpepcat(1,nres-1)
+
+ return
+ end subroutine ecats_prot_amber
-! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
- ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
- enddo
- enddo
- return
- end subroutine ecatcat
!---------------------------------------------------------------------------
+! old for Ca2+
subroutine ecat_prot(ecation_prot)
+! use calc_data
+! use comm_momo
integer i,j,k,subchap,itmp,inum
- real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
- r7,r4,ecationcation
- real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
- dist_init,dist_temp,ecation_prot,rcal,rocal, &
- Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
- catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
- wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
- costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
- Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
- rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
- opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
- opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
- Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip
- real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
- gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
- dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
- tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
- v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
- dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
- dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
- dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
- dEvan1Cat
- real(kind=8),dimension(6) :: vcatprm
- ecation_prot=0.0d0
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
+ r7,r4,ecationcation
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,ecation_prot,rcal,rocal, &
+ Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
+ catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
+ wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
+ costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
+ Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
+ rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
+ opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
+ opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
+ Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
+ ndiv,ndivi
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
+ dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
+ tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
+ v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
+ dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
+ dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
+ dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
+ dEvan1Cat
+ real(kind=8),dimension(6) :: vcatprm
+ ecation_prot=0.0d0
! first lets calculate interaction with peptide groups
- if (nres_molec(5).eq.0) return
- wconst=78
- wdip =1.092777950857032D2
- wdip=wdip/wconst
- wmodquad=-2.174122713004870D4
- wmodquad=wmodquad/wconst
- wquad1 = 3.901232068562804D1
- wquad1=wquad1/wconst
- wquad2 = 3
- wquad2=wquad2/wconst
- wvan1 = 0.1
- wvan2 = 6
- itmp=0
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
+ if (nres_molec(5).eq.0) return
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
- do i=ibond_start,ibond_end
+ do i=ibond_start,ibond_end
! cycle
- if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
- 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
-
- do j=itmp+1,itmp+nres_molec(5)
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
+ 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))
+ call to_box(xi,yi,zi)
+
+ do j=itmp+1,itmp+nres_molec(5)
+! print *,"WTF",itmp,j,i
+! all parameters were for Ca2+ to approximate single charge divide by two
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+ wconst=78*ndiv
+ wdip =1.092777950857032D2
+ wdip=wdip/wconst
+ wmodquad=-2.174122713004870D4
+ wmodquad=wmodquad/wconst
+ wquad1 = 3.901232068562804D1
+ wquad1=wquad1/wconst
+ wquad2 = 3
+ wquad2=wquad2/wconst
+ wvan1 = 0.1
+ wvan2 = 6
+! itmp=0
+
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
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
! enddo
! enddo
rcpm = sqrt(xj**2+yj**2+zj**2)
enddo
dcmag=dsqrt(dcmag)
do k=1,3
- myd_norm(k)=dc(k,i)/dcmag
+ myd_norm(k)=dc(k,i)/dcmag
enddo
- costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
- drcp_norm(3)*myd_norm(3)
- rsecp = rcpm**2
- Ir = 1.0d0/rcpm
- Irsecp = 1.0d0/rsecp
- Irthrp = Irsecp/rcpm
- Irfourp = Irthrp/rcpm
- Irfiftp = Irfourp/rcpm
- Irsistp=Irfiftp/rcpm
- Irseven=Irsistp/rcpm
- Irtwelv=Irsistp*Irsistp
- Irthir=Irtwelv/rcpm
- sin2thet = (1-costhet*costhet)
- sinthet=sqrt(sin2thet)
- E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
- *sin2thet
- E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
- 2*wvan2**6*Irsistp)
- ecation_prot = ecation_prot+E1+E2
- dE1dr = -2*costhet*wdip*Irthrp-&
- (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
- dE2dr = 3*wquad1*wquad2*Irfourp- &
- 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
- dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
- do k=1,3
- drdpep(k) = -drcp_norm(k)
- dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
- dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
- dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
- dEddci(k) = dEdcos*dcosddci(k)
- enddo
- do k=1,3
- gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
- gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
- gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
- enddo
+ costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
+ drcp_norm(3)*myd_norm(3)
+ rsecp = rcpm**2
+ Ir = 1.0d0/rcpm
+ Irsecp = 1.0d0/rsecp
+ Irthrp = Irsecp/rcpm
+ Irfourp = Irthrp/rcpm
+ Irfiftp = Irfourp/rcpm
+ Irsistp=Irfiftp/rcpm
+ Irseven=Irsistp/rcpm
+ Irtwelv=Irsistp*Irsistp
+ Irthir=Irtwelv/rcpm
+ sin2thet = (1-costhet*costhet)
+ sinthet=sqrt(sin2thet)
+ E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
+ *sin2thet
+ E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
+ 2*wvan2**6*Irsistp)
+ ecation_prot = ecation_prot+E1+E2
+! print *,"ecatprot",i,j,ecation_prot,rcpm
+ dE1dr = -2*costhet*wdip*Irthrp-&
+ (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
+ dE2dr = 3*wquad1*wquad2*Irfourp- &
+ 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
+ dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
+ do k=1,3
+ drdpep(k) = -drcp_norm(k)
+ dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
+ dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
+ dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
+ dEddci(k) = dEdcos*dcosddci(k)
+ enddo
+ do k=1,3
+ gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
+ gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
+ gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
+ enddo
enddo ! j
enddo ! i
!------------------------------------------sidechains
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
+ do i=ibond_start,ibond_end
+ if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
! cycle
! print *,i,ecation_prot
- xi=(c(1,i+nres))
- yi=(c(2,i+nres))
- zi=(c(3,i+nres))
- 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 k=1,3
- cm1(k)=dc(k,i+nres)
- enddo
- cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
- do j=itmp+1,itmp+nres_molec(5)
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
+ xi=(c(1,i+nres))
+ yi=(c(2,i+nres))
+ zi=(c(3,i+nres))
+ call to_box(xi,yi,zi)
+ do k=1,3
+ cm1(k)=dc(k,i+nres)
+ enddo
+ cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
+ do j=itmp+1,itmp+nres_molec(5)
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
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
! enddo
! enddo
- if(itype(i,1).eq.15.or.itype(i,1).eq.16) then
- if(itype(i,1).eq.16) then
- inum=1
- else
- inum=2
- endif
- do k=1,6
- vcatprm(k)=catprm(k,inum)
- enddo
- dASGL=catprm(7,inum)
- do k=1,3
- vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
- valpha(k)=c(k,i)
- vcat(k)=c(k,j)
- enddo
- do k=1,3
- dx(k) = vcat(k)-vcm(k)
- enddo
- do k=1,3
- v1(k)=(vcm(k)-valpha(k))
- v2(k)=(vcat(k)-valpha(k))
- enddo
- v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
- v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
- v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
+! 15- Glu 16-Asp
+ if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
+ ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
+ (itype(i,1).eq.25))) then
+ if(itype(i,1).eq.16) then
+ inum=1
+ else
+ inum=2
+ endif
+ do k=1,6
+ vcatprm(k)=catprm(k,inum)
+ enddo
+ dASGL=catprm(7,inum)
+! do k=1,3
+! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
+ vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
+ vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
+ vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
+
+! valpha(k)=c(k,i)
+! vcat(k)=c(k,j)
+ if (subchap.eq.1) then
+ vcat(1)=xj_temp
+ vcat(2)=yj_temp
+ vcat(3)=zj_temp
+ else
+ vcat(1)=xj_safe
+ vcat(2)=yj_safe
+ vcat(3)=zj_safe
+ endif
+ valpha(1)=xi-c(1,i+nres)+c(1,i)
+ valpha(2)=yi-c(2,i+nres)+c(2,i)
+ valpha(3)=zi-c(3,i+nres)+c(3,i)
+
+! enddo
+ do k=1,3
+ dx(k) = vcat(k)-vcm(k)
+ enddo
+ do k=1,3
+ v1(k)=(vcm(k)-valpha(k))
+ v2(k)=(vcat(k)-valpha(k))
+ enddo
+ v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
+ v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
+ v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
! The weights of the energy function calculated from
!The quantum mechanical GAMESS simulations of calcium with ASP/GLU
- wh2o=78
- wc = vcatprm(1)
- wc=wc/wh2o
- wdip =vcatprm(2)
- wdip=wdip/wh2o
- wquad1 =vcatprm(3)
- wquad1=wquad1/wh2o
- wquad2 = vcatprm(4)
- wquad2=wquad2/wh2o
- wquad2p = 1-wquad2
- wvan1 = vcatprm(5)
- wvan2 =vcatprm(6)
- opt = dx(1)**2+dx(2)**2
- rsecp = opt+dx(3)**2
- rs = sqrt(rsecp)
- rthrp = rsecp*rs
- rfourp = rthrp*rs
- rsixp = rfourp*rsecp
- reight=rsixp*rsecp
- Ir = 1.0d0/rs
- Irsecp = 1/rsecp
- Irthrp = Irsecp/rs
- Irfourp = Irthrp/rs
- Irsixp = 1/rsixp
- Ireight=1/reight
- Irtw=Irsixp*Irsixp
- Irthir=Irtw/rs
- Irfourt=Irthir/rs
- opt1 = (4*rs*dx(3)*wdip)
- opt2 = 6*rsecp*wquad1*opt
- opt3 = wquad1*wquad2p*Irsixp
- opt4 = (wvan1*wvan2**12)
- opt5 = opt4*12*Irfourt
- opt6 = 2*wvan1*wvan2**6
- opt7 = 6*opt6*Ireight
- opt8 = wdip/v1m
- opt10 = wdip/v2m
- opt11 = (rsecp*v2m)**2
- opt12 = (rsecp*v1m)**2
- opt14 = (v1m*v2m*rsecp)**2
- opt15 = -wquad1/v2m**2
- opt16 = (rthrp*(v1m*v2m)**2)**2
- opt17 = (v1m**2*rthrp)**2
- opt18 = -wquad1/rthrp
- opt19 = (v1m**2*v2m**2)**2
- Ec = wc*Ir
- do k=1,3
- dEcCat(k) = -(dx(k)*wc)*Irthrp
- dEcCm(k)=(dx(k)*wc)*Irthrp
- dEcCalp(k)=0.0d0
- enddo
- Edip=opt8*(v1dpv2)/(rsecp*v2m)
- do k=1,3
- dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
- *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
- dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
- *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
- dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
- *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
- *v1dpv2)/opt14
- enddo
- Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
- do k=1,3
- dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
- (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
- v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
- dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
- (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
- v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
- dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
- v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
- v1dpv2**2)/opt19
- enddo
- Equad2=wquad1*wquad2p*Irthrp
- do k=1,3
- dEquad2Cat(k)=-3*dx(k)*rs*opt3
- dEquad2Cm(k)=3*dx(k)*rs*opt3
- dEquad2Calp(k)=0.0d0
- enddo
- Evan1=opt4*Irtw
- do k=1,3
- dEvan1Cat(k)=-dx(k)*opt5
- dEvan1Cm(k)=dx(k)*opt5
- dEvan1Calp(k)=0.0d0
- enddo
- Evan2=-opt6*Irsixp
- do k=1,3
- dEvan2Cat(k)=dx(k)*opt7
- dEvan2Cm(k)=-dx(k)*opt7
- dEvan2Calp(k)=0.0d0
- enddo
- ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ ndivi=0.5
+ else
+ ndivi=1.0
+ endif
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ wh2o=78*ndivi*ndiv
+ wc = vcatprm(1)
+ wc=wc/wh2o
+ wdip =vcatprm(2)
+ wdip=wdip/wh2o
+ wquad1 =vcatprm(3)
+ wquad1=wquad1/wh2o
+ wquad2 = vcatprm(4)
+ wquad2=wquad2/wh2o
+ wquad2p = 1.0d0-wquad2
+ wvan1 = vcatprm(5)
+ wvan2 =vcatprm(6)
+ opt = dx(1)**2+dx(2)**2
+ rsecp = opt+dx(3)**2
+ rs = sqrt(rsecp)
+ rthrp = rsecp*rs
+ rfourp = rthrp*rs
+ rsixp = rfourp*rsecp
+ reight=rsixp*rsecp
+ Ir = 1.0d0/rs
+ Irsecp = 1.0d0/rsecp
+ Irthrp = Irsecp/rs
+ Irfourp = Irthrp/rs
+ Irsixp = 1.0d0/rsixp
+ Ireight=1.0d0/reight
+ Irtw=Irsixp*Irsixp
+ Irthir=Irtw/rs
+ Irfourt=Irthir/rs
+ opt1 = (4*rs*dx(3)*wdip)
+ opt2 = 6*rsecp*wquad1*opt
+ opt3 = wquad1*wquad2p*Irsixp
+ opt4 = (wvan1*wvan2**12)
+ opt5 = opt4*12*Irfourt
+ opt6 = 2*wvan1*wvan2**6
+ opt7 = 6*opt6*Ireight
+ opt8 = wdip/v1m
+ opt10 = wdip/v2m
+ opt11 = (rsecp*v2m)**2
+ opt12 = (rsecp*v1m)**2
+ opt14 = (v1m*v2m*rsecp)**2
+ opt15 = -wquad1/v2m**2
+ opt16 = (rthrp*(v1m*v2m)**2)**2
+ opt17 = (v1m**2*rthrp)**2
+ opt18 = -wquad1/rthrp
+ opt19 = (v1m**2*v2m**2)**2
+ Ec = wc*Ir
+ do k=1,3
+ dEcCat(k) = -(dx(k)*wc)*Irthrp
+ dEcCm(k)=(dx(k)*wc)*Irthrp
+ dEcCalp(k)=0.0d0
+ enddo
+ Edip=opt8*(v1dpv2)/(rsecp*v2m)
+ do k=1,3
+ dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
+ *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
+ dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
+ *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
+ dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
+ *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
+ *v1dpv2)/opt14
+ enddo
+ Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
+ do k=1,3
+ dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
+ (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
+ v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
+ (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
+ v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
+ v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
+ v1dpv2**2)/opt19
+ enddo
+ Equad2=wquad1*wquad2p*Irthrp
+ do k=1,3
+ dEquad2Cat(k)=-3*dx(k)*rs*opt3
+ dEquad2Cm(k)=3*dx(k)*rs*opt3
+ dEquad2Calp(k)=0.0d0
+ enddo
+ Evan1=opt4*Irtw
+ do k=1,3
+ dEvan1Cat(k)=-dx(k)*opt5
+ dEvan1Cm(k)=dx(k)*opt5
+ dEvan1Calp(k)=0.0d0
+ enddo
+ Evan2=-opt6*Irsixp
+ do k=1,3
+ dEvan2Cat(k)=dx(k)*opt7
+ dEvan2Cm(k)=-dx(k)*opt7
+ dEvan2Calp(k)=0.0d0
+ enddo
+ ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
-
- do k=1,3
- dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
- dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
+
+ do k=1,3
+ dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
+ dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
!c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
- dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
- dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
- dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
- +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
- enddo
- dscmag = 0.0d0
- do k=1,3
- dscvec(k) = dc(k,i+nres)
- dscmag = dscmag+dscvec(k)*dscvec(k)
- enddo
- dscmag3 = dscmag
- dscmag = sqrt(dscmag)
- dscmag3 = dscmag3*dscmag
- constA = 1.0d0+dASGL/dscmag
- constB = 0.0d0
- do k=1,3
- constB = constB+dscvec(k)*dEtotalCm(k)
- enddo
- constB = constB*dASGL/dscmag3
- do k=1,3
- gg(k) = dEtotalCm(k)+dEtotalCalp(k)
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- constA*dEtotalCm(k)-constB*dscvec(k)
+ dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
+ dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
+ dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
+ +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
+ enddo
+ dscmag = 0.0d0
+ do k=1,3
+ dscvec(k) = dc(k,i+nres)
+ dscmag = dscmag+dscvec(k)*dscvec(k)
+ enddo
+ dscmag3 = dscmag
+ dscmag = sqrt(dscmag)
+ dscmag3 = dscmag3*dscmag
+ constA = 1.0d0+dASGL/dscmag
+ constB = 0.0d0
+ do k=1,3
+ constB = constB+dscvec(k)*dEtotalCm(k)
+ enddo
+ constB = constB*dASGL/dscmag3
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ constA*dEtotalCm(k)-constB*dscvec(k)
! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
- gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
- gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
- enddo
- else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
- if(itype(i,1).eq.14) then
- inum=3
- else
- inum=4
+ gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
+ gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
+ enddo
+ else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
+ if(itype(i,1).eq.14) then
+ inum=3
+ else
+ inum=4
+ endif
+ do k=1,6
+ vcatprm(k)=catprm(k,inum)
+ enddo
+ dASGL=catprm(7,inum)
+! do k=1,3
+! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
+! valpha(k)=c(k,i)
+! vcat(k)=c(k,j)
+! enddo
+ vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
+ vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
+ vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
+ if (subchap.eq.1) then
+ vcat(1)=xj_temp
+ vcat(2)=yj_temp
+ vcat(3)=zj_temp
+ else
+ vcat(1)=xj_safe
+ vcat(2)=yj_safe
+ vcat(3)=zj_safe
endif
- do k=1,6
- vcatprm(k)=catprm(k,inum)
- enddo
- dASGL=catprm(7,inum)
- do k=1,3
- vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
- valpha(k)=c(k,i)
- vcat(k)=c(k,j)
- enddo
+ valpha(1)=xi-c(1,i+nres)+c(1,i)
+ valpha(2)=yi-c(2,i+nres)+c(2,i)
+ valpha(3)=zi-c(3,i+nres)+c(3,i)
- do k=1,3
- dx(k) = vcat(k)-vcm(k)
- enddo
- do k=1,3
- v1(k)=(vcm(k)-valpha(k))
- v2(k)=(vcat(k)-valpha(k))
- enddo
- v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
- v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
- v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
+
+ do k=1,3
+ dx(k) = vcat(k)-vcm(k)
+ enddo
+ do k=1,3
+ v1(k)=(vcm(k)-valpha(k))
+ v2(k)=(vcat(k)-valpha(k))
+ enddo
+ v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
+ v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
+ v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
! The weights of the energy function calculated from
!The quantum mechanical GAMESS simulations of ASN/GLN with calcium
- wh2o=78
- wdip =vcatprm(2)
- wdip=wdip/wh2o
- wquad1 =vcatprm(3)
- wquad1=wquad1/wh2o
- wquad2 = vcatprm(4)
- wquad2=wquad2/wh2o
- wquad2p = 1-wquad2
- wvan1 = vcatprm(5)
- wvan2 =vcatprm(6)
- opt = dx(1)**2+dx(2)**2
- rsecp = opt+dx(3)**2
- rs = sqrt(rsecp)
- rthrp = rsecp*rs
- rfourp = rthrp*rs
- rsixp = rfourp*rsecp
- reight=rsixp*rsecp
- Ir = 1.0d0/rs
- Irsecp = 1/rsecp
- Irthrp = Irsecp/rs
- Irfourp = Irthrp/rs
- Irsixp = 1/rsixp
- Ireight=1/reight
- Irtw=Irsixp*Irsixp
- Irthir=Irtw/rs
- Irfourt=Irthir/rs
- opt1 = (4*rs*dx(3)*wdip)
- opt2 = 6*rsecp*wquad1*opt
- opt3 = wquad1*wquad2p*Irsixp
- opt4 = (wvan1*wvan2**12)
- opt5 = opt4*12*Irfourt
- opt6 = 2*wvan1*wvan2**6
- opt7 = 6*opt6*Ireight
- opt8 = wdip/v1m
- opt10 = wdip/v2m
- opt11 = (rsecp*v2m)**2
- opt12 = (rsecp*v1m)**2
- opt14 = (v1m*v2m*rsecp)**2
- opt15 = -wquad1/v2m**2
- opt16 = (rthrp*(v1m*v2m)**2)**2
- opt17 = (v1m**2*rthrp)**2
- opt18 = -wquad1/rthrp
- opt19 = (v1m**2*v2m**2)**2
- Edip=opt8*(v1dpv2)/(rsecp*v2m)
- do k=1,3
- dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
- *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
- dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
- *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
- dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
- *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
- *v1dpv2)/opt14
- enddo
- Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
- do k=1,3
- dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
- (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
- v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
- dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
- (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
- v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
- dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
- v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
- v1dpv2**2)/opt19
- enddo
- Equad2=wquad1*wquad2p*Irthrp
- do k=1,3
- dEquad2Cat(k)=-3*dx(k)*rs*opt3
- dEquad2Cm(k)=3*dx(k)*rs*opt3
- dEquad2Calp(k)=0.0d0
- enddo
- Evan1=opt4*Irtw
- do k=1,3
- dEvan1Cat(k)=-dx(k)*opt5
- dEvan1Cm(k)=dx(k)*opt5
- dEvan1Calp(k)=0.0d0
- enddo
- Evan2=-opt6*Irsixp
- do k=1,3
- dEvan2Cat(k)=dx(k)*opt7
- dEvan2Cm(k)=-dx(k)*opt7
- dEvan2Calp(k)=0.0d0
- enddo
- ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
- do k=1,3
- dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
- dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
- dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
- dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
- dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
- +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
- enddo
- dscmag = 0.0d0
- do k=1,3
- dscvec(k) = c(k,i+nres)-c(k,i)
- dscmag = dscmag+dscvec(k)*dscvec(k)
- enddo
- dscmag3 = dscmag
- dscmag = sqrt(dscmag)
- dscmag3 = dscmag3*dscmag
- constA = 1+dASGL/dscmag
- constB = 0.0d0
- do k=1,3
- constB = constB+dscvec(k)*dEtotalCm(k)
- enddo
- constB = constB*dASGL/dscmag3
- do k=1,3
- gg(k) = dEtotalCm(k)+dEtotalCalp(k)
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- constA*dEtotalCm(k)-constB*dscvec(k)
- gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
- gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
- enddo
- else
- rcal = 0.0d0
- do k=1,3
- r(k) = c(k,j)-c(k,i+nres)
- rcal = rcal+r(k)*r(k)
- enddo
- ract=sqrt(rcal)
- rocal=1.5
- epscalc=0.2
- r0p=0.5*(rocal+sig0(itype(i,1)))
- r06 = r0p**6
- r012 = r06*r06
- Evan1=epscalc*(r012/rcal**6)
- Evan2=epscalc*2*(r06/rcal**3)
- r4 = rcal**4
- r7 = rcal**7
- do k=1,3
- dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
- dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
- enddo
- do k=1,3
- dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
- enddo
- ecation_prot = ecation_prot+ Evan1+Evan2
- do k=1,3
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- dEtotalCm(k)
- gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
- gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
- enddo
- endif ! 13-16 residues
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ wh2o=78*ndiv
+ wdip =vcatprm(2)
+ wdip=wdip/wh2o
+ wquad1 =vcatprm(3)
+ wquad1=wquad1/wh2o
+ wquad2 = vcatprm(4)
+ wquad2=wquad2/wh2o
+ wquad2p = 1-wquad2
+ wvan1 = vcatprm(5)
+ wvan2 =vcatprm(6)
+ opt = dx(1)**2+dx(2)**2
+ rsecp = opt+dx(3)**2
+ rs = sqrt(rsecp)
+ rthrp = rsecp*rs
+ rfourp = rthrp*rs
+ rsixp = rfourp*rsecp
+ reight=rsixp*rsecp
+ Ir = 1.0d0/rs
+ Irsecp = 1/rsecp
+ Irthrp = Irsecp/rs
+ Irfourp = Irthrp/rs
+ Irsixp = 1/rsixp
+ Ireight=1/reight
+ Irtw=Irsixp*Irsixp
+ Irthir=Irtw/rs
+ Irfourt=Irthir/rs
+ opt1 = (4*rs*dx(3)*wdip)
+ opt2 = 6*rsecp*wquad1*opt
+ opt3 = wquad1*wquad2p*Irsixp
+ opt4 = (wvan1*wvan2**12)
+ opt5 = opt4*12*Irfourt
+ opt6 = 2*wvan1*wvan2**6
+ opt7 = 6*opt6*Ireight
+ opt8 = wdip/v1m
+ opt10 = wdip/v2m
+ opt11 = (rsecp*v2m)**2
+ opt12 = (rsecp*v1m)**2
+ opt14 = (v1m*v2m*rsecp)**2
+ opt15 = -wquad1/v2m**2
+ opt16 = (rthrp*(v1m*v2m)**2)**2
+ opt17 = (v1m**2*rthrp)**2
+ opt18 = -wquad1/rthrp
+ opt19 = (v1m**2*v2m**2)**2
+ Edip=opt8*(v1dpv2)/(rsecp*v2m)
+ do k=1,3
+ dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
+ *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
+ dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
+ *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
+ dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
+ *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
+ *v1dpv2)/opt14
+ enddo
+ Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
+ do k=1,3
+ dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
+ (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
+ v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
+ (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
+ v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
+ v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
+ v1dpv2**2)/opt19
+ enddo
+ Equad2=wquad1*wquad2p*Irthrp
+ do k=1,3
+ dEquad2Cat(k)=-3*dx(k)*rs*opt3
+ dEquad2Cm(k)=3*dx(k)*rs*opt3
+ dEquad2Calp(k)=0.0d0
+ enddo
+ Evan1=opt4*Irtw
+ do k=1,3
+ dEvan1Cat(k)=-dx(k)*opt5
+ dEvan1Cm(k)=dx(k)*opt5
+ dEvan1Calp(k)=0.0d0
+ enddo
+ Evan2=-opt6*Irsixp
+ do k=1,3
+ dEvan2Cat(k)=dx(k)*opt7
+ dEvan2Cm(k)=-dx(k)*opt7
+ dEvan2Calp(k)=0.0d0
+ enddo
+ ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
+ do k=1,3
+ dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
+ dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
+ dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
+ dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
+ dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
+ +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
+ enddo
+ dscmag = 0.0d0
+ do k=1,3
+ dscvec(k) = c(k,i+nres)-c(k,i)
+! TU SPRAWDZ???
+! dscvec(1) = xj
+! dscvec(2) = yj
+! dscvec(3) = zj
+
+ dscmag = dscmag+dscvec(k)*dscvec(k)
+ enddo
+ dscmag3 = dscmag
+ dscmag = sqrt(dscmag)
+ dscmag3 = dscmag3*dscmag
+ constA = 1+dASGL/dscmag
+ constB = 0.0d0
+ do k=1,3
+ constB = constB+dscvec(k)*dEtotalCm(k)
+ enddo
+ constB = constB*dASGL/dscmag3
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ constA*dEtotalCm(k)-constB*dscvec(k)
+ gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
+ gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
+ enddo
+ else
+ rcal = 0.0d0
+ do k=1,3
+! r(k) = c(k,j)-c(k,i+nres)
+ r(1) = xj
+ r(2) = yj
+ r(3) = zj
+ rcal = rcal+r(k)*r(k)
+ enddo
+ ract=sqrt(rcal)
+ rocal=1.5
+ epscalc=0.2
+ r0p=0.5*(rocal+sig0(itype(i,1)))
+ r06 = r0p**6
+ r012 = r06*r06
+ Evan1=epscalc*(r012/rcal**6)
+ Evan2=epscalc*2*(r06/rcal**3)
+ r4 = rcal**4
+ r7 = rcal**7
+ do k=1,3
+ dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
+ dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
+ enddo
+ do k=1,3
+ dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
+ enddo
+ ecation_prot = ecation_prot+ Evan1+Evan2
+ do k=1,3
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ dEtotalCm(k)
+ gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
+ gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
+ enddo
+ endif ! 13-16 residues
enddo !j
enddo !i
return
end subroutine ecat_prot
!----------------------------------------------------------------------------
+!---------------------------------------------------------------------------
+ subroutine ecat_nucl(ecation_nucl)
+ integer i,j,k,subchap,itmp,inum,itypi,itypj
+ real(kind=8) :: xi,yi,zi,xj,yj,zj
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,ecation_nucl,Evan1,Evan2,Ecav,Egb,wdip1,wdip2, &
+ wvan1,wvan2,wgbsig,wgbeps,wgbchi,wgbchip,wcav1,wcav2,wcav3,wcav4, &
+ wcavsig,wcavchi,v1m,v1dpdx,wh2o,wc,Edip,rcs2,invrcs6,invrcs8,invrcs12, &
+ invrcs14,rcb,rcb2,invrcb,invrcb2,invrcb4,invrcb6,cosinus,cos2,dcosdcatconst, &
+ dcosdcalpconst,dcosdcmconst,rcav,rcav11,rcav12,constcav1,constcav2, &
+ constgb1,constgb2,constdvan1,constdvan2,sgb,sgb6,sgb7,sgb12,sgb13, &
+ cavnum,cavdenom,invcavdenom2,dcavnumdcos,dcavnumdr,dcavdenomdcos, &
+ dcavdenomdr,sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
+ real(kind=8),dimension(3) ::gg,r,dEtotalCm,dEtotalCalp,dEvan1Cm,&
+ dEvan2Cm,cm1,cm,vcat,vsug,v1,v2,dx,vcm,dEdipCm,dEdipCalp, &
+ dEvan1Calp,dEvan2Cat,dEvan2Calp,dEtotalCat,dEdipCat,dEvan1Cat,dcosdcat, &
+ dcosdcalp,dcosdcm,dEgbdCat,dEgbdCalp,dEgbdCm,dEcavdCat,dEcavdCalp, &
+ dEcavdCm,boxik
+ real(kind=8),dimension(14) :: vcatnuclprm
+ ecation_nucl=0.0d0
+ boxik(1)=boxxsize
+ boxik(2)=boxysize
+ boxik(3)=boxzsize
+
+ if (nres_molec(5).eq.0) return
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+ do i=iatsc_s_nucl,iatsc_e_nucl
+ if ((itype(i,2).eq.ntyp1_molec(2))) cycle ! leave dummy atoms
+ xi=(c(1,i+nres))
+ yi=(c(2,i+nres))
+ zi=(c(3,i+nres))
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do k=1,3
+ cm1(k)=dc(k,i+nres)
+ enddo
+ do j=itmp+1,itmp+nres_molec(5)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+! write(iout,*) 'after shift', xj,yj,zj
+ dist_init=xj**2+yj**2+zj**2
+
+ itypi=itype(i,2)
+ itypj=itype(j,5)
+ do k=1,13
+ vcatnuclprm(k)=catnuclprm(k,itypi,itypj)
+ enddo
+ do k=1,3
+ vcm(k)=c(k,i+nres)
+ vsug(k)=c(k,i)
+ vcat(k)=c(k,j)
+ enddo
+ call to_box(vcm(1),vcm(2),vcm(3))
+ call to_box(vsug(1),vsug(2),vsug(3))
+ call to_box(vcat(1),vcat(2),vcat(3))
+ do k=1,3
+! dx(k) = vcat(k)-vcm(k)
+! enddo
+ dx(k)=boxshift(vcat(k)-vcm(k),boxik(k))
+! do k=1,3
+ v1(k)=dc(k,i+nres)
+ v2(k)=boxshift(vcat(k)-vsug(k),boxik(k))
+ enddo
+ v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
+ v1dpdx = v1(1)*dx(1)+v1(2)*dx(2)+v1(3)*dx(3)
+! The weights of the energy function calculated from
+!The quantum mechanical Gaussian simulations of potassium and sodium with deoxynucleosides
+ wh2o=78
+ wdip1 = vcatnuclprm(1)
+ wdip1 = wdip1/wh2o !w1
+ wdip2 = vcatnuclprm(2)
+ wdip2 = wdip2/wh2o !w2
+ wvan1 = vcatnuclprm(3)
+ wvan2 = vcatnuclprm(4) !pis1
+ wgbsig = vcatnuclprm(5) !sigma0
+ wgbeps = vcatnuclprm(6) !epsi0
+ wgbchi = vcatnuclprm(7) !chi1
+ wgbchip = vcatnuclprm(8) !chip1
+ wcavsig = vcatnuclprm(9) !sig
+ wcav1 = vcatnuclprm(10) !b1
+ wcav2 = vcatnuclprm(11) !b2
+ wcav3 = vcatnuclprm(12) !b3
+ wcav4 = vcatnuclprm(13) !b4
+ wcavchi = vcatnuclprm(14) !chis1
+ rcs2 = v2(1)**2+v2(2)**2+v2(3)**2
+ invrcs6 = 1/rcs2**3
+ invrcs8 = invrcs6/rcs2
+ invrcs12 = invrcs6**2
+ invrcs14 = invrcs12/rcs2
+ rcb2 = dx(1)**2+dx(2)**2+dx(3)**2
+ rcb = sqrt(rcb2)
+ invrcb = 1/rcb
+ invrcb2 = invrcb**2
+ invrcb4 = invrcb2**2
+ invrcb6 = invrcb4*invrcb2
+ cosinus = v1dpdx/(v1m*rcb)
+ cos2 = cosinus**2
+ dcosdcatconst = invrcb2/v1m
+ dcosdcalpconst = invrcb/v1m**2
+ dcosdcmconst = invrcb2/v1m**2
+ do k=1,3
+ dcosdcat(k) = (v1(k)*rcb-dx(k)*v1m*cosinus)*dcosdcatconst
+ dcosdcalp(k) = (v1(k)*rcb*cosinus-dx(k)*v1m)*dcosdcalpconst
+ dcosdcm(k) = ((dx(k)-v1(k))*v1m*rcb+ &
+ cosinus*(dx(k)*v1m**2-v1(k)*rcb2))*dcosdcmconst
+ enddo
+ rcav = rcb/wcavsig
+ rcav11 = rcav**11
+ rcav12 = rcav11*rcav
+ constcav1 = 1-wcavchi*cos2
+ constcav2 = sqrt(constcav1)
+ constgb1 = 1/sqrt(1-wgbchi*cos2)
+ constgb2 = wgbeps*(1-wgbchip*cos2)**2
+ constdvan1 = 12*wvan1*wvan2**12*invrcs14
+ constdvan2 = 6*wvan1*wvan2**6*invrcs8
+!----------------------------------------------------------------------------
+!Gay-Berne term
+!---------------------------------------------------------------------------
+ sgb = 1/(1-constgb1+(rcb/wgbsig))
+ sgb6 = sgb**6
+ sgb7 = sgb6*sgb
+ sgb12 = sgb6**2
+ sgb13 = sgb12*sgb
+ Egb = constgb2*(sgb12-sgb6)
+ do k=1,3
+ dEgbdCat(k) = -constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
+ +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcat(k)
+ dEgbdCm(k) = constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
+ +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcm(k)
+ dEgbdCalp(k) = (constgb1**3*constgb2*wgbchi*cosinus &
+ *(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcalp(k)
+ enddo
+!----------------------------------------------------------------------------
+!cavity term
+!---------------------------------------------------------------------------
+ cavnum = sqrt(rcav*constcav2)+wcav2*rcav*constcav2-wcav3
+ cavdenom = 1+wcav4*rcav12*constcav1**6
+ Ecav = wcav1*cavnum/cavdenom
+ invcavdenom2 = 1/cavdenom**2
+ dcavnumdcos = -wcavchi*cosinus/constcav2 &
+ *(sqrt(rcav/constcav2)/2+wcav2*rcav)
+ dcavnumdr = (0.5*sqrt(constcav2/rcav)+wcav2*constcav2)/wcavsig
+ dcavdenomdcos = -12*wcav4*wcavchi*rcav12*constcav1**5*cosinus
+ dcavdenomdr = 12*wcav4/wcavsig*rcav11*constcav1**6
+ do k=1,3
+ dEcavdCat(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcat(k)+(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
+ dEcavdCm(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcm(k)-(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
+ dEcavdCalp(k) = (dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcalp(k)*wcav1*invcavdenom2
+ enddo
+!----------------------------------------------------------------------------
+!van der Waals and dipole-charge interaction energy
+!---------------------------------------------------------------------------
+ Evan1 = wvan1*wvan2**12*invrcs12
+ do k=1,3
+ dEvan1Cat(k) = -v2(k)*constdvan1
+ dEvan1Cm(k) = 0.0d0
+ dEvan1Calp(k) = v2(k)*constdvan1
+ enddo
+ Evan2 = -wvan1*wvan2**6*invrcs6
+ do k=1,3
+ dEvan2Cat(k) = v2(k)*constdvan2
+ dEvan2Cm(k) = 0.0d0
+ dEvan2Calp(k) = -v2(k)*constdvan2
+ enddo
+ Edip = wdip1*cosinus*invrcb2-wdip2*(1-cos2)*invrcb4
+ do k=1,3
+ dEdipCat(k) = (-2*wdip1*cosinus*invrcb4 &
+ +4*wdip2*(1-cos2)*invrcb6)*dx(k) &
+ +dcosdcat(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
+ dEdipCm(k) = (2*wdip1*cosinus*invrcb4 &
+ -4*wdip2*(1-cos2)*invrcb6)*dx(k) &
+ +dcosdcm(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
+ dEdipCalp(k) = dcosdcalp(k)*(wdip1*invrcb2 &
+ +2*wdip2*cosinus*invrcb4)
+ enddo
+ if (energy_dec) write (iout,'(2i5,4(a6,f7.3))') i,j, &
+ ' E GB ',Egb,' ECav ',Ecav,' Evdw ',Evan1+Evan2,' Edip ',Edip
+ ecation_nucl=ecation_nucl+Ecav+Egb+Edip+Evan1+Evan2
+ do k=1,3
+ dEtotalCat(k) = dEcavdCat(k)+dEvan1Cat(k)+dEvan2Cat(k) &
+ +dEgbdCat(k)+dEdipCat(k)
+ dEtotalCm(k) = dEcavdCm(k)+dEvan1Cm(k)+dEvan2Cm(k) &
+ +dEgbdCm(k)+dEdipCm(k)
+ dEtotalCalp(k) = dEcavdCalp(k)+dEgbdCalp(k)+dEvan1Calp(k) &
+ +dEdipCalp(k)+dEvan2Calp(k)
+ enddo
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradnuclcatx(k,i)=gradnuclcatx(k,i)+dEtotalCm(k)
+ gradnuclcat(k,i)=gradnuclcat(k,i)+gg(k)
+ gradnuclcat(k,j)=gradnuclcat(k,j)+dEtotalCat(k)
+ enddo
+ enddo !j
+ enddo !i
+ return
+ end subroutine ecat_nucl
+
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
subroutine eprot_sc_base(escbase)
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escbase
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
+ sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
escbase=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dxi = dc_norm(1,nres+i)
- dyi = dc_norm(2,nres+i)
- dzi = dc_norm(3,nres+i)
- dsci_inv = vbld_inv(i+nres)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
- itypj= itype(j,2)
- if (itype(j,2).eq.ntyp1_molec(2))cycle
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- 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 )
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dxi = dc_norm(1,nres+i)
+ dyi = dc_norm(2,nres+i)
+ dzi = dc_norm(3,nres+i)
+ dsci_inv = vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! print *,i,j,itypi,itypj
- d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
- d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
+ d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
+ d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
! d1i=0.0d0
! d1j=0.0d0
! BetaT = 1.0d0 / (298.0d0 * Rb)
! Gay-berne var's
- sig0ij = sigma_scbase( itypi,itypj )
- chi1 = chi_scbase( itypi, itypj,1 )
- chi2 = chi_scbase( itypi, itypj,2 )
+ sig0ij = sigma_scbase( itypi,itypj )
+ chi1 = chi_scbase( itypi, itypj,1 )
+ chi2 = chi_scbase( itypi, itypj,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_scbase( itypi, itypj,1 )
- chip2 = chipp_scbase( itypi, itypj,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_scbase( itypi, itypj,1 )
+ chip2 = chipp_scbase( itypi, itypj,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
+ chip12 = chip1 * chip2
! not used by momo potential, but needed by sc_angular which is shared
! by all energy_potential subroutines
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
! a12sq = a12sq * a12sq
! charge of amino acid itypi is...
- chis1 = chis_scbase(itypi,itypj,1)
- chis2 = chis_scbase(itypi,itypj,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_scbase(itypi,itypj)
- sig2 = sigmap2_scbase(itypi,itypj)
+ chis1 = chis_scbase(itypi,itypj,1)
+ chis2 = chis_scbase(itypi,itypj,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_scbase(itypi,itypj)
+ sig2 = sigmap2_scbase(itypi,itypj)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- b1 = alphasur_scbase(1,itypi,itypj)
+ b1 = alphasur_scbase(1,itypi,itypj)
! b1=0.0d0
- b2 = alphasur_scbase(2,itypi,itypj)
- b3 = alphasur_scbase(3,itypi,itypj)
- b4 = alphasur_scbase(4,itypi,itypj)
+ b2 = alphasur_scbase(2,itypi,itypj)
+ b3 = alphasur_scbase(3,itypi,itypj)
+ b4 = alphasur_scbase(4,itypi,itypj)
! used to determine whether we want to do quadrupole calculations
! used by Fgb
eps_in = epsintab_scbase(itypi,itypj)
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
+ chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_scbase(itypi,itypj)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_scbase(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_scbase(itypi,itypj)
+ c2 = fac * bb_scbase(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
! if (b2.gt.0.0) then
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
! print *,i,j,Fcav
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
-
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)
+ pom = ertail(k)
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
- pom = ertail(k)
+ pom = ertail(k)
!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
! endif
!Now dipole-dipole
- if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
+ if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
w1 = wdipdip_scbase(1,itypi,itypj)
w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
w3 = wdipdip_scbase(2,itypi,itypj)
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
c3= (w3/ Rhead ** 6.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
ECL = c1 - c2 + c3
!c! write (*,*) "w1 = ", w1
!c! write (*,*) "w2 = ", w2
!c! dECL/dr
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
dGCLdR = c1 - c2 + c3
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
dGCLdOM1 = c1 - c2 + c3
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
dGCLdOM2 = c1 - c2 + c3
!c! dECL/dom12
c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
dGCLdOM12 = c1 - c2 + c3
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
facd2 = d1j * vbld_inv(j+nres)
DO k = 1, 3
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - dGCLdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + dGCLdR * pom
-
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - dGCLdR * erhead(k)
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + dGCLdR * erhead(k)
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - dGCLdR * pom
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + dGCLdR * pom
+
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - dGCLdR * erhead(k)
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + dGCLdR * erhead(k)
END DO
endif
!now charge with dipole eg. ARG-dG
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances tail is center of side-chain
- R1=R1+(c(k,j+nres)-chead(k,1))**2
+ R1=R1+(c(k,j+nres)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom2)
Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) / (Rhead**2.0d0)
!c! dF/dom2
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
! facd1=0.0d0
! facd2=0.0d0
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - dGCLdR * pom &
- - dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR1 * (erhead_tail(k,1))
! & - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + dGCLdR * pom &
- + dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1))
! & + dGLJdR * pom
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1)
! & - dGLJdR * erhead(k)
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1)
! & + dGLJdR * erhead(k)
END DO
! print *,i,j,evdwij,epol,Fcav,ECL
escbase=escbase+evdwij+epol+Fcav+ECL
call sc_grad_scbase
- enddo
+ enddo
enddo
return
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
! gg(1),gg(2),"rozne"
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
- gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
+ gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
END DO
RETURN
END SUBROUTINE sc_grad_scbase
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: epepbase
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
+ sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
epepbase=0.0d0
! do i=1,nres_molec(1)-1
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
!C itypi = itype(i,1)
- dxi = dc_norm(1,i)
- dyi = dc_norm(2,i)
- dzi = dc_norm(3,i)
+ dxi = dc_norm(1,i)
+ dyi = dc_norm(2,i)
+ dzi = dc_norm(3,i)
! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
- dsci_inv = vbld_inv(i+1)/2.0
- xi=(c(1,i)+c(1,i+1))/2.0
- yi=(c(2,i)+c(2,i+1))/2.0
- zi=(c(3,i)+c(3,i+1))/2.0
- 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 j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
- itypj= itype(j,2)
- if (itype(j,2).eq.ntyp1_molec(2))cycle
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- 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 )
+ dsci_inv = vbld_inv(i+1)/2.0
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
! Gay-berne var's
- sig0ij = sigma_pepbase(itypj )
- chi1 = chi_pepbase(itypj,1 )
- chi2 = chi_pepbase(itypj,2 )
+ sig0ij = sigma_pepbase(itypj )
+ chi1 = chi_pepbase(itypj,1 )
+ chi2 = chi_pepbase(itypj,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_pepbase(itypj,1 )
- chip2 = chipp_pepbase(itypj,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_pepbase(itypj,1 )
+ chip2 = chipp_pepbase(itypj,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
- chis1 = chis_pepbase(itypj,1)
- chis2 = chis_pepbase(itypj,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_pepbase(itypj)
- sig2 = sigmap2_pepbase(itypj)
+ chip12 = chip1 * chip2
+ chis1 = chis_pepbase(itypj,1)
+ chis2 = chis_pepbase(itypj,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_pepbase(itypj)
+ sig2 = sigmap2_pepbase(itypj)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
DO k = 1,3
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = (c(k,i)+c(k,i+1))/2.0
+ chead(k,1) = (c(k,i)+c(k,i+1))/2.0
! + d1i * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres)
+ chead(k,2) = c(k, j+nres)
! + d1j * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
! print *,gvdwc_pepbase(k,i)
END DO
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
! alpha factors from Fcav/Gcav
- b1 = alphasur_pepbase(1,itypj)
+ b1 = alphasur_pepbase(1,itypj)
! b1=0.0d0
- b2 = alphasur_pepbase(2,itypj)
- b3 = alphasur_pepbase(3,itypj)
- b4 = alphasur_pepbase(4,itypj)
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ b2 = alphasur_pepbase(2,itypj)
+ b3 = alphasur_pepbase(3,itypj)
+ b4 = alphasur_pepbase(4,itypj)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
! print *,i,j,rrij
- rij = dsqrt(rrij)
+ rij = dsqrt(rrij)
!----------------------------
evdwij = 0.0d0
ECL = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
- CALL sc_angular
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_pepbase(itypj)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_pepbase(itypj)
! c1 = 0.0d0
- c2 = fac * bb_pepbase(itypj)
+ c2 = fac * bb_pepbase(itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
! print *,i,j,Fcav
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)
+ pom = ertail(k)
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
- - (( dFdR + gg(k) ) * pom)/2.0
+ gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
+ - (( dFdR + gg(k) ) * pom)/2.0
! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
- pom = ertail(k)
+ pom = ertail(k)
!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
+ + (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
- - (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0
! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
!c! & - ( dFdR * ertail(k))
- gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
c3= (w3/ Rhead ** 6.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
ECL = c1 - c2 + c3
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
dGCLdR = c1 - c2 + c3
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
dGCLdOM1 = c1 - c2 + c3
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
dGCLdOM2 = c1 - c2 + c3
c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
dGCLdOM12 = c1 - c2 + c3
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
!+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
! - dGCLdR * pom
- pom = erhead(k)
+ pom = erhead(k)
!+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
- + dGCLdR * pom
+ gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
+ + dGCLdR * pom
- gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
- - dGCLdR * erhead(k)/2.0d0
+ gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
+ - dGCLdR * erhead(k)/2.0d0
! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
- gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
- - dGCLdR * erhead(k)/2.0d0
+ gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
+ - dGCLdR * erhead(k)/2.0d0
! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
- gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
- + dGCLdR * erhead(k)
+ gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
+ + dGCLdR * erhead(k)
END DO
! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
epepbase=epepbase+evdwij+Fcav+ECL
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! om12=0.0
! eom12=0.0
! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
! *dsci_inv*2.0
-! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
-! gg(1),gg(2),"rozne"
- DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
- + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
- *dsci_inv*2.0 &
- - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
- - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
- *dsci_inv*2.0 &
- + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
+! gg(1),gg(2),"rozne"
+ DO k = 1, 3
+ dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
+ + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
+ *dsci_inv*2.0 &
+ - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
+ - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
+ *dsci_inv*2.0 &
+ + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
! print *,eom12,eom2,om12,om2
!eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
- gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
- + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
+ gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
+ + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
END DO
RETURN
END SUBROUTINE sc_grad_pepbase
!el local variables
integer :: iint,itypi,itypi1,itypj,subchap
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
- real(kind=8) :: evdw,sig0ij
+ real(kind=8) :: evdw,sig0ij,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
+ sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
escpho=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dxi = dc_norm(1,nres+i)
- dyi = dc_norm(2,nres+i)
- dzi = dc_norm(3,nres+i)
- dsci_inv = vbld_inv(i+nres)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
- itypj= itype(j,2)
- if ((itype(j,2).eq.ntyp1_molec(2)).or.&
- (itype(j+1,2).eq.ntyp1_molec(2))) cycle
- xj=(c(1,j)+c(1,j+1))/2.0
- yj=(c(2,j)+c(2,j+1))/2.0
- zj=(c(3,j)+c(3,j+1))/2.0
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- 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
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dxi = dc_norm(1,nres+i)
+ dyi = dc_norm(2,nres+i)
+ dzi = dc_norm(3,nres+i)
+ dsci_inv = vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj = dc_norm( 1,j )
- dyj = dc_norm( 2,j )
- dzj = dc_norm( 3,j )
- dscj_inv = vbld_inv(j+1)
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)
! Gay-berne var's
- sig0ij = sigma_scpho(itypi )
- chi1 = chi_scpho(itypi,1 )
- chi2 = chi_scpho(itypi,2 )
+ sig0ij = sigma_scpho(itypi )
+ chi1 = chi_scpho(itypi,1 )
+ chi2 = chi_scpho(itypi,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_scpho(itypi,1 )
- chip2 = chipp_scpho(itypi,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_scpho(itypi,1 )
+ chip2 = chipp_scpho(itypi,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
- chis1 = chis_scpho(itypi,1)
- chis2 = chis_scpho(itypi,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_scpho(itypi)
- sig2 = sigmap2_scpho(itypi)
+ chip12 = chip1 * chip2
+ chis1 = chis_scpho(itypi,1)
+ chis2 = chis_scpho(itypi,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_scpho(itypi)
+ sig2 = sigmap2_scpho(itypi)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
- b1 = alphasur_scpho(1,itypi)
+ b1 = alphasur_scpho(1,itypi)
! b1=0.0d0
- b2 = alphasur_scpho(2,itypi)
- b3 = alphasur_scpho(3,itypi)
- b4 = alphasur_scpho(4,itypi)
+ b2 = alphasur_scpho(2,itypi)
+ b3 = alphasur_scpho(3,itypi)
+ b4 = alphasur_scpho(4,itypi)
! used to determine whether we want to do quadrupole calculations
! used by Fgb
eps_in = epsintab_scpho(itypi)
! write (*,*) "eps_inout_fac = ", eps_inout_fac
!-------------------------------------------------------------------
! tail location and distance calculations
- d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
- d1j = 0.0
+ d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
+ d1j = 0.0
DO k = 1,3
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
- chead(k,2) = (c(k, j) + c(k, j+1))/2.0
+ chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
+ chead(k,2) = (c(k, j) + c(k, j+1))/2.0
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
Rhead_sq=Rhead**2.0
!-------------------------------------------------------------------
! zero everything that should be zero'ed
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+1)/2.0
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+1)/2.0
!dhead_scbasej(itypi,itypj)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_scpho(itypi)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_scpho(itypi)
! c1 = 0.0d0
- c2 = fac * bb_scpho(itypi)
+ c2 = fac * bb_scpho(itypi)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
- pom = ertail(k)
+ pom = ertail(k)
! print *,pom,gg(k),dFdR
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
+ - (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
- gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
- ENDDO
+ gg(k) = 0.0d0
+ ENDDO
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
! alphapol1 = alphapol_scpho(itypi)
Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
!c! derivative of Ecl is Gcl...
dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
- (Rhead*alpha_sco+1) ) / Rhead_sq
+ (Rhead*alpha_sco+1) ) / Rhead_sq
if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
else if (wqdip_scpho(2,itypi).gt.0.0d0) then
w1 = wqdip_scpho(1,itypi)
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom2)
Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
- 1.0/rij,sparrow
+ 1.0/rij,sparrow
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) / (Rhead**2.0d0)
!c! dF/dom2
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances tail is center of side-chain
- R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
+ R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
! dPOLdR1 = 0.0d0
! dPOLdOM1 = 0.0d0
dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
dPOLdOM2 = 0.0
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
! facd1=0.0d0
! facd2=0.0d0
! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
! pom,(erhead_tail(k,1))
! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
- - dGCLdR * pom &
- - dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR1 * (erhead_tail(k,1))
! & - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
! + dGCLdR * pom &
! + dPOLdR1 * (erhead_tail(k,1))
! & + dGLJdR * pom
- gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1)
! & - dGLJdR * erhead(k)
- gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
- + (dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1))/2.0
- gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
- + (dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1))/2.0
+ gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
+ + (dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1))/2.0
+ gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
+ + (dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1))/2.0
! & + dGLJdR * erhead(k)
! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
END DO
! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
- "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
+ "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
escpho=escpho+evdwij+epol+Fcav+ECL
call sc_grad_scpho
- enddo
+ enddo
enddo
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! om12=0.0
! eom12=0.0
! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
! gg(1),gg(2),"rozne"
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
- + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
- *dscj_inv*2.0 &
- - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
- - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
- *dscj_inv*2.0 &
- + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
- + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
+ + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
+ *dscj_inv*2.0 &
+ - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
+ gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
+ - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
+ *dscj_inv*2.0 &
+ + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
+ gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! print *,eom12,eom2,om12,om2
!eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
+ gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
END DO
RETURN
END SUBROUTINE sc_grad_scpho
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: epeppho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
+ sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
real (kind=8) :: dcosom1(3),dcosom2(3)
epeppho=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dsci_inv = vbld_inv(i+1)/2.0
- dxi = dc_norm(1,i)
- dyi = dc_norm(2,i)
- dzi = dc_norm(3,i)
- xi=(c(1,i)+c(1,i+1))/2.0
- yi=(c(2,i)+c(2,i+1))/2.0
- zi=(c(3,i)+c(3,i+1))/2.0
- 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 j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
- itypj= itype(j,2)
- if ((itype(j,2).eq.ntyp1_molec(2)).or.&
- (itype(j+1,2).eq.ntyp1_molec(2))) cycle
- xj=(c(1,j)+c(1,j+1))/2.0
- yj=(c(2,j)+c(2,j+1))/2.0
- zj=(c(3,j)+c(3,j+1))/2.0
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
- dxj = dc_norm( 1,j )
- dyj = dc_norm( 2,j )
- dzj = dc_norm( 3,j )
- dscj_inv = vbld_inv(j+1)/2.0
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dsci_inv = vbld_inv(i+1)/2.0
+ dxi = dc_norm(1,i)
+ dyi = dc_norm(2,i)
+ dzi = dc_norm(3,i)
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=xj**2+yj**2+zj**2
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ dxj = dc_norm( 1,j )
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)/2.0
! Gay-berne var's
- sig0ij = sigma_peppho
+ sig0ij = sigma_peppho
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
+ chi12 = chi1 * chi2
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
+ chip12 = chip1 * chip2
! chis1 = 0.0d0
! chis2 = 0.0d0
- chis12 = chis1 * chis2
- sig1 = sigmap1_peppho
- sig2 = sigmap2_peppho
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_peppho
+ sig2 = sigmap2_peppho
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- b1 = alphasur_peppho(1)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ b1 = alphasur_peppho(1)
! b1=0.0d0
- b2 = alphasur_peppho(2)
- b3 = alphasur_peppho(3)
- b4 = alphasur_peppho(4)
- CALL sc_angular
+ b2 = alphasur_peppho(2)
+ b3 = alphasur_peppho(3)
+ b4 = alphasur_peppho(4)
+ CALL sc_angular
sqom1=om1*om1
evdwij = 0.0d0
ECL = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- rij_shift = rij
- fac = rij_shift**expon
- c1 = fac * fac * aa_peppho
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ rij_shift = rij
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_peppho
! c1 = 0.0d0
- c2 = fac * bb_peppho
+ c2 = fac * bb_peppho
! c2 = 0.0d0
- evdwij = c1 + c2
+ evdwij = c1 + c2
! Now cavity....................
eagle = dsqrt(1.0/rij_shift)
top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
- bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
- dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
- dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
- dFdR = ((dtop * bot - top * dbot) / botsq)
+ bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+ dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
+ dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
+ dFdR = ((dtop * bot - top * dbot) / botsq)
w1 = wqdip_peppho(1)
w2 = wqdip_peppho(2)
! w1=0.0d0
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom1)
Ecl = sparrow * rij_shift**2.0d0 &
- - hawk * rij_shift**4.0d0
+ - hawk * rij_shift**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
! rij_shift=5.0
dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
- + 4.0d0 * hawk * rij_shift**5.0d0
+ + 4.0d0 * hawk * rij_shift**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) * (rij_shift**2.0d0)
!c! dF/dom2
eom1 = dGCLdOM1+dGCLdOM2
eom2 = 0.0
- fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
+ fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
! fac=0.0
- gg(1) = fac*xj*rij
- gg(2) = fac*yj*rij
- gg(3) = fac*zj*rij
- do k=1,3
- gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
- gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
- gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
- gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
- gg(k)=0.0
- enddo
+ gg(1) = fac*xj*rij
+ gg(2) = fac*yj*rij
+ gg(3) = fac*zj*rij
+ do k=1,3
+ gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
+ gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
+ gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
+ gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
+ gg(k)=0.0
+ enddo
DO k = 1, 3
- dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
- dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
- gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
+ dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
+ dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
+ gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
+ gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
- - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
- + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- enddo
+ gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
+ - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
+ + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ enddo
epeppho=epeppho+evdwij+Fcav+ECL
! print *,i,j,evdwij,Fcav,ECL,rij_shift
enddo
!el local variables
integer :: iint,itypi1,subchap,isel
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
- real(kind=8) :: evdw
+ real(kind=8) :: evdw,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,egb
real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
- Lambf,&
- Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
- dFdOM2,dFdL,dFdOM12,&
- federmaus,&
- d1i,d1j
+ Lambf,&
+ Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
+ dFdOM2,dFdL,dFdOM12,&
+ federmaus,&
+ d1i,d1j
! real(kind=8),dimension(3,2)::erhead_tail
! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
real(kind=8) :: facd4, adler, Fgb, facd3
integer troll,jj,istate
real (kind=8) :: dcosom1(3),dcosom2(3)
+ evdw=0.0d0
eps_out=80.0d0
sss_ele_cut=1.0d0
! print *,"EVDW KURW",evdw,nres
do i=iatsc_s,iatsc_e
! print *,"I am in EVDW",i
- itypi=iabs(itype(i,1))
+ itypi=iabs(itype(i,1))
! if (i.ne.47) cycle
- if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1,1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+! endif
! print *, sslipi,ssgradlipi
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
+ dsci_inv=vbld_inv(i+nres)
! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
!
! Calculate SC interaction energy.
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
- IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- call dyn_ssbond_ene(i,j,evdwij)
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
- 'evdw',i,j,evdwij,' ss'
+ IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
+ call dyn_ssbond_ene(i,j,evdwij)
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,' ss'
! if (energy_dec) write (iout,*) &
! 'evdw',i,j,evdwij,' ss'
- do k=j+1,iend(i,iint)
+ do k=j+1,iend(i,iint)
!C search over all next residues
- if (dyn_ss_mask(k)) then
+ if (dyn_ss_mask(k)) then
!C check if they are cysteins
!C write(iout,*) 'k=',k
!c write(iout,*) "PRZED TRI", evdwij
! evdwij_przed_tri=evdwij
- call triple_ssbond_ene(i,j,k,evdwij)
+ call triple_ssbond_ene(i,j,k,evdwij)
!c if(evdwij_przed_tri.ne.evdwij) then
!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
!c endif
!c write(iout,*) "PO TRI", evdwij
!C call the energy function that removes the artifical triple disulfide
!C bond the soubroutine is located in ssMD.F
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
- 'evdw',i,j,evdwij,'tss'
- endif!dyn_ss_mask(k)
- enddo! k
- ELSE
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
+ ELSE
!el ind=ind+1
- itypj=iabs(itype(j,1))
- if (itypj.eq.ntyp1) cycle
- CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ itypj=iabs(itype(j,1))
+ if (itypj.eq.ntyp1) cycle
+ CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
! if (j.ne.78) cycle
! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- 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 )
+ dscj_inv=vbld_inv(j+nres)
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! write(iout,*) "KRUWA", i,j
+ 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
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! print *,i,j,itypi,itypj
! d1i=0.0d0
! d1j=0.0d0
! chip2=0.0d0
! not used by momo potential, but needed by sc_angular which is shared
! by all energy_potential subroutines
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
! a12sq = a12sq * a12sq
! charge of amino acid itypi is...
- chis1 = chis(itypi,itypj)
- chis2 = chis(itypj,itypi)
- chis12 = chis1 * chis2
- sig1 = sigmap1(itypi,itypj)
- sig2 = sigmap2(itypi,itypj)
+ chis1 = chis(itypi,itypj)
+ chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1(itypi,itypj)
+ sig2 = sigmap2(itypi,itypj)
! write (*,*) "sig1 = ", sig1
! chis1=0.0
! chis2=0.0
! sig2=0.0
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- b1cav = alphasur(1,itypi,itypj)
+ b1cav = alphasur(1,itypi,itypj)
! b1cav=0.0d0
- b2cav = alphasur(2,itypi,itypj)
- b3cav = alphasur(3,itypi,itypj)
- b4cav = alphasur(4,itypi,itypj)
+ b2cav = alphasur(2,itypi,itypj)
+ b3cav = alphasur(3,itypi,itypj)
+ b4cav = alphasur(4,itypi,itypj)
! used to determine whether we want to do quadrupole calculations
eps_in = epsintab(itypi,itypj)
if (eps_in.eq.0.0) eps_in=1.0
-
+
eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
Rtail = 0.0d0
! dtail(1,itypi,itypj)=0.0
! dtail(2,itypi,itypj)=0.0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
! write (*,*) "eps_inout_fac = ", eps_inout_fac
!-------------------------------------------------------------------
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = Rtail - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_aq(itypi,itypj)
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq(itypi,itypj)
! print *,"ADAM",aa_aq(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_aq(itypi,itypj)
+ c2 = fac * bb_aq(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
!#ifdef TSCSC
! IF (bb_aq(itypi,itypj).gt.0) THEN
! evdw_p = evdw_p + evdwij
! evdw_m = evdw_m + evdwij
! END IF
!#else
- evdw = evdw &
- + evdwij
+ evdw = evdw &
+ + evdwij
!#endif
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
! if (b2.gt.0.0) then
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
! print *,"fac,pom",fac,pom,Lambf
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! print *,"sig1,sig2",sig1,sig2,itypi,itypj
! write (*,*) "sparrow = ", sparrow
- Chif = Rtail * sparrow
+ Chif = Rtail * sparrow
! print *,"rij,sparrow",rij , sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
- bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
- botsq = bot * bot
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
! print *,top,bot,"bot,top",ChiLambf,Chif
- Fcav = top / bot
+ Fcav = top / bot
dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
dbot = 12.0d0 * b4cav * bat * Lambf
dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
- dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
- dbot = 12.0d0 * b4cav * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
DO k= 1, 3
- ertail(k) = Rtail_distance(k)/Rtail
+ ertail(k) = Rtail_distance(k)/Rtail
END DO
erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
DO k = 1, 3
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - (( dFdR + gg(k) ) * pom)
!c! & - ( dFdR * pom )
- pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + (( dFdR + gg(k) ) * pom)
!c! & + ( dFdR * pom )
- gvdwc(k,i) = gvdwc(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc(k,i) = gvdwc(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc(k,j) = gvdwc(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc(k,j) = gvdwc(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
!c! Compute head-head and head-tail energies for each state
- isel = iabs(Qi) + iabs(Qj)
+ isel = iabs(Qi) + iabs(Qj)
+! double charge for Phophorylated! itype - 25,27,27
+! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
+! Qi=Qi*2
+! Qij=Qij*2
+! endif
+! if ((itype(j).eq.27).or.(itype(j).eq.26).or.(itype(j).eq.25)) then
+! Qj=Qj*2
+! Qij=Qij*2
+! endif
+
! isel=0
- IF (isel.eq.0) THEN
+ IF (isel.eq.0) THEN
!c! No charges - do nothing
- eheadtail = 0.0d0
+ eheadtail = 0.0d0
- ELSE IF (isel.eq.4) THEN
+ ELSE IF (isel.eq.4) THEN
!c! Calculate dipole-dipole interactions
- CALL edd(ecl)
- eheadtail = ECL
+ CALL edd(ecl)
+ eheadtail = ECL
! eheadtail = 0.0d0
- ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
+ ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
!c! Charge-nonpolar interactions
- CALL eqn(epol)
- eheadtail = epol
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+
+ CALL eqn(epol)
+ eheadtail = epol
! eheadtail = 0.0d0
- ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
+ ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
!c! Nonpolar-charge interactions
- CALL enq(epol)
- eheadtail = epol
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+
+ CALL enq(epol)
+ eheadtail = epol
! eheadtail = 0.0d0
- ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
+ ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
!c! Charge-dipole interactions
- CALL eqd(ecl, elj, epol)
- eheadtail = ECL + elj + epol
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+
+ CALL eqd(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
! eheadtail = 0.0d0
- ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
+ ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
!c! Dipole-charge interactions
- CALL edq(ecl, elj, epol)
- eheadtail = ECL + elj + epol
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+ CALL edq(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
! eheadtail = 0.0d0
- ELSE IF ((isel.eq.2.and. &
- iabs(Qi).eq.1).and. &
- nstate(itypi,itypj).eq.1) THEN
+ ELSE IF ((isel.eq.2.and. &
+ iabs(Qi).eq.1).and. &
+ nstate(itypi,itypj).eq.1) THEN
!c! Same charge-charge interaction ( +/+ or -/- )
- CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
- eheadtail = ECL + Egb + Epol + Fisocav + Elj
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+
+ CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
! eheadtail = 0.0d0
- ELSE IF ((isel.eq.2.and. &
- iabs(Qi).eq.1).and. &
- nstate(itypi,itypj).ne.1) THEN
+ ELSE IF ((isel.eq.2.and. &
+ iabs(Qi).eq.1).and. &
+ nstate(itypi,itypj).ne.1) THEN
!c! Different charge-charge interaction ( +/- or -/+ )
- CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
- END IF
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+
+ CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
+ END IF
END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
evdw = evdw + Fcav + eheadtail
IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
- restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
- 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
- Equad,evdwij+Fcav+eheadtail,evdw
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
! evdw = evdw + Fcav + eheadtail
- iF (nstate(itypi,itypj).eq.1) THEN
- CALL sc_grad
+ iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad
END IF
!c!-------------------------------------------------------------------
!c! NAPISY KONCOWE
- END DO ! j
- END DO ! iint
+ END DO ! j
+ END DO ! iint
END DO ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!c energy_dec=.false.
use calc_data
use comm_momo
real (kind=8) :: facd3, facd4, federmaus, adler,&
- Ecl,Egb,Epol,Fisocav,Elj,Fgb
+ Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
! integer :: k
!c! Epol and Gpol analytical parameters
alphapol1 = alphapol(itypi,itypj)
alphapol2 = alphapol(itypj,itypi)
!c! Fisocav and Gisocav analytical parameters
- al1 = alphiso(1,itypi,itypj)
- al2 = alphiso(2,itypi,itypj)
- al3 = alphiso(3,itypi,itypj)
- al4 = alphiso(4,itypi,itypj)
+ al1 = alphiso(1,itypi,itypj)
+ al2 = alphiso(2,itypi,itypj)
+ al3 = alphiso(3,itypi,itypj)
+ al4 = alphiso(4,itypi,itypj)
+ csig = (1.0d0 &
+ / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
+ + sigiso2(itypi,itypj)**2.0d0))
+!c!
+ pis = sig0head(itypi,itypj)
+ eps_head = epshead(itypi,itypj)
+ Rhead_sq = Rhead * Rhead
+!c! R1 - distance between head of ith side chain and tail of jth sidechain
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R1 = 0.0d0
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances needed by Epol
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ R1 = dsqrt(R1)
+ R2 = dsqrt(R2)
+
+!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
+!c! & +dhead(1,1,itypi,itypj))**2))
+!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
+!c! & +dhead(2,1,itypi,itypj))**2))
+
+!c!-------------------------------------------------------------------
+!c! Coulomb electrostatic interaction
+ Ecl = (332.0d0 * Qij) / Rhead
+!c! derivative of Ecl is Gcl...
+ dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ debkap=debaykap(itypi,itypj)
+ Egb = -(332.0d0 * Qij *&
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
+! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
+!c! Derivative of Egb is Ggb...
+ dGGBdFGB = -(-332.0d0 * Qij * &
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
+ -(332.0d0 * Qij *&
+ (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
+ dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
+ dGGBdR = dGGBdFGB * dFGBdR
+!c!-------------------------------------------------------------------
+!c! Fisocav - isotropic cavity creation term
+!c! or "how much energy it costs to put charged head in water"
+ pom = Rhead * csig
+ top = al1 * (dsqrt(pom) + al2 * pom - al3)
+ bot = (1.0d0 + al4 * pom**12.0d0)
+ botsq = bot * bot
+ FisoCav = top / bot
+! write (*,*) "Rhead = ",Rhead
+! write (*,*) "csig = ",csig
+! write (*,*) "pom = ",pom
+! write (*,*) "al1 = ",al1
+! write (*,*) "al2 = ",al2
+! write (*,*) "al3 = ",al3
+! write (*,*) "al4 = ",al4
+! write (*,*) "top = ",top
+! write (*,*) "bot = ",bot
+!c! Derivative of Fisocav is GCV...
+ dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
+ dbot = 12.0d0 * al4 * pom ** 11.0d0
+ dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
+!c!-------------------------------------------------------------------
+!c! Epol
+!c! Polarization energy - charged heads polarize hydrophobic "neck"
+ MomoFac1 = (1.0d0 - chi1 * sqom2)
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR1 = ( R1 * R1 ) / MomoFac1
+ RR2 = ( R2 * R2 ) / MomoFac2
+ ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
+ ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
+ fgb1 = sqrt( RR1 + a12sq * ee1 )
+ fgb2 = sqrt( RR2 + a12sq * ee2 )
+ epol = 332.0d0 * eps_inout_fac * ( &
+ (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
+!c! epol = 0.0d0
+ dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
+ / (fgb1 ** 5.0d0)
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
+ / (fgb2 ** 5.0d0)
+ dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
+ / ( 2.0d0 * fgb1 )
+ dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
+ / ( 2.0d0 * fgb2 )
+ dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
+ * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
+ * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1
+!c! dPOLdR1 = 0.0d0
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.0d0
+ dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+!c! dPOLdOM2 = 0.0d0
+!c!-------------------------------------------------------------------
+!c! Elj
+!c! Lennard-Jones 6-12 interaction between heads
+ pom = (pis / Rhead)**6.0d0
+ Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
+!c! derivative of Elj is Glj
+ dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+!c!-------------------------------------------------------------------
+!c! Return the results
+!c! These things do the dRdX derivatives, that is
+!c! allow us to change what we see from function that changes with
+!c! distance to function that changes with LOCATION (of the interaction
+!c! site)
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j+nres)
+ facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+ facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
+
+!c! Now we add appropriate partial derivatives (one in each dimension)
+ DO k = 1, 3
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ condor = (erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dGCLdR * pom&
+ - dGGBdR * pom&
+ - dGCVdR * pom&
+ - dPOLdR1 * hawk&
+ - dPOLdR2 * (erhead_tail(k,2)&
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
+ - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
+ + dGGBdR * pom+ dGCVdR * pom&
+ + dPOLdR1 * (erhead_tail(k,1)&
+ -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
+ + dPOLdR2 * condor + dGLJdR * pom
+
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k)
+
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2)&
+ + dGLJdR * erhead(k)
+
+ END DO
+ RETURN
+ END SUBROUTINE eqq
+
+ SUBROUTINE eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
+ use calc_data
+ use comm_momo
+ real (kind=8) :: facd3, facd4, federmaus, adler,&
+ Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
+! integer :: k
+!c! Epol and Gpol analytical parameters
+ alphapol1 = alphapolcat(itypi,itypj)
+ alphapol2 = alphapolcat2(itypj,itypi)
+!c! Fisocav and Gisocav analytical parameters
+ al1 = alphisocat(1,itypi,itypj)
+ al2 = alphisocat(2,itypi,itypj)
+ al3 = alphisocat(3,itypi,itypj)
+ al4 = alphisocat(4,itypi,itypj)
csig = (1.0d0 &
- / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
- + sigiso2(itypi,itypj)**2.0d0))
+ / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 &
+ + sigiso2cat(itypi,itypj)**2.0d0))
!c!
- pis = sig0head(itypi,itypj)
- eps_head = epshead(itypi,itypj)
+ pis = sig0headcat(itypi,itypj)
+ eps_head = epsheadcat(itypi,itypj)
Rhead_sq = Rhead * Rhead
!c! R1 - distance between head of ith side chain and tail of jth sidechain
!c! R2 - distance between head of jth side chain and tail of ith sidechain
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances needed by Epol
- R1=R1+(ctail(k,2)-chead(k,1))**2
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
dGCLdOM12 = 0.0d0
ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
- Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
+ debkap=debaykapcat(itypi,itypj)
+ Egb = -(332.0d0 * Qij *&
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
!c! Derivative of Egb is Ggb...
- dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
+ dGGBdFGB = -(-332.0d0 * Qij * &
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
+ -(332.0d0 * Qij *&
+ (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
dGGBdR = dGGBdFGB * dFGBdR
!c!-------------------------------------------------------------------
(( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
+ / ( 2.0d0 * fgb1 )
dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
- / ( 2.0d0 * fgb2 )
+ / ( 2.0d0 * fgb2 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
- * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
- * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
+ * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
dPOLdR2 = dPOLdFGB2 * dFGBdR2
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
!c! Return the results
!c! These things do the dRdX derivatives, that is
!c! distance to function that changes with LOCATION (of the interaction
!c! site)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
- erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j) )
bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
- federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
- eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
facd1 = d1 * vbld_inv(i+nres)
- facd2 = d2 * vbld_inv(j+nres)
- facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
- facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ facd4 = dtailcat(2,itypi,itypj) * vbld_inv(j)
!c! Now we add appropriate partial derivatives (one in each dimension)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- condor = (erhead_tail(k,2) + &
- facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - dGCLdR * pom&
- - dGGBdR * pom&
- - dGCVdR * pom&
- - dPOLdR1 * hawk&
- - dPOLdR2 * (erhead_tail(k,2)&
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ condor = (erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom&
+ - dGGBdR * pom&
+ - dGCVdR * pom&
+ - dPOLdR1 * hawk&
+ - dPOLdR2 * (erhead_tail(k,2)&
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
- - dGLJdR * pom
-
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
- + dGGBdR * pom+ dGCVdR * pom&
- + dPOLdR1 * (erhead_tail(k,1)&
- -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
- + dPOLdR2 * condor + dGLJdR * pom
-
- gvdwc(k,i) = gvdwc(k,i) &
- - dGCLdR * erhead(k)&
- - dGGBdR * erhead(k)&
- - dGCVdR * erhead(k)&
- - dPOLdR1 * erhead_tail(k,1)&
- - dPOLdR2 * erhead_tail(k,2)&
- - dGLJdR * erhead(k)
-
- gvdwc(k,j) = gvdwc(k,j) &
- + dGCLdR * erhead(k) &
- + dGGBdR * erhead(k) &
- + dGCVdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dPOLdR2 * erhead_tail(k,2)&
- + dGLJdR * erhead(k)
+ - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepcatx(k,j) = gradpepcatx(k,j)+ dGCLdR * pom&
+! + dGGBdR * pom+ dGCVdR * pom&
+! + dPOLdR1 * (erhead_tail(k,1)&
+! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))&
+! + dPOLdR2 * condor + dGLJdR * pom
+
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k)
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2)&
+ + dGLJdR * erhead(k)
END DO
RETURN
- END SUBROUTINE eqq
+ END SUBROUTINE eqq_cat
!c!-------------------------------------------------------------------
SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
use comm_momo
al3 = alphiso(3,itypi,itypj)
al4 = alphiso(4,itypi,itypj)
csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
- + sigiso2(itypi,itypj)**2.0d0))
+ + sigiso2(itypi,itypj)**2.0d0))
!c!
w1 = wqdip(1,itypi,itypj)
w2 = wqdip(2,itypi,itypj)
!c! First things first:
!c! We need to do sc_grad's job with GB and Fcav
eom1 = eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der&
- + sigder * sigsq_om1&
- + dCAVdOM1
+ - 2.0D0 * alf1 * eps3der&
+ + sigder * sigsq_om1&
+ + dCAVdOM1
eom2 = eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der&
- + sigder * sigsq_om2&
- + dCAVdOM2
+ + 2.0D0 * alf2 * eps3der&
+ + sigder * sigsq_om2&
+ + dCAVdOM2
eom12 = evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der&
- + sigder *sigsq_om12&
- + dCAVdOM12
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der&
+ + sigder *sigsq_om12&
+ + dCAVdOM12
!c! now some magical transformations to project gradient into
!c! three cartesian vectors
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
!c! this acts on hydrophobic center of interaction
- gvdwx(k,i)= gvdwx(k,i) - gg(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)= gvdwx(k,j) + gg(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwx(k,i)= gvdwx(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)= gvdwx(k,j) + gg(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! this acts on Calpha
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
+ gvdwc(k,i)=gvdwc(k,i)-gg(k)
+ gvdwc(k,j)=gvdwc(k,j)+gg(k)
END DO
!c! sc_grad is done, now we will compute
eheadtail = 0.0d0
eom12 = 0.0d0
DO istate = 1, nstate(itypi,itypj)
!c*************************************************************
- IF (istate.ne.1) THEN
- IF (istate.lt.3) THEN
- ii = 1
- ELSE
- ii = 2
- END IF
- jj = istate/ii
- d1 = dhead(1,ii,itypi,itypj)
- d2 = dhead(2,jj,itypi,itypj)
- DO k = 1,3
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
- END DO
+ IF (istate.ne.1) THEN
+ IF (istate.lt.3) THEN
+ ii = 1
+ ELSE
+ ii = 2
+ END IF
+ jj = istate/ii
+ d1 = dhead(1,ii,itypi,itypj)
+ d2 = dhead(2,jj,itypi,itypj)
+ DO k = 1,3
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
+ END DO
!c! pitagoras (root of sum of squares)
- Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
- END IF
- Rhead_sq = Rhead * Rhead
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+ END IF
+ Rhead_sq = Rhead * Rhead
!c! R1 - distance between head of ith side chain and tail of jth sidechain
!c! R2 - distance between head of jth side chain and tail of ith sidechain
- R1 = 0.0d0
- R2 = 0.0d0
- DO k = 1, 3
+ R1 = 0.0d0
+ R2 = 0.0d0
+ DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
- R2=R2+(chead(k,2)-ctail(k,1))**2
- END DO
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
!c! Pitagoras
- R1 = dsqrt(R1)
- R2 = dsqrt(R2)
- Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
+ R1 = dsqrt(R1)
+ R2 = dsqrt(R2)
+ Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
!c! Ecl = 0.0d0
!c! write (*,*) "Ecl = ", Ecl
!c! derivative of Ecl is Gcl...
- dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
+ dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
!c! dGCLdR = 0.0d0
- dGCLdOM1 = 0.0d0
- dGCLdOM2 = 0.0d0
- dGCLdOM12 = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
!c!-------------------------------------------------------------------
!c! Generalised Born Solvent Polarization
- ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
- Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
- Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
!c! Egb = 0.0d0
!c! write (*,*) "a1*a2 = ", a12sq
!c! write (*,*) "Rhead = ", Rhead
!c! write (*,*) "Egb = ", Egb
!c! Derivative of Egb is Ggb...
!c! dFGBdR is used by Quad's later...
- dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
- dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
- / ( 2.0d0 * Fgb )
- dGGBdR = dGGBdFGB * dFGBdR
+ dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
+ dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
+ / ( 2.0d0 * Fgb )
+ dGGBdR = dGGBdFGB * dFGBdR
!c! dGGBdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Fisocav - isotropic cavity creation term
- pom = Rhead * csig
- top = al1 * (dsqrt(pom) + al2 * pom - al3)
- bot = (1.0d0 + al4 * pom**12.0d0)
- botsq = bot * bot
- FisoCav = top / bot
- dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
- dbot = 12.0d0 * al4 * pom ** 11.0d0
- dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
+ pom = Rhead * csig
+ top = al1 * (dsqrt(pom) + al2 * pom - al3)
+ bot = (1.0d0 + al4 * pom**12.0d0)
+ botsq = bot * bot
+ FisoCav = top / bot
+ dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
+ dbot = 12.0d0 * al4 * pom ** 11.0d0
+ dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
!c! dGCVdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Polarization energy
!c! Epol
- MomoFac1 = (1.0d0 - chi1 * sqom2)
- MomoFac2 = (1.0d0 - chi2 * sqom1)
- RR1 = ( R1 * R1 ) / MomoFac1
- RR2 = ( R2 * R2 ) / MomoFac2
- ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
- ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
- fgb1 = sqrt( RR1 + a12sq * ee1 )
- fgb2 = sqrt( RR2 + a12sq * ee2 )
- epol = 332.0d0 * eps_inout_fac * (&
- (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
+ MomoFac1 = (1.0d0 - chi1 * sqom2)
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR1 = ( R1 * R1 ) / MomoFac1
+ RR2 = ( R2 * R2 ) / MomoFac2
+ ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
+ ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
+ fgb1 = sqrt( RR1 + a12sq * ee1 )
+ fgb2 = sqrt( RR2 + a12sq * ee2 )
+ epol = 332.0d0 * eps_inout_fac * (&
+ (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
!c! derivative of Epol is Gpol...
- dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
- dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
- dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
- dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / ( 2.0d0 * fgb2 )
- dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * ( 2.0d0 - 0.5d0 * ee1) ) &
- / ( 2.0d0 * fgb1 )
- dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * ( 2.0d0 - 0.5d0 * ee2) ) &
- / ( 2.0d0 * fgb2 )
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
+ / (fgb1 ** 5.0d0)
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
+ / (fgb2 ** 5.0d0)
+ dFGBdR1 = ( (R1 / MomoFac1) &
+ * ( 2.0d0 - (0.5d0 * ee1) ) )&
+ / ( 2.0d0 * fgb1 )
+ dFGBdR2 = ( (R2 / MomoFac2) &
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / ( 2.0d0 * fgb2 )
+ dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
+ * ( 2.0d0 - 0.5d0 * ee1) ) &
+ / ( 2.0d0 * fgb1 )
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
+ * ( 2.0d0 - 0.5d0 * ee2) ) &
+ / ( 2.0d0 * fgb2 )
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
- dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
- dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
- pom = (pis / Rhead)**6.0d0
- Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
+ dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+ pom = (pis / Rhead)**6.0d0
+ Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! Elj = 0.0d0
!c! derivative of Elj is Glj
- dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ dGLJdR = 4.0d0 * eps_head &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c! dGLJdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Equad
IF (Wqd.ne.0.0d0) THEN
- Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
- - 37.5d0 * ( sqom1 + sqom2 ) &
- + 157.5d0 * ( sqom1 * sqom2 ) &
- - 45.0d0 * om1*om2*om12
- fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
- Equad = fac * Beta1
+ Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
+ - 37.5d0 * ( sqom1 + sqom2 ) &
+ + 157.5d0 * ( sqom1 * sqom2 ) &
+ - 45.0d0 * om1*om2*om12
+ fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
+ Equad = fac * Beta1
!c! Equad = 0.0d0
!c! derivative of Equad...
- dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
+ dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
!c! dQUADdR = 0.0d0
- dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
+ dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
!c! dQUADdOM1 = 0.0d0
- dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
+ dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
!c! dQUADdOM2 = 0.0d0
- dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
+ dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
ELSE
- Beta1 = 0.0d0
- Equad = 0.0d0
- END IF
+ Beta1 = 0.0d0
+ Equad = 0.0d0
+ END IF
!c!-------------------------------------------------------------------
!c! Return the results
!c! Angular stuff
- eom1 = dPOLdOM1 + dQUADdOM1
- eom2 = dPOLdOM2 + dQUADdOM2
- eom12 = dQUADdOM12
+ eom1 = dPOLdOM1 + dQUADdOM1
+ eom2 = dPOLdOM2 + dQUADdOM2
+ eom12 = dQUADdOM12
!c! now some magical transformations to project gradient into
!c! three cartesian vectors
- DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
- END DO
+ DO k = 1, 3
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ END DO
!c! Radial stuff
- DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
- END DO
- erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
- erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
- bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
- federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
- eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
- adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
- facd1 = d1 * vbld_inv(i+nres)
- facd2 = d2 * vbld_inv(j+nres)
- facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
- facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
- DO k = 1, 3
- hawk = erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
- condor = erhead_tail(k,2) + &
- facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j+nres)
+ facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+ facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
+ DO k = 1, 3
+ hawk = erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
+ condor = erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
!c! this acts on hydrophobic center of interaction
- gheadtail(k,1,1) = gheadtail(k,1,1) &
- - dGCLdR * pom &
- - dGGBdR * pom &
- - dGCVdR * pom &
- - dPOLdR1 * hawk &
- - dPOLdR2 * (erhead_tail(k,2) &
+ gheadtail(k,1,1) = gheadtail(k,1,1) &
+ - dGCLdR * pom &
+ - dGGBdR * pom &
+ - dGCVdR * pom &
+ - dPOLdR1 * hawk &
+ - dPOLdR2 * (erhead_tail(k,2) &
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
- - dGLJdR * pom &
- - dQUADdR * pom&
- - tuna(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ - dGLJdR * pom &
+ - dQUADdR * pom&
+ - tuna(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
!c! this acts on hydrophobic center of interaction
- gheadtail(k,2,1) = gheadtail(k,2,1) &
- + dGCLdR * pom &
- + dGGBdR * pom &
- + dGCVdR * pom &
- + dPOLdR1 * (erhead_tail(k,1) &
+ gheadtail(k,2,1) = gheadtail(k,2,1) &
+ + dGCLdR * pom &
+ + dGGBdR * pom &
+ + dGCVdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1) &
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
- + dPOLdR2 * condor &
- + dGLJdR * pom &
- + dQUADdR * pom &
- + tuna(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ + dPOLdR2 * condor &
+ + dGLJdR * pom &
+ + dQUADdR * pom &
+ + tuna(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! this acts on Calpha
- gheadtail(k,3,1) = gheadtail(k,3,1) &
- - dGCLdR * erhead(k)&
- - dGGBdR * erhead(k)&
- - dGCVdR * erhead(k)&
- - dPOLdR1 * erhead_tail(k,1)&
- - dPOLdR2 * erhead_tail(k,2)&
- - dGLJdR * erhead(k) &
- - dQUADdR * erhead(k)&
- - tuna(k)
+ gheadtail(k,3,1) = gheadtail(k,3,1) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k) &
+ - dQUADdR * erhead(k)&
+ - tuna(k)
!c! this acts on Calpha
- gheadtail(k,4,1) = gheadtail(k,4,1) &
- + dGCLdR * erhead(k) &
- + dGGBdR * erhead(k) &
- + dGCVdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k) &
- + dQUADdR * erhead(k)&
- + tuna(k)
- END DO
- ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
- eheadtail = eheadtail &
- + wstate(istate, itypi, itypj) &
- * dexp(-betaT * ener(istate))
+ gheadtail(k,4,1) = gheadtail(k,4,1) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k) &
+ + dQUADdR * erhead(k)&
+ + tuna(k)
+ END DO
+ ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
+ eheadtail = eheadtail &
+ + wstate(istate, itypi, itypj) &
+ * dexp(-betaT * ener(istate))
!c! foreach cartesian dimension
- DO k = 1, 3
+ DO k = 1, 3
!c! foreach of two gvdwx and gvdwc
- DO l = 1, 4
- gheadtail(k,l,2) = gheadtail(k,l,2) &
- + wstate( istate, itypi, itypj ) &
- * dexp(-betaT * ener(istate)) &
- * gheadtail(k,l,1)
- gheadtail(k,l,1) = 0.0d0
- END DO
- END DO
+ DO l = 1, 4
+ gheadtail(k,l,2) = gheadtail(k,l,2) &
+ + wstate( istate, itypi, itypj ) &
+ * dexp(-betaT * ener(istate)) &
+ * gheadtail(k,l,1)
+ gheadtail(k,l,1) = 0.0d0
+ END DO
+ END DO
END DO
!c! Here ended the gigantic DO istate = 1, 4, which starts
!c! at the beggining of the subroutine
DO k = 1, 3
- DO l = 1, 4
- gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
- END DO
- gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
- gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
- gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
- gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
- DO l = 1, 4
- gheadtail(k,l,1) = 0.0d0
- gheadtail(k,l,2) = 0.0d0
- END DO
+ DO l = 1, 4
+ gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
+ END DO
+ gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
+ gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
+ gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
+ gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
+ DO l = 1, 4
+ gheadtail(k,l,1) = 0.0d0
+ gheadtail(k,l,2) = 0.0d0
+ END DO
END DO
eheadtail = (-dlog(eheadtail)) / betaT
dPOLdOM1 = 0.0d0
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
fgb1 = sqrt( RR1 + a12sq * ee1)
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
DO k = 1, 3
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
END DO
bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- gvdwx(k,i) = gvdwx(k,i) &
- - dPOLdR1 * hawk
- gvdwx(k,j) = gvdwx(k,j) &
- + dPOLdR1 * (erhead_tail(k,1) &
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR1 * hawk
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR1 * (erhead_tail(k,1) &
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
- gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
- gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
+ gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
+ gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
END DO
RETURN
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! Return the results
!c! (See comments in Eqq)
DO k = 1, 3
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
facd2 = d2 * vbld_inv(j+nres)
facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ condor = (erhead_tail(k,2) &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
- gvdwx(k,i) = gvdwx(k,i) &
- - dPOLdR2 * (erhead_tail(k,2) &
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR2 * (erhead_tail(k,2) &
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
- gvdwx(k,j) = gvdwx(k,j) &
- + dPOLdR2 * condor
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR2 * condor
- gvdwc(k,i) = gvdwc(k,i) &
- - dPOLdR2 * erhead_tail(k,2)
- gvdwc(k,j) = gvdwc(k,j) &
- + dPOLdR2 * erhead_tail(k,2)
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dPOLdR2 * erhead_tail(k,2)
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dPOLdR2 * erhead_tail(k,2)
END DO
RETURN
END SUBROUTINE enq
+
+ SUBROUTINE enq_cat(Epol)
+ use calc_data
+ use comm_momo
+ double precision facd3, adler,epol
+ alphapol2 = alphapolcat(itypi,itypj)
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ R2 = dsqrt(R2)
+
+!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
+!c! & +dhead(1,1,itypi,itypj))**2))
+!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
+!c! & +dhead(2,1,itypi,itypj))**2))
+!c------------------------------------------------------------------------
+!c Polarization energy
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR2 = R2 * R2 / MomoFac2
+ ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
+ fgb2 = sqrt(RR2 + a12sq * ee2)
+ epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
+ / (fgb2 ** 5.0d0)
+ dFGBdR2 = ( (R2 / MomoFac2) &
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+
+!c!-------------------------------------------------------------------
+!c! Return the results
+!c! (See comments in Eqq)
+ DO k = 1, 3
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd2 = d2 * vbld_inv(j+nres)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ DO k = 1, 3
+ condor = (erhead_tail(k,2) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
+
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
+! gradpepcatx(k,j) = gradpepcatx(k,j) &
+! + dPOLdR2 * condor
+
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dPOLdR2 * erhead_tail(k,2)
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dPOLdR2 * erhead_tail(k,2)
+
+ END DO
+ RETURN
+ END SUBROUTINE enq_cat
+
SUBROUTINE eqd(Ecl,Elj,Epol)
use calc_data
use comm_momo
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ END DO
+!c! Pitagoras
+ R1 = dsqrt(R1)
+
+!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
+!c! & +dhead(1,1,itypi,itypj))**2))
+!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
+!c! & +dhead(2,1,itypi,itypj))**2))
+
+!c!-------------------------------------------------------------------
+!c! ecl
+ sparrow = w1 * Qi * om1
+ hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
+ Ecl = sparrow / Rhead**2.0d0 &
+ - hawk / Rhead**4.0d0
+ dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0
+!c! dF/dom1
+ dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
+!c Polarization energy
+!c Epol
+ MomoFac1 = (1.0d0 - chi1 * sqom2)
+ RR1 = R1 * R1 / MomoFac1
+ ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
+ fgb1 = sqrt( RR1 + a12sq * ee1)
+ epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
+!c! epol = 0.0d0
+!c!------------------------------------------------------------------
+!c! derivative of Epol is Gpol...
+ dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
+ / (fgb1 ** 5.0d0)
+ dFGBdR1 = ( (R1 / MomoFac1) &
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
+ dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1
+!c! dPOLdR1 = 0.0d0
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+!c! dPOLdOM2 = 0.0d0
+!c!-------------------------------------------------------------------
+!c! Elj
+ pom = (pis / Rhead)**6.0d0
+ Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
+!c! derivative of Elj is Glj
+ dGLJdR = 4.0d0 * eps_head &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ END DO
+
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j+nres)
+ facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
+
+ DO k = 1, 3
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dGCLdR * pom&
+ - dPOLdR1 * hawk &
+ - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1) &
+ -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
+ + dGLJdR * pom
+
+
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1) &
+ - dGLJdR * erhead(k)
+
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dGLJdR * erhead(k)
+
+ END DO
+ RETURN
+ END SUBROUTINE eqd
+ SUBROUTINE edq(Ecl,Elj,Epol)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
+
+ double precision facd3, adler,ecl,elj,epol
+ alphapol2 = alphapol(itypj,itypi)
+ w1 = wqdip(1,itypi,itypj)
+ w2 = wqdip(2,itypi,itypj)
+ pis = sig0head(itypi,itypj)
+ eps_head = epshead(itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ R2 = dsqrt(R2)
+
+!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
+!c! & +dhead(1,1,itypi,itypj))**2))
+!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
+!c! & +dhead(2,1,itypi,itypj))**2))
+
+
+!c!-------------------------------------------------------------------
+!c! ecl
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+ ECL = sparrow / Rhead**2.0d0 &
+ - hawk / Rhead**4.0d0
+!c!-------------------------------------------------------------------
+!c! derivative of ecl is Gcl
+!c! dF/dr part
+ dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0
+!c! dF/dom1
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
+!c Polarization energy
+!c Epol
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR2 = R2 * R2 / MomoFac2
+ ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
+ fgb2 = sqrt(RR2 + a12sq * ee2)
+ epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
+ / (fgb2 ** 5.0d0)
+ dFGBdR2 = ( (R2 / MomoFac2) &
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+!c!-------------------------------------------------------------------
+!c! Elj
+ pom = (pis / Rhead)**6.0d0
+ Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
+!c! derivative of Elj is Glj
+ dGLJdR = 4.0d0 * eps_head &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+!c!-------------------------------------------------------------------
+!c! Return the results
+!c! (see comments in Eqq)
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j+nres)
+ facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+ DO k = 1, 3
+ condor = (erhead_tail(k,2) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
+ - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR2 * condor &
+ + dGLJdR * pom
+
+
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k)
+
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)
+
+ END DO
+ RETURN
+ END SUBROUTINE edq
+
+ SUBROUTINE edq_cat(Ecl,Elj,Epol)
+ use comm_momo
+ use calc_data
+
+ double precision facd3, adler,ecl,elj,epol
+ alphapol2 = alphapolcat(itypi,itypj)
+ w1 = wqdipcat(1,itypi,itypj)
+ w2 = wqdipcat(2,itypi,itypj)
+ pis = sig0headcat(itypi,itypj)
+ eps_head = epsheadcat(itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
- R1 = dsqrt(R1)
+ R2 = dsqrt(R2)
!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
!c! & +dhead(1,1,itypi,itypj))**2))
!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
!c! & +dhead(2,1,itypi,itypj))**2))
+
!c!-------------------------------------------------------------------
!c! ecl
- sparrow = w1 * Qi * om1
- hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
- Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+! write(iout,*) "KURWA2",Rhead
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+ ECL = sparrow / Rhead**2.0d0 &
+ - hawk / Rhead**4.0d0
+!c!-------------------------------------------------------------------
+!c! derivative of ecl is Gcl
+!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
- dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
!c! dF/dom2
- dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
!c--------------------------------------------------------------------
!c Polarization energy
!c Epol
- MomoFac1 = (1.0d0 - chi1 * sqom2)
- RR1 = R1 * R1 / MomoFac1
- ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
- fgb1 = sqrt( RR1 + a12sq * ee1)
- epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
-!c! epol = 0.0d0
-!c!------------------------------------------------------------------
-!c! derivative of Epol is Gpol...
- dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
- dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
- dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
-!c! dPOLdR1 = 0.0d0
- dPOLdOM1 = 0.0d0
- dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
-!c! dPOLdOM2 = 0.0d0
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR2 = R2 * R2 / MomoFac2
+ ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
+ fgb2 = sqrt(RR2 + a12sq * ee2)
+ epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
+ / (fgb2 ** 5.0d0)
+ dFGBdR2 = ( (R2 / MomoFac2) &
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
!c!-------------------------------------------------------------------
!c! Elj
pom = (pis / Rhead)**6.0d0
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+!c!-------------------------------------------------------------------
+
+!c! Return the results
+!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
-
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
- erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
- bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
- federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
+ erdxj = scalar( erhead(1), dC_norm(1,j) )
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
facd1 = d1 * vbld_inv(i+nres)
- facd2 = d2 * vbld_inv(j+nres)
- facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
-
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ condor = (erhead_tail(k,2) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - dGCLdR * pom&
- - dPOLdR1 * hawk &
- - dGLJdR * pom
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
+ - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) &
- + dGCLdR * pom &
- + dPOLdR1 * (erhead_tail(k,1) &
- -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
- + dGLJdR * pom
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepcatx(k,j) = gradpepcatx(k,j) &
+! + dGCLdR * pom &
+! + dPOLdR2 * condor &
+! + dGLJdR * pom
- gvdwc(k,i) = gvdwc(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1) &
- - dGLJdR * erhead(k)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k)
- gvdwc(k,j) = gvdwc(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dGLJdR * erhead(k)
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)
END DO
RETURN
- END SUBROUTINE eqd
- SUBROUTINE edq(Ecl,Elj,Epol)
-! IMPLICIT NONE
- use comm_momo
+ END SUBROUTINE edq_cat
+
+ SUBROUTINE edq_cat_pep(Ecl,Elj,Epol)
+ use comm_momo
use calc_data
double precision facd3, adler,ecl,elj,epol
- alphapol2 = alphapol(itypj,itypi)
- w1 = wqdip(1,itypi,itypj)
- w2 = wqdip(2,itypi,itypj)
- pis = sig0head(itypi,itypj)
- eps_head = epshead(itypi,itypj)
+ alphapol2 = alphapolcat(itypi,itypj)
+ w1 = wqdipcat(1,itypi,itypj)
+ w2 = wqdipcat(2,itypi,itypj)
+ pis = sig0headcat(itypi,itypj)
+ eps_head = epsheadcat(itypi,itypj)
!c!-------------------------------------------------------------------
!c! R2 - distance between head of jth side chain and tail of ith sidechain
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
!c!-------------------------------------------------------------------
!c! ecl
- sparrow = w1 * Qi * om1
- hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+! print *,"CO2", itypi,itypj
+! print *,"CO?!.", w1,w2,Qj,om1
ECL = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
- dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
!c! dF/dom2
- dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
!c--------------------------------------------------------------------
!c Polarization energy
!c Epol
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
+
!c! Return the results
!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
- erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
- erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
- eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
- adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
- facd1 = d1 * vbld_inv(i+nres)
- facd2 = d2 * vbld_inv(j+nres)
- facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+ erdxi = scalar( erhead(1), dC_norm(1,i) )
+ erdxj = scalar( erhead(1), dC_norm(1,j) )
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i) )
+ facd1 = d1 * vbld_inv(i+1)/2.0
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+1)/2.0
DO k = 1, 3
- condor = (erhead_tail(k,2) &
- + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - dGCLdR * pom &
- - dPOLdR2 * (erhead_tail(k,2) &
- -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
- - dGLJdR * pom
-
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) &
- + dGCLdR * pom &
- + dPOLdR2 * condor &
- + dGLJdR * pom
-
-
- gvdwc(k,i) = gvdwc(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR2 * erhead_tail(k,2) &
- - dGLJdR * erhead(k)
-
- gvdwc(k,j) = gvdwc(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k)
+ condor = (erhead_tail(k,2) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i))
+! gradpepcatx(k,i) = gradpepcatx(k,i) &
+! - dGCLdR * pom &
+! - dPOLdR2 * (erhead_tail(k,2) &
+! -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
+! - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepcatx(k,j) = gradpepcatx(k,j) &
+! + dGCLdR * pom &
+! + dPOLdR2 * condor &
+! + dGLJdR * pom
+
+
+ gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))
+ gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))
+
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)
END DO
RETURN
- END SUBROUTINE edq
+ END SUBROUTINE edq_cat_pep
+
SUBROUTINE edd(ECL)
! IMPLICIT NONE
use comm_momo
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
ECL = c1 - c2
!c! write (*,*) "w1 = ", w1
!c! write (*,*) "w2 = ", w2
!c! dECL/dr
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
dGCLdR = c1 - c2
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
dGCLdOM1 = c1 - c2
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
dGCLdOM2 = c1 - c2
!c! dECL/dom12
c1 = w1 / (Rhead ** 3.0d0)
c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
dGCLdOM12 = c1 - c2
!c!-------------------------------------------------------------------
-!c! Return the results
-!c! (see comments in Eqq)
- DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- END DO
- erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
- erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
- facd1 = d1 * vbld_inv(i+nres)
- facd2 = d2 * vbld_inv(j+nres)
+!c! Return the results
+!c! (see comments in Eqq)
+ DO k= 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ END DO
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j+nres)
+ DO k = 1, 3
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
+
+ gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
+ gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
+ END DO
+ RETURN
+ END SUBROUTINE edd
+ SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
+
+ real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
+ eps_out=80.0d0
+ itypi = itype(i,1)
+ itypj = itype(j,1)
+!c! 1/(Gas Constant * Thermostate temperature) = BetaT
+!c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
+!c! t_bath = 300
+!c! BetaT = 1.0d0 / (t_bath * Rb)i
+ Rb=0.001986d0
+ BetaT = 1.0d0 / (298.0d0 * Rb)
+!c! Gay-berne var's
+ sig0ij = sigma( itypi,itypj )
+ chi1 = chi( itypi, itypj )
+ chi2 = chi( itypj, itypi )
+ chi12 = chi1 * chi2
+ chip1 = chipp( itypi, itypj )
+ chip2 = chipp( itypj, itypi )
+ chip12 = chip1 * chip2
+! chi1=0.0
+! chi2=0.0
+! chi12=0.0
+! chip1=0.0
+! chip2=0.0
+! chip12=0.0
+!c! not used by momo potential, but needed by sc_angular which is shared
+!c! by all energy_potential subroutines
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+!c! location, location, location
+! xj = c( 1, nres+j ) - xi
+! yj = c( 2, nres+j ) - yi
+! zj = c( 3, nres+j ) - zi
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
+!c! distance from center of chain(?) to polar/charged head
+!c! write (*,*) "istate = ", 1
+!c! write (*,*) "ii = ", 1
+!c! write (*,*) "jj = ", 1
+ d1 = dhead(1, 1, itypi, itypj)
+ d2 = dhead(2, 1, itypi, itypj)
+!c! ai*aj from Fgb
+ a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+!c! a12sq = a12sq * a12sq
+!c! charge of amino acid itypi is...
+ Qi = icharge(itypi)
+ Qj = icharge(itypj)
+ Qij = Qi * Qj
+!c! chis1,2,12
+ chis1 = chis(itypi,itypj)
+ chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1(itypi,itypj)
+ sig2 = sigmap2(itypi,itypj)
+!c! write (*,*) "sig1 = ", sig1
+!c! write (*,*) "sig2 = ", sig2
+!c! alpha factors from Fcav/Gcav
+ b1cav = alphasur(1,itypi,itypj)
+! b1cav=0.0
+ b2cav = alphasur(2,itypi,itypj)
+ b3cav = alphasur(3,itypi,itypj)
+ b4cav = alphasur(4,itypi,itypj)
+ wqd = wquad(itypi, itypj)
+!c! used by Fgb
+ eps_in = epsintab(itypi,itypj)
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+!c! write (*,*) "eps_inout_fac = ", eps_inout_fac
+!c!-------------------------------------------------------------------
+!c! tail location and distance calculations
+ Rtail = 0.0d0
+ DO k = 1, 3
+ ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ END DO
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
+ Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
+ Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+!c!-------------------------------------------------------------------
+!c! Calculate location and distance between polar heads
+!c! distance between heads
+!c! for each one of our three dimensional space...
+ d1 = dhead(1, 1, itypi, itypj)
+ d2 = dhead(2, 1, itypi, itypj)
+
+ DO k = 1,3
+!c! location of polar head is computed by taking hydrophobic centre
+!c! and moving by a d1 * dc_norm vector
+!c! see unres publications for very informative images
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+!c! distance
+!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
+ END DO
+!c! pitagoras (root of sum of squares)
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+!c!-------------------------------------------------------------------
+!c! zero everything that should be zero'ed
+ Egb = 0.0d0
+ ECL = 0.0d0
+ Elj = 0.0d0
+ Equad = 0.0d0
+ Epol = 0.0d0
+ eheadtail = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+ RETURN
+ END SUBROUTINE elgrad_init
+
+
+ SUBROUTINE elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ use comm_momo
+ use calc_data
+ real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
+ eps_out=80.0d0
+ itypi = itype(i,1)
+ itypj = itype(j,5)
+!c! 1/(Gas Constant * Thermostate temperature) = BetaT
+!c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
+!c! t_bath = 300
+!c! BetaT = 1.0d0 / (t_bath * Rb)i
+ Rb=0.001986d0
+ BetaT = 1.0d0 / (298.0d0 * Rb)
+!c! Gay-berne var's
+ sig0ij = sigmacat( itypi,itypj )
+ chi1 = chi1cat( itypi, itypj )
+ chi2 = 0.0d0
+ chi12 = 0.0d0
+ chip1 = chipp1cat( itypi, itypj )
+ chip2 = 0.0d0
+ chip12 = 0.0d0
+!c! not used by momo potential, but needed by sc_angular which is shared
+!c! by all energy_potential subroutines
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ dxj = 0.0d0 !dc_norm( 1, nres+j )
+ dyj = 0.0d0 !dc_norm( 2, nres+j )
+ dzj = 0.0d0 !dc_norm( 3, nres+j )
+!c! distance from center of chain(?) to polar/charged head
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
+!c! ai*aj from Fgb
+ a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
+!c! a12sq = a12sq * a12sq
+!c! charge of amino acid itypi is...
+ Qi = icharge(itypi)
+ Qj = ichargecat(itypj)
+ Qij = Qi * Qj
+!c! chis1,2,12
+ chis1 = chis1cat(itypi,itypj)
+ chis2 = 0.0d0
+ chis12 = 0.0d0
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2 = sigmap2cat(itypi,itypj)
+!c! alpha factors from Fcav/Gcav
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+ wqd = wquadcat(itypi, itypj)
+!c! used by Fgb
+ eps_in = epsintabcat(itypi,itypj)
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+!c!-------------------------------------------------------------------
+!c! tail location and distance calculations
+ Rtail = 0.0d0
DO k = 1, 3
+ ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
+ END DO
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
+ Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
+ Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+!c!-------------------------------------------------------------------
+!c! Calculate location and distance between polar heads
+!c! distance between heads
+!c! for each one of our three dimensional space...
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
-
- gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
- gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
+ DO k = 1,3
+!c! location of polar head is computed by taking hydrophobic centre
+!c! and moving by a d1 * dc_norm vector
+!c! see unres publications for very informative images
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
+!c! distance
+!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
+!c! pitagoras (root of sum of squares)
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+!c!-------------------------------------------------------------------
+!c! zero everything that should be zero'ed
+ Egb = 0.0d0
+ ECL = 0.0d0
+ Elj = 0.0d0
+ Equad = 0.0d0
+ Epol = 0.0d0
+ eheadtail = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
RETURN
- END SUBROUTINE edd
- SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
-! IMPLICIT NONE
- use comm_momo
+ END SUBROUTINE elgrad_init_cat
+
+ SUBROUTINE elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ use comm_momo
use calc_data
-
real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
eps_out=80.0d0
- itypi = itype(i,1)
- itypj = itype(j,1)
+ itypi = 10
+ itypj = itype(j,5)
!c! 1/(Gas Constant * Thermostate temperature) = BetaT
!c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
!c! t_bath = 300
Rb=0.001986d0
BetaT = 1.0d0 / (298.0d0 * Rb)
!c! Gay-berne var's
- sig0ij = sigma( itypi,itypj )
- chi1 = chi( itypi, itypj )
- chi2 = chi( itypj, itypi )
- chi12 = chi1 * chi2
- chip1 = chipp( itypi, itypj )
- chip2 = chipp( itypj, itypi )
- chip12 = chip1 * chip2
-! chi1=0.0
-! chi2=0.0
-! chi12=0.0
-! chip1=0.0
-! chip2=0.0
-! chip12=0.0
+ sig0ij = sigmacat( itypi,itypj )
+ chi1 = chi1cat( itypi, itypj )
+ chi2 = 0.0d0
+ chi12 = 0.0d0
+ chip1 = chipp1cat( itypi, itypj )
+ chip2 = 0.0d0
+ chip12 = 0.0d0
!c! not used by momo potential, but needed by sc_angular which is shared
!c! by all energy_potential subroutines
alf1 = 0.0d0
alf2 = 0.0d0
alf12 = 0.0d0
-!c! location, location, location
-! xj = c( 1, nres+j ) - xi
-! yj = c( 2, nres+j ) - yi
-! zj = c( 3, nres+j ) - zi
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ dxj = 0.0d0 !dc_norm( 1, nres+j )
+ dyj = 0.0d0 !dc_norm( 2, nres+j )
+ dzj = 0.0d0 !dc_norm( 3, nres+j )
!c! distance from center of chain(?) to polar/charged head
-!c! write (*,*) "istate = ", 1
-!c! write (*,*) "ii = ", 1
-!c! write (*,*) "jj = ", 1
- d1 = dhead(1, 1, itypi, itypj)
- d2 = dhead(2, 1, itypi, itypj)
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
!c! ai*aj from Fgb
- a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
!c! a12sq = a12sq * a12sq
!c! charge of amino acid itypi is...
- Qi = icharge(itypi)
- Qj = icharge(itypj)
- Qij = Qi * Qj
+ Qi = 0
+ Qj = ichargecat(itypj)
+! Qij = Qi * Qj
!c! chis1,2,12
- chis1 = chis(itypi,itypj)
- chis2 = chis(itypj,itypi)
- chis12 = chis1 * chis2
- sig1 = sigmap1(itypi,itypj)
- sig2 = sigmap2(itypi,itypj)
-!c! write (*,*) "sig1 = ", sig1
-!c! write (*,*) "sig2 = ", sig2
+ chis1 = chis1cat(itypi,itypj)
+ chis2 = 0.0d0
+ chis12 = 0.0d0
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2 = sigmap2cat(itypi,itypj)
!c! alpha factors from Fcav/Gcav
- b1cav = alphasur(1,itypi,itypj)
-! b1cav=0.0
- b2cav = alphasur(2,itypi,itypj)
- b3cav = alphasur(3,itypi,itypj)
- b4cav = alphasur(4,itypi,itypj)
- wqd = wquad(itypi, itypj)
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+ wqd = wquadcat(itypi, itypj)
!c! used by Fgb
- eps_in = epsintab(itypi,itypj)
+ eps_in = epsintabcat(itypi,itypj)
eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
-!c! write (*,*) "eps_inout_fac = ", eps_inout_fac
!c!-------------------------------------------------------------------
!c! tail location and distance calculations
Rtail = 0.0d0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i)
+ ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
!c!-------------------------------------------------------------------
!c! Calculate location and distance between polar heads
!c! distance between heads
!c! for each one of our three dimensional space...
- d1 = dhead(1, 1, itypi, itypj)
- d2 = dhead(2, 1, itypi, itypj)
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
DO k = 1,3
!c! location of polar head is computed by taking hydrophobic centre
!c! and moving by a d1 * dc_norm vector
!c! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+ chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
+ chead(k,2) = c(k, j)
!c! distance
!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
!c! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!c!-------------------------------------------------------------------
!c! zero everything that should be zero'ed
Egb = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
RETURN
- END SUBROUTINE elgrad_init
+ END SUBROUTINE elgrad_init_cat_pep
+
+ double precision function tschebyshev(m,n,x,y)
+ implicit none
+ integer i,m,n
+ double precision x(n),y,yy(0:maxvar),aux
+!c Tschebyshev polynomial. Note that the first term is omitted
+!c m=0: the constant term is included
+!c m=1: the constant term is not included
+ yy(0)=1.0d0
+ yy(1)=y
+ do i=2,n
+ yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
+ enddo
+ aux=0.0d0
+ do i=m,n
+ aux=aux+x(i)*yy(i)
+ enddo
+ tschebyshev=aux
+ return
+ end function tschebyshev
+!C--------------------------------------------------------------------------
+ double precision function gradtschebyshev(m,n,x,y)
+ implicit none
+ integer i,m,n
+ double precision x(n+1),y,yy(0:maxvar),aux
+!c Tschebyshev polynomial. Note that the first term is omitted
+!c m=0: the constant term is included
+!c m=1: the constant term is not included
+ yy(0)=1.0d0
+ yy(1)=2.0d0*y
+ do i=2,n
+ yy(i)=2*y*yy(i-1)-yy(i-2)
+ enddo
+ aux=0.0d0
+ do i=m,n
+ aux=aux+x(i+1)*yy(i)*(i+1)
+!C print *, x(i+1),yy(i),i
+ enddo
+ gradtschebyshev=aux
+ return
+ end function gradtschebyshev
+
+ subroutine make_SCSC_inter_list
+ include 'mpif.h'
+ real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real*8 :: dist_init, dist_temp,r_buff_list
+ integer:: contlisti(250*nres),contlistj(250*nres)
+! integer :: newcontlisti(200*nres),newcontlistj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_sc,g_ilist_sc
+ integer displ(0:nprocs),i_ilist_sc(0:nprocs),ierr
+! print *,"START make_SC"
+ r_buff_list=5.0
+ ilist_sc=0
+ do i=iatsc_s,iatsc_e
+ itypi=iabs(itype(i,1))
+ if (itypi.eq.ntyp1) cycle
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ do iint=1,nint_gr(i)
+! print *,"is it wrong", iint,i
+ do j=istart(i,iint),iend(i,iint)
+ itypj=iabs(itype(j,1))
+ if (energy_dec) write(iout,*) "LISTA ZAKRES",istart(i,iint),iend(i,iint),iatsc_s,iatsc_e
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+! dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+! r_buff_list is a read value for a buffer
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_sc=ilist_sc+1
+! this can be substituted by cantor and anti-cantor
+ contlisti(ilist_sc)=i
+ contlistj(ilist_sc)=j
+
+ endif
+ enddo
+ enddo
+ enddo
+! call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+! MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! call MPI_Gather(newnss,1,MPI_INTEGER,&
+! i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_sc
+ do i=1,ilist_sc
+ write (iout,*) i,contlisti(i),contlistj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_sc,1,MPI_INTEGER,&
+ i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_sc(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,&
+ newcontlisti,i_ilist_sc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,&
+ newcontlistj,i_ilist_sc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ else
+ g_ilist_sc=ilist_sc
+
+ do i=1,ilist_sc
+ newcontlisti(i)=contlisti(i)
+ newcontlistj(i)=contlistj(i)
+ enddo
+ endif
+
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_sc
+ do i=1,g_ilist_sc
+ write (iout,*) i,newcontlisti(i),newcontlistj(i)
+ enddo
+#endif
+ call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
+ return
+ end subroutine make_SCSC_inter_list
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ subroutine make_SCp_inter_list
+ use MD_data, only: itime_mat
+
+ include 'mpif.h'
+ real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real*8 :: dist_init, dist_temp,r_buff_list
+ integer:: contlistscpi(350*nres),contlistscpj(350*nres)
+! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_scp,g_ilist_scp
+ integer displ(0:nprocs),i_ilist_scp(0:nprocs),ierr
+! print *,"START make_SC"
+ r_buff_list=5.0
+ ilist_scp=0
+ do i=iatscp_s,iatscp_e
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ 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))
+ call to_box(xi,yi,zi)
+ do iint=1,nscp_gr(i)
+
+ do j=iscpstart(i,iint),iscpend(i,iint)
+ itypj=iabs(itype(j,1))
+ if (itypj.eq.ntyp1) cycle
+! Uncomment following three lines for SC-p interactions
+! xj=c(1,nres+j)-xi
+! yj=c(2,nres+j)-yi
+! zj=c(3,nres+j)-zi
+! Uncomment following three lines for Ca-p interactions
+! xj=c(1,j)-xi
+! yj=c(2,j)-yi
+! zj=c(3,j)-zi
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+#ifdef DEBUG
+ ! r_buff_list is a read value for a buffer
+ if ((sqrt(dist_init).le.(r_cut_ele)).and.(ifirstrun.eq.0)) then
+! Here the list is created
+ ilist_scp_first=ilist_scp_first+1
+! this can be substituted by cantor and anti-cantor
+ contlistscpi_f(ilist_scp_first)=i
+ contlistscpj_f(ilist_scp_first)=j
+ endif
+#endif
+! r_buff_list is a read value for a buffer
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_scp=ilist_scp+1
+! this can be substituted by cantor and anti-cantor
+ contlistscpi(ilist_scp)=i
+ contlistscpj(ilist_scp)=j
+ endif
+ enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_scp
+ do i=1,ilist_scp
+ write (iout,*) i,contlistscpi(i),contlistscpj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_scp,g_ilist_scp,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_scp,1,MPI_INTEGER,&
+ i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_scp(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,&
+ newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,&
+ newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ else
+ g_ilist_scp=ilist_scp
+
+ do i=1,ilist_scp
+ newcontlistscpi(i)=contlistscpi(i)
+ newcontlistscpj(i)=contlistscpj(i)
+ enddo
+ endif
+
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_scp
+ do i=1,g_ilist_scp
+ write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
+ enddo
+
+! if (ifirstrun.eq.0) ifirstrun=1
+! do i=1,ilist_scp_first
+! do j=1,g_ilist_scp
+! if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
+! (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
+! enddo
+! print *,itime_mat,"ERROR matrix needs updating"
+! print *,contlistscpi_f(i),contlistscpj_f(i)
+! 126 continue
+! enddo
+#endif
+ call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
+
+ return
+ end subroutine make_SCp_inter_list
+
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+
+
+ subroutine make_pp_inter_list
+ include 'mpif.h'
+ real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real*8 :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
+ real*8 :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
+ real*8 :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ integer:: contlistppi(250*nres),contlistppj(250*nres)
+! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_pp,g_ilist_pp
+ integer displ(0:nprocs),i_ilist_pp(0:nprocs),ierr
+! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list
+ ilist_pp=0
+ r_buff_list=5.0
+ do i=iatel_s,iatel_e
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+! write (iout,*) i,j,itype(i,1),itype(j,1)
+! if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
+
+! 1,j)
+ do j=ielstart(i),ielend(i)
+! write (iout,*) i,j,itype(i,1),itype(j,1)
+ if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+! xj=c(1,j)+0.5D0*dxj-xmedi
+! yj=c(2,j)+0.5D0*dyj-ymedi
+! zj=c(3,j)+0.5D0*dzj-zmedi
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_pp=ilist_pp+1
+! this can be substituted by cantor and anti-cantor
+ contlistppi(ilist_pp)=i
+ contlistppj(ilist_pp)=j
+ endif
+! enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_pp
+ do i=1,ilist_pp
+ write (iout,*) i,contlistppi(i),contlistppj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_pp,g_ilist_pp,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_pp,1,MPI_INTEGER,&
+ i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_pp(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,&
+ newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,&
+ newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ else
+ g_ilist_pp=ilist_pp
+
+ do i=1,ilist_pp
+ newcontlistppi(i)=contlistppi(i)
+ newcontlistppj(i)=contlistppj(i)
+ enddo
+ endif
+ call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_pp
+ do i=1,g_ilist_pp
+ write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
+ enddo
+#endif
+ return
+ end subroutine make_pp_inter_list
+
+!-----------------------------------------------------------------------------
+ double precision function boxshift(x,boxsize)
+ implicit none
+ double precision x,boxsize
+ double precision xtemp
+ xtemp=dmod(x,boxsize)
+ if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then
+ boxshift=xtemp-boxsize
+ else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then
+ boxshift=xtemp+boxsize
+ else
+ boxshift=xtemp
+ endif
+ return
+ end function boxshift
+!-----------------------------------------------------------------------------
+ subroutine to_box(xi,yi,zi)
+ implicit none
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+ double precision xi,yi,zi
+ xi=dmod(xi,boxxsize)
+ if (xi.lt.0.0d0) xi=xi+boxxsize
+ yi=dmod(yi,boxysize)
+ if (yi.lt.0.0d0) yi=yi+boxysize
+ zi=dmod(zi,boxzsize)
+ if (zi.lt.0.0d0) zi=zi+boxzsize
+ return
+ end subroutine to_box
+!--------------------------------------------------------------------------
+ subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ implicit none
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+ double precision xi,yi,zi,sslipi,ssgradlipi
+ double precision fracinbuf
+! double precision sscalelip,sscagradlip
+#ifdef DEBUG
+ write (iout,*) "bordlipbot",bordlipbot," bordliptop",bordliptop
+ write (iout,*) "buflipbot",buflipbot," lipbufthick",lipbufthick
+ write (iout,*) "xi yi zi",xi,yi,zi
+#endif
+ if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then
+! the energy transfer exist
+ if (zi.lt.buflipbot) then
+! what fraction I am in
+ fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
+! lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+#ifdef DEBUG
+ write (iout,*) "sslipi",sslipi," ssgradlipi",ssgradlipi
+#endif
+ return
+ end subroutine lipid_layer
+
+!--------------------------------------------------------------------------
+!--------------------------------------------------------------------------
end module energy
projects / unres4.git / blobdiff