!-----------------------------------------------------------------------------
! Maximum number of SC local term fitting function coefficiants
integer,parameter :: maxsccoef=65
+! Maximum number of local shielding effectors
+! integer,parameter :: maxcontsshi=50
!-----------------------------------------------------------------------------
! commom.calc common/calc/
!-----------------------------------------------------------------------------
! common /contacts/
! Change 12/1/95 - common block CONTACTS1 included.
! common /contacts1/
- integer,dimension(:),allocatable :: num_cont !(maxres)
- integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
- real(kind=8),dimension(:,:),allocatable :: facont !(maxconts,maxres)
- real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
+
+ integer,dimension(:),allocatable :: num_cont !(maxres)
+ integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
+ real(kind=8),dimension(:,:),allocatable :: facont,ees0plist !(maxconts,maxres)
+ real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
+ integer,dimension(:),allocatable :: ishield_list
+ integer,dimension(:,:),allocatable :: shield_list
+ real(kind=8),dimension(:),allocatable :: enetube,enecavtube
!
! 12/26/95 - H-bonding contacts
! common /contacts_hb/
real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
- gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
+ gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
- ees0m,d_cont !(maxconts,maxres)
- integer,dimension(:),allocatable :: num_cont_hb !(maxres)
- integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
+ ees0m,d_cont !(maxconts,maxres)
+ integer,dimension(:),allocatable :: num_cont_hb !(maxres)
+ integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
! interactions
! 7/25/08 commented out; not needed when cumulants used
! Interactions of pseudo-dipoles generated by loc-el interactions.
! common /dipint/
real(kind=8),dimension(:,:,:),allocatable :: dip,&
- dipderg !(4,maxconts,maxres)
+ dipderg !(4,maxconts,maxres)
real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
! 10/30/99 Added other pre-computed vectors and matrices needed
! to calculate three - six-order el-loc correlation terms
! common /rotat/
- real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
+ real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
- obrot2_der !(2,maxres)
+ obrot2_der !(2,maxres)
!
! This common block contains vectors and matrices dependent on a single
! amino-acid residue.
! common /precomp1/
real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
- Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
+ Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
- CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
+ CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
! This common block contains vectors and matrices dependent on two
! consecutive amino-acid residues.
! common /precomp2/
real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
- CUgb2,CUgb2der !(2,maxres)
+ CUgb2,CUgb2der !(2,maxres)
real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
- EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
+ EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
- DtUg2EUgder !(2,2,2,maxres)
+ DtUg2EUgder !(2,2,2,maxres)
! common /rotat_old/
real(kind=8),dimension(:),allocatable :: costab,sintab,&
- costab2,sintab2 !(maxres)
+ costab2,sintab2 !(maxres)
! This common block contains dipole-interaction matrices and their
! Cartesian derivatives.
! common /dipmat/
- real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
- real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
+ real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
+ real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
! common /diploc/
real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
- gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6 !(3,maxres)
+ gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,&
+ gliptranx, &
+ gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,&
+ gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, &
+ gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, &
+ gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,&
+ grad_shield,gg_tube,gg_tube_sc,gradafm !(3,maxres)
+!-----------------------------NUCLEIC GRADIENT
+ real(kind=8),dimension(:,:),allocatable ::gradb_nucl,gradbx_nucl, &
+ gvdwpsb1,gelpp,gvdwpsb,gelsbc,gelsbx,gvdwsbx,gvdwsbc,gsbloc,&
+ gsblocx,gradcorr_nucl,gradxorr_nucl,gradcorr3_nucl,gradxorr3_nucl,&
+ gvdwpp_nucl
+!-----------------------------NUCLEIC-PROTEIN GRADIENT
+ real(kind=8),dimension(:,:),allocatable :: gvdwx_scbase,gvdwc_scbase,&
+ gvdwx_pepbase,gvdwc_pepbase,gvdwx_scpho,gvdwc_scpho,&
+ gvdwc_peppho
+!------------------------------IONS GRADIENT
+ real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
+ gradpepcat,gradpepcatx
! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
+
+
real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
- g_corr6_loc !(maxvar)
+ g_corr6_loc !(maxvar)
real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
- real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
-! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
+ real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
+! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
+ real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
+ grad_shield_loc ! (3,maxcontsshileding,maxnres)
! integer :: nfl,icg
! common /deriv_loc/
+ real(kind=8), dimension(:),allocatable :: fac_shield
real(kind=8),dimension(3,5,2) :: derx,derx_turn
! common /deriv_scloc/
real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
- dZZ_XYZtab !(3,maxres)
+ dZZ_XYZtab !(3,maxres)
!-----------------------------------------------------------------------------
! common.maxgrad
! common /maxgrad/
! common /qmeas/
real(kind=8) :: Ucdfrag,Ucdpair
real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
- dqwol,dxqwol !(3,0:MAXRES)
+ dqwol,dxqwol !(3,0:MAXRES)
!-----------------------------------------------------------------------------
! common.sbridge
! common /dyn_ssbond/
! Parameters of the SCCOR term
! common/sccor/
real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
- dcosomicron,domicron !(3,3,3,maxres2)
+ dcosomicron,domicron !(3,3,3,maxres2)
!-----------------------------------------------------------------------------
! common.vectors
! common /vectors/
real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
!-----------------------------------------------------------------------------
! common /przechowalnia/
- real(kind=8),dimension(:,:,:),allocatable :: zapas !(max_dim,maxconts,max_fg_procs)
+ real(kind=8),dimension(:,:,:),allocatable :: zapas
+ real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
integer :: n_corr,n_corr1,ierror
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
+ real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
+ Eafmforce,ethetacnstr
real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
+! 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
+! energies for protein nucleic acid interaction
+ real(kind=8) :: escbase,epepbase,escpho,epeppho
#ifdef MPI
real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
! shielding effect varibles for MPI
-! real(kind=8) fac_shieldbuf(maxres),
-! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
-! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
-! & grad_shieldbuf(3,-1:maxres)
-! integer ishield_listbuf(maxres),
-! &shield_listbuf(maxcontsshi,maxres)
+ real(kind=8) fac_shieldbuf(nres), &
+ grad_shield_locbuf(3,maxcontsshi,-1:nres), &
+ grad_shield_sidebuf(3,maxcontsshi,-1:nres), &
+ grad_shieldbuf(3,-1:nres)
+ integer ishield_listbuf(nres), &
+ shield_listbuf(maxcontsshi,nres),k,j,i
! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
! & " nfgtasks",nfgtasks
weights_(17)=wbond
weights_(18)=scal14
weights_(21)=wsccor
+ weights_(26)=wvdwpp_nucl
+ weights_(27)=welpp
+ weights_(28)=wvdwpsb
+ weights_(29)=welpsb
+ weights_(30)=wvdwsb
+ weights_(31)=welsb
+ weights_(32)=wbond_nucl
+ weights_(33)=wang_nucl
+ weights_(34)=wsbloc
+ weights_(35)=wtor_nucl
+ weights_(36)=wtor_d_nucl
+ weights_(37)=wcorr_nucl
+ weights_(38)=wcorr3_nucl
+ weights_(41)=wcatcat
+ weights_(42)=wcatprot
+ weights_(46)=wscbase
+ weights_(47)=wscpho
+ weights_(48)=wpeppho
+! wcatcat= weights(41)
+! wcatprot=weights(42)
+
! FG Master broadcasts the WEIGHTS_ array
call MPI_Bcast(weights_(1),n_ene,&
MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
wbond=weights(17)
scal14=weights(18)
wsccor=weights(21)
+ wvdwpp_nucl =weights(26)
+ welpp =weights(27)
+ wvdwpsb=weights(28)
+ welpsb =weights(29)
+ wvdwsb =weights(30)
+ welsb =weights(31)
+ wbond_nucl =weights(32)
+ wang_nucl =weights(33)
+ wsbloc =weights(34)
+ wtor_nucl =weights(35)
+ wtor_d_nucl =weights(36)
+ wcorr_nucl =weights(37)
+ wcorr3_nucl =weights(38)
+ wcatcat= weights(41)
+ wcatprot=weights(42)
+ wscbase=weights(46)
+ wscpho=weights(47)
+ wpeppho=weights(48)
endif
time_Bcast=time_Bcast+MPI_Wtime()-time00
time_Bcastw=time_Bcastw+MPI_Wtime()-time00
#endif
!
! Compute the side-chain and electrostatic interaction energy
-!
+! print *, "Before EVDW"
! goto (101,102,103,104,105,106) ipot
select case(ipot)
! Lennard-Jones potential.
! Gay-Berne potential (shifted LJ, angular dependence).
! 104 call egb(evdw)
case (4)
+! print *,"MOMO",scelemode
+ if (scelemode.eq.0) then
call egb(evdw)
+ else
+ call emomo(evdw)
+ endif
! goto 107
! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
! 105 call egbv(evdw)
! 50 continue
end select
! continue
+! print *,"after EGB"
+! shielding effect
+ if (shield_mode.eq.2) then
+ call set_shield_fac2
+ endif
+ if (nfgtasks.gt.1) then
+ call MPI_Allgatherv(fac_shield(ivec_start), &
+ ivec_count(fg_rank1), &
+ MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0), &
+ ivec_displ(0), &
+ MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
+ call MPI_Allgatherv(shield_list(1,ivec_start), &
+ ivec_count(fg_rank1), &
+ MPI_I50,shield_listbuf(1,1),ivec_count(0), &
+ ivec_displ(0), &
+ MPI_I50,FG_COMM,IERROR)
+ call MPI_Allgatherv(ishield_list(ivec_start), &
+ ivec_count(fg_rank1), &
+ MPI_INTEGER,ishield_listbuf(1),ivec_count(0), &
+ ivec_displ(0), &
+ MPI_INTEGER,FG_COMM,IERROR)
+ call MPI_Allgatherv(grad_shield(1,ivec_start), &
+ ivec_count(fg_rank1), &
+ MPI_UYZ,grad_shieldbuf(1,1),ivec_count(0), &
+ ivec_displ(0), &
+ MPI_UYZ,FG_COMM,IERROR)
+ call MPI_Allgatherv(grad_shield_side(1,1,ivec_start), &
+ ivec_count(fg_rank1), &
+ MPI_SHI,grad_shield_sidebuf(1,1,1),ivec_count(0), &
+ ivec_displ(0), &
+ MPI_SHI,FG_COMM,IERROR)
+ call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start), &
+ ivec_count(fg_rank1), &
+ MPI_SHI,grad_shield_locbuf(1,1,1),ivec_count(0), &
+ ivec_displ(0), &
+ MPI_SHI,FG_COMM,IERROR)
+ do i=1,nres
+ fac_shield(i)=fac_shieldbuf(i)
+ ishield_list(i)=ishield_listbuf(i)
+ do j=1,3
+ grad_shield(j,i)=grad_shieldbuf(j,i)
+ enddo !j
+ do j=1,ishield_list(i)
+ shield_list(j,i)=shield_listbuf(j,i)
+ do k=1,3
+ grad_shield_loc(k,j,i)=grad_shield_locbuf(k,j,i)
+ grad_shield_side(k,j,i)=grad_shield_sidebuf(k,j,i)
+ enddo !k
+ enddo !j
+ enddo !i
+ endif
+
+
+
+! print *,"AFTER EGB",ipot,evdw
!mc
!mc Sep-06: egb takes care of dynamic ss bonds too
!mc
#ifdef TIMING
time_vec=time_vec+MPI_Wtime()-time01
#endif
-! print *,"Processor",myrank," left VEC_AND_DERIV"
+
+
+
+
+! print *,"Processor",myrank," left VEC_AND_DERIV"
if (ipot.lt.6) then
#ifdef SPLITELE
+! print *,"after ipot if", ipot
if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
.or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
.or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
.or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
#endif
+! print *,"just befor eelec call"
call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-! write (iout,*) "ELEC calc"
+! write (iout,*) "ELEC calc"
else
ees=0.0d0
evdw1=0.0d0
! write (iout,*) "Soft-sphere SCP potential"
call escp_soft_sphere(evdw2,evdw2_14)
endif
-!elwrite(iout,*) "in etotal before ebond",ipot
+! write(iout,*) "in etotal before ebond",ipot
!
! Calculate the bond-stretching energy
!
call ebond(estr)
-!elwrite(iout,*) "in etotal afer ebond",ipot
+! print *,"EBOND",estr
+! write(iout,*) "in etotal afer ebond",ipot
!
! Calculate the disulfide-bridge and other energy and the contributions
! Calculate the virtual-bond-angle energy.
!
if (wang.gt.0d0) then
- call ebend(ebe)
+ call ebend(ebe,ethetacnstr)
else
ebe=0
+ ethetacnstr=0
endif
! print *,"Processor",myrank," computed UB"
!
Uconst=0.0d0
Uconst_back=0.0d0
endif
-!elwrite(iout,*) "after Econstr"
+ call flush(iout)
+! write(iout,*) "after Econstr"
+ if (wliptran.gt.0) then
+! print *,"PRZED WYWOLANIEM"
+ call Eliptransfer(eliptran)
+ else
+ eliptran=0.0d0
+ endif
+ if (fg_rank.eq.0) then
+ if (AFMlog.gt.0) then
+ call AFMforce(Eafmforce)
+ else if (selfguide.gt.0) then
+ call AFMvel(Eafmforce)
+ endif
+ endif
+ if (tubemode.eq.1) then
+ call calctube(etube)
+ else if (tubemode.eq.2) then
+ call calctube2(etube)
+ elseif (tubemode.eq.3) then
+ call calcnano(etube)
+ else
+ etube=0.0d0
+ endif
+!--------------------------------------------------------
+! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
+! print *,"before",ees,evdw1,ecorr
+ if (nres_molec(2).gt.0) then
+ call ebond_nucl(estr_nucl)
+ call ebend_nucl(ebe_nucl)
+ call etor_nucl(etors_nucl)
+ call esb_gb(evdwsb,eelsb)
+ call epp_nucl_sub(evdwpp,eespp)
+ call epsb(evdwpsb,eelpsb)
+ call esb(esbloc)
+ call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
+ else
+ etors_nucl=0.0d0
+ estr_nucl=0.0d0
+ ebe_nucl=0.0d0
+ evdwsb=0.0d0
+ eelsb=0.0d0
+ esbloc=0.0d0
+ endif
+ if (nfgtasks.gt.1) then
+ if (fg_rank.eq.0) then
+ call ecatcat(ecationcation)
+ endif
+ else
+ call ecatcat(ecationcation)
+ endif
+ call ecat_prot(ecation_prot)
+ if (nres_molec(2).gt.0) then
+ call eprot_sc_base(escbase)
+ call epep_sc_base(epepbase)
+ call eprot_sc_phosphate(escpho)
+ call eprot_pep_phosphate(epeppho)
+ else
+ epepbase=0.0
+ escbase=0.0
+ escpho=0.0
+ epeppho=0.0
+ endif
+! call ecatcat(ecationcation)
+! print *,"after ebend", ebe_nucl
#ifdef TIMING
time_enecalc=time_enecalc+MPI_Wtime()-time00
#endif
energia(17)=estr
energia(20)=Uconst+Uconst_back
energia(21)=esccor
+ energia(22)=eliptran
+ energia(23)=Eafmforce
+ energia(24)=ethetacnstr
+ energia(25)=etube
+!---------------------------------------------------------------
+ energia(26)=evdwpp
+ energia(27)=eespp
+ energia(28)=evdwpsb
+ energia(29)=eelpsb
+ energia(30)=evdwsb
+ energia(31)=eelsb
+ energia(32)=estr_nucl
+ energia(33)=ebe_nucl
+ energia(34)=esbloc
+ energia(35)=etors_nucl
+ energia(36)=etors_d_nucl
+ energia(37)=ecorr_nucl
+ energia(38)=ecorr3_nucl
+!----------------------------------------------------------------------
! 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(46)=escbase
+ energia(47)=epepbase
+ energia(48)=escpho
+ energia(49)=epeppho
call sum_energy(energia,.true.)
if (dyn_ss) call dyn_set_nss
! print *," Processor",myrank," left SUM_ENERGY"
logical :: reduce
real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
- real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot
+ real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
+ 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
+ real(kind=8) :: escbase,epepbase,escpho,epeppho
integer :: i
#ifdef MPI
integer :: ierr
estr=energia(17)
Uconst=energia(20)
esccor=energia(21)
+ eliptran=energia(22)
+ Eafmforce=energia(23)
+ ethetacnstr=energia(24)
+ etube=energia(25)
+ evdwpp=energia(26)
+ eespp=energia(27)
+ evdwpsb=energia(28)
+ eelpsb=energia(29)
+ evdwsb=energia(30)
+ eelsb=energia(31)
+ estr_nucl=energia(32)
+ ebe_nucl=energia(33)
+ esbloc=energia(34)
+ etors_nucl=energia(35)
+ etors_d_nucl=energia(36)
+ ecorr_nucl=energia(37)
+ ecorr3_nucl=energia(38)
+ ecation_prot=energia(41)
+ ecationcation=energia(42)
+ escbase=energia(46)
+ epepbase=energia(47)
+ escpho=energia(48)
+ epeppho=energia(49)
+! energia(41)=ecation_prot
+! energia(42)=ecationcation
+
+
#ifdef SPLITELE
etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
+wang*ebe+wtor*etors+wscloc*escloc &
+wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
+wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
+wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
- +wbond*estr+Uconst+wsccor*esccor
+ +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
+ +Eafmforce+ethetacnstr &
+ +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
#else
etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
+wang*ebe+wtor*etors+wscloc*escloc &
+wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
+wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
+wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
- +wbond*estr+Uconst+wsccor*esccor
+ +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
+ +Eafmforce+ethetacnstr &
+ +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
#endif
energia(0)=etot
! detecting NaNQ
!el local variables
real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
- real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor
+ real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
+ 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
+ real(kind=8) :: escbase,epepbase,escpho,epeppho
etot=energia(0)
evdw=energia(1)
estr=energia(17)
Uconst=energia(20)
esccor=energia(21)
+ eliptran=energia(22)
+ Eafmforce=energia(23)
+ ethetacnstr=energia(24)
+ etube=energia(25)
+ evdwpp=energia(26)
+ eespp=energia(27)
+ evdwpsb=energia(28)
+ eelpsb=energia(29)
+ evdwsb=energia(30)
+ eelsb=energia(31)
+ estr_nucl=energia(32)
+ ebe_nucl=energia(33)
+ esbloc=energia(34)
+ etors_nucl=energia(35)
+ etors_d_nucl=energia(36)
+ ecorr_nucl=energia(37)
+ ecorr3_nucl=energia(38)
+ ecation_prot=energia(41)
+ ecationcation=energia(42)
+ escbase=energia(46)
+ epepbase=energia(47)
+ escpho=energia(48)
+ epeppho=energia(49)
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
estr,wbond,ebe,wang,&
ecorr,wcorr,&
ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
- edihcnstr,ebr*nss,&
- Uconst,etot
+ edihcnstr,ethetacnstr,ebr*nss,&
+ Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
+ 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,&
+ 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
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
+ 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
'UCONST= ',1pE16.6,' (Constraint energy)'/ &
+ 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
+ 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
+ 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
+ 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
+ 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
+ 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
+ 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
+ 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
+ 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
+ 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
+ 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
+ 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
+ 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
+ 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
+ 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
+ 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
+ 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
+ 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
+ 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
+ '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)'/&
'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,&
- ebr*nss,Uconst,etot
+ ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
+ etube,wtube, &
+ 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&
+ 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
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
+ 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
'UCONST=',1pE16.6,' (Constraint energy)'/ &
+ 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
+ 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
+ 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
+ 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
+ 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
+ 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
+ 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
+ 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
+ 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
+ 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
+ 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
+ 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
+ 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
+ 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
+ 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
+ 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
+ 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
+ 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
+ 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
+ '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)'/&
'ETOT= ',1pE16.6,' (total)')
#endif
return
! include 'COMMON.NAMES'
! include 'COMMON.IOUNITS'
! include 'COMMON.CONTACTS'
- real(kind=8),dimension(3) :: gg
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
integer :: num_conti
!el local variables
integer :: i,itypi,iint,j,itypi1,itypj,k
evdw=0.0D0
! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
-! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
-! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
+! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
+! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
+ itypi=iabs(itype(i,1))
if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
+ itypi1=iabs(itype(i+1,1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
!d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
!d & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
evdwij=e1+e2
!d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
!d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
!d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
-!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
+!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
!d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
!d & (c(k,i),k=1,3),(c(k,j),k=1,3)
evdw=evdw+evdwij
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
! include 'COMMON.NAMES'
- real(kind=8),dimension(3) :: gg
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
logical :: scheck
!el local variables
integer :: i,iint,j,itypi,itypi1,k,itypj
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
+ itypi=iabs(itype(i,1))
if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
+ itypi1=iabs(itype(i+1,1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
!
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
rij=1.0D0/r_inv_ij
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
evdwij=e_augm+e1+e2
!d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
!d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
!d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
+!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
!d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
!d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
!d & (c(k,i),k=1,3),(c(k,j),k=1,3)
! endif
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
+ itypi=iabs(itype(i,1))
if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
+ itypi1=iabs(itype(i+1,1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
!el ind=ind+1
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
! Calculate whole angle-dependent part of epsilon and contributions
! to its derivatives
fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ 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
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ 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),i,restyp(itypj),j,
+!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),
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
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
+ real(kind=8) :: fracinbuf
+
!cccc energy_dec=.false.
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
! if (icall.eq.0) lprn=.false.
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
+!C print *,"I am in EVDW",i
+ itypi=iabs(itype(i,1))
+! if (i.ne.47) cycle
if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
+ itypi1=iabs(itype(i+1,1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
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
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
'evdw',i,j,evdwij,' ss'
! if (energy_dec) write (iout,*) &
! 'evdw',i,j,evdwij,' ss'
+ do k=j+1,iend(i,iint)
+!C search over all next residues
+ if (dyn_ss_mask(k)) then
+!C check if they are cysteins
+!C write(iout,*) 'k=',k
+
+!c write(iout,*) "PRZED TRI", evdwij
+! evdwij_przed_tri=evdwij
+ call triple_ssbond_ene(i,j,k,evdwij)
+!c if(evdwij_przed_tri.ne.evdwij) then
+!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
+!c endif
+
+!c write(iout,*) "PO TRI", evdwij
+!C call the energy function that removes the artifical triple disulfide
+!C bond the soubroutine is located in ssMD.F
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
ELSE
!el ind=ind+1
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
+! if (j.ne.78) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
! 1.0d0/vbld(j+nres) !d
-! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
sig0ij=sigma(itypi,itypj)
chi1=chi(itypi,itypj)
chi2=chi(itypj,itypi)
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
if (rij_shift.le.0.0D0) then
evdw=1.0D20
!d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-!d & restyp(itypi),i,restyp(itypj),j,
+!d & restyp(itypi,1),i,restyp(itypj,1),j,
!d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
return
endif
!---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ faclip=fac
+ e1=fac*fac*aa!(itypi,itypj)
+ e2=fac*bb!(itypi,itypj)
evdwij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
evdwij=evdwij*eps2rt*eps3rt
evdw=evdw+evdwij*sss_ele_cut
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+ epsi=bb**2/aa!(itypi,itypj)
write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi),i,restyp(itypj),j, &
+ restyp(itypi,1),i,restyp(itypj,1),j, &
epsi,sigm,chi1,chi2,chip1,chip2, &
eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
evdwij
endif
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'evdw',i,j,evdwij !,"egb"
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
+ 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
+!C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
! if (energy_dec) write (iout,*) &
! 'evdw',i,j,evdwij
+! print *,"ZALAMKA", evdw
! Calculate gradient components.
e1=e1*eps1*eps2rt**2*eps3rt**2
gg(1)=xj*fac
gg(2)=yj*fac
gg(3)=zj*fac
+!C Calculate the radial part of the gradient
+ gg_lipi(3)=eps1*(eps2rt*eps2rt)&
+ *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
+ (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
+ +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
+ gg_lipj(3)=ssgradlipj*gg_lipi(3)
+ gg_lipi(3)=gg_lipi(3)*ssgradlipi
+
! print *,'before sc_grad', gg(1),gg(2),gg(3)
! Calculate angular part of the gradient.
call sc_grad
enddo ! j
enddo ! iint
enddo ! i
+! print *,"ZALAMKA", evdw
! write (iout,*) "Number of loop steps in EGB:",ind
!ccc energy_dec=.false.
return
! if (icall.eq.0) lprn=.true.
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
+ itypi=iabs(itype(i,1))
if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
+ itypi1=iabs(itype(i+1,1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
!el ind=ind+1
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
!---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ 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+e_augm
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ sigm=dabs(aa_aq(itypi,itypj)/&
+ bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi),i,restyp(itypj),j,&
+ restyp(itypi,1),i,restyp(itypj,1),j,&
epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
chi1,chi2,chip1,chip2,&
eps1,eps2rt**2,eps3rt**2,&
! include 'COMMON.NAMES'
! include 'COMMON.IOUNITS'
! include 'COMMON.CONTACTS'
- real(kind=8),dimension(3) :: gg
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
!d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
!el local variables
integer :: i,iint,j,itypi,itypi1,itypj,k
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
+ itypi=iabs(itype(i,1))
if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1))
+ itypi1=iabs(itype(i+1,1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
!d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
!d & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
eello_turn4=0.0d0
!el ind=0
do i=iatel_s,iatel_e
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ 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)
num_conti=0
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
- if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
+ if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
!el ind=ind+1
iteli=itel(i)
itelj=itel(j)
! include 'COMMON.LOCAL'
! include 'COMMON.CHAIN'
! include 'COMMON.VECTORS'
- real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
- real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
+ real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
+ real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
real(kind=8),dimension(3) :: erij
real(kind=8) :: delta=1.0d-7
real(kind=8) :: auxvec(2),auxmat(2,2)
integer :: i,iti1,iti,k,l
real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
-
+! print *,"in set matrices"
!
! Compute the virtual-bond-torsional-angle dependent quantities needed
! to calculate the el-loc multibody terms of various order.
#else
do i=3,nres+1
#endif
+! print *,i,"i"
if (i .lt. nres+1) then
sin1=dsin(phi(i))
cos1=dcos(phi(i))
endif
! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
if (i.gt. nnt+2 .and. i.lt.nct+2) then
- iti = itortyp(itype(i-2))
+ if (itype(i-2,1).eq.0) then
+ iti=ntortyp+1
+ else
+ iti = itortyp(itype(i-2,1))
+ endif
else
iti=ntortyp+1
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
- iti1 = itortyp(itype(i-1))
+ if (itype(i-1,1).eq.0) then
+ iti1=ntortyp+1
+ else
+ iti1 = itortyp(itype(i-1,1))
+ endif
else
iti1=ntortyp+1
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)
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).le.ntyp) then
- iti1 = itortyp(itype(i-1))
+ if (itype(i-1,1).eq.0) then
+ iti1=ntortyp+1
+ elseif (itype(i-1,1).le.ntyp) then
+ iti1 = itortyp(itype(i-1,1))
else
iti1=ntortyp+1
endif
#endif
#endif
!d do i=1,nres
-!d iti = itortyp(itype(i))
+!d iti = itortyp(itype(i,1))
!d write (iout,*) i
!d do j=1,2
!d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
!el local variables
integer :: i,k,j
real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
- real(kind=8) :: fac,t_eelecij
+ real(kind=8) :: fac,t_eelecij,fracinbuf
!d write(iout,*) 'In EELEC'
+! print *,"IN EELEC"
!d do i=1,nloctyp
!d write(iout,*) 'Type',i
!d write(iout,*) 'B1',B1(:,i)
! write (iout,*) 'i',i,' fac',fac
enddo
endif
+! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
+! wturn6
if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
.or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
#ifdef TIMING
time01=MPI_Wtime()
#endif
+! print *, "before set matrices"
call set_matrices
+! print *, "after set matrices"
+
#ifdef TIMING
time_mat=time_mat+MPI_Wtime()-time01
#endif
endif
+! print *, "after set matrices"
!d do i=1,nres-1
!d write (iout,*) 'i=',i
!d do k=1,3
!
-
+! print *,"before iturn3 loop"
do i=iturn3_start,iturn3_end
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
- .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
+ .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
zmedi=dmod(zmedi,boxzsize)
if (zmedi.lt.0) zmedi=zmedi+boxzsize
num_conti=0
- call eelecij(i,i+2,ees,evdw1,eel_loc)
+ 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
enddo
do i=iturn4_start,iturn4_end
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
- .or. itype(i+3).eq.ntyp1 &
- .or. itype(i+4).eq.ntyp1) cycle
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
+ .or. itype(i+3,1).eq.ntyp1 &
+ .or. itype(i+4,1).eq.ntyp1) cycle
+! print *,"before2",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
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
+
num_conti=num_cont_hb(i)
call eelecij(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
+ if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
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
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ 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)
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
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
do j=ielstart(i),ielend(i)
-! write (iout,*) i,j,itype(i),itype(j)
- if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
+! 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
num_cont_hb(i)=num_conti
!el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
real(kind=8),dimension(4) :: muij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init
- integer xshift,yshift,zshift
+ dist_temp, dist_init,rlocshield,fracinbuf
+ integer xshift,yshift,zshift,ilist,iresshield
!el integer :: num_conti,j1,j2
!el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
!el dz_normi,xmedi,ymedi,zmedi
ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
ecosgp,ecosam,ecosbm,ecosgm,ghalf
! maxconts=nres/4
-! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
-! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
+! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
+! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
! time00=MPI_Wtime()
!d write (iout,*) "eelecij",i,j
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
evdwij=ev1+ev2
el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
el2=fac4*fac
- eesij=el1+el2
+! eesij=el1+el2
+ if (shield_mode.gt.0) then
+!C fac_shield(i)=0.4
+!C fac_shield(j)=0.6
+ el1=el1*fac_shield(i)**2*fac_shield(j)**2
+ el2=el2*fac_shield(i)**2*fac_shield(j)**2
+ eesij=(el1+el2)
+ ees=ees+eesij*sss_ele_cut
+!C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
+!C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ else
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+ eesij=(el1+el2)
+ ees=ees+eesij &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
+!C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ endif
+
! 12/26/95 - for the evaluation of multi-body H-bonding interactions
ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij*sss_ele_cut
- evdw1=evdw1+evdwij*sss_ele_cut
+! ees=ees+eesij*sss_ele_cut
+ evdw1=evdw1+evdwij*sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
!d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
!d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
!d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
! Calculate contributions to the Cartesian gradient.
!
#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut
- facel=-3*rrmij*(el1+eesij)*sss_ele_cut
+ facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
fac1=fac
erij(1)=xj*rmij
erij(2)=yj*rmij
!
! Radial derivatives. First process both termini of the fragment (i,j)
!
- ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
- ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
- ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
+ ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
+ ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
+ ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
+ ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
+ (shield_mode.gt.0)) then
+!C print *,i,j
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
+ *2.0*sss_ele_cut
+ gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
+ *sss_ele_cut
+ gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
+ *2.0*sss_ele_cut
+ gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
+ *sss_ele_cut
+ gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
+ enddo
+ enddo
+ do k=1,3
+ gshieldc(k,i)=gshieldc(k,i)+ &
+ grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
+ *sss_ele_cut
+
+ gshieldc(k,j)=gshieldc(k,j)+ &
+ grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
+ *sss_ele_cut
+
+ gshieldc(k,i-1)=gshieldc(k,i-1)+ &
+ grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
+ *sss_ele_cut
+
+ gshieldc(k,j-1)=gshieldc(k,j-1)+ &
+ grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
+ *sss_ele_cut
+
+ enddo
+ endif
+
! do k=1,3
! ghalf=0.5D0*ggg(k)
gelc_long(k,j)=gelc_long(k,j)+ggg(k)
gelc_long(k,i)=gelc_long(k,i)-ggg(k)
enddo
+ gelc_long(3,j)=gelc_long(3,j)+ &
+ ssgradlipj*eesij/2.0d0*lipscale**2&
+ *sss_ele_cut
+
+ gelc_long(3,i)=gelc_long(3,i)+ &
+ ssgradlipi*eesij/2.0d0*lipscale**2&
+ *sss_ele_cut
+
+
!
! Loop over residues i+1 thru j-1.
!
!grad gelc(l,k)=gelc(l,k)+ggg(l)
!grad enddo
!grad enddo
- ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj
- ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj
- ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj
+ ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
! do k=1,3
! ghalf=0.5D0*ggg(k)
! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
enddo
-!
-! Loop over residues i+1 thru j-1.
+
+!C Lipidic part for scaling weight
+ gvdwpp(3,j)=gvdwpp(3,j)+ &
+ sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
+ gvdwpp(3,i)=gvdwpp(3,i)+ &
+ sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
+!! Loop over residues i+1 thru j-1.
!
!grad do k=i+1,j-1
!grad do l=1,3
!grad enddo
!grad enddo
#else
- facvdw=(ev1+evdwij)*sss_ele_cut
+ facvdw=(ev1+evdwij)*sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
facel=(el1+eesij)*sss_ele_cut
fac1=fac
fac=-3*rrmij*(facvdw+facvdw+facel)
!grad enddo
!grad enddo
! 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
+ ggg(1)=facvdw*xj &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(2)=facvdw*yj &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+ ggg(3)=facvdw*zj &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
do k=1,3
gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
enddo
+ gvdwpp(3,j)=gvdwpp(3,j)+ &
+ sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
+ gvdwpp(3,i)=gvdwpp(3,i)+ &
+ sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
+
#endif
!
! Angular part
!d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
!d & (dcosg(k),k=1,3)
do k=1,3
- ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut
+ ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
+ *fac_shield(i)**2*fac_shield(j)**2 &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
enddo
! do k=1,3
! ghalf=0.5D0*ggg(k)
gelc(k,i)=gelc(k,i) &
+(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+ ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)**2*fac_shield(j)**2 &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
gelc(k,j)=gelc(k,j) &
+(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+ ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)**2*fac_shield(j)**2 &
+ *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
gelc_long(k,j)=gelc_long(k,j)+ggg(k)
gelc_long(k,i)=gelc_long(k,i)-ggg(k)
enddo
a32=a32*fac
a33=a33*fac
!d write (iout,'(4i5,4f10.5)')
-!d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
+!d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
!d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
!d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
!d & uy(:,j),uz(:,j)
! Contribution to the local-electrostatic energy coming from the i-j pair
eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
+a33*muij(4)
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+ endif
+ eel_loc_ij=eel_loc_ij &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+!C Now derivative over eel_loc
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
+ (shield_mode.gt.0)) then
+!C print *,i,j
+
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
+ /fac_shield(i)&
+ *sss_ele_cut
+ gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
+ *sss_ele_cut
+
+ gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
+ +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
+ /fac_shield(j) &
+ *sss_ele_cut
+ gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
+ *sss_ele_cut
+
+ gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
+ +rlocshield
+
+ enddo
+ enddo
+
+ do k=1,3
+ gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
+ grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
+ *sss_ele_cut
+ gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
+ grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
+ *sss_ele_cut
+ gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
+ grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
+ *sss_ele_cut
+ gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
+ grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
+ *sss_ele_cut
+
+ enddo
+ endif
+
+
! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
! eel_loc_ij=0.0
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'eelloc',i,j,eel_loc_ij
+! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
+! 'eelloc',i,j,eel_loc_ij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,8f8.3)') &
+ 'eelloc',i,j,eel_loc_ij,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
+! print *,"EELLOC",i,gel_loc_loc(i-1)
+
! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
! if (energy_dec) write (iout,*) "muij",muij
! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
(a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
+a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
(a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
+a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
! do l=1,3
! ggg(1)=(agg(1,1)*muij(1)+ &
ggg(l)=(agg(l,1)*muij(1)+ &
agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
*sss_ele_cut &
- +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
+ +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
+
gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
!grad gel_loc(l,i)=gel_loc(l,i)+ghalf
!grad gel_loc(l,j)=gel_loc(l,j)+ghalf
enddo
+ gel_loc_long(3,j)=gel_loc_long(3,j)+ &
+ ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
+ ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
+
+ gel_loc_long(3,i)=gel_loc_long(3,i)+ &
+ ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
+ ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
+
!grad do k=i+1,j2
!grad do l=1,3
!grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
do l=1,3
gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
+aggi1(l,4)*muij(4))&
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
+aggj1(l,4)*muij(4))&
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
enddo
ENDIF
else
ees0pij=0
endif
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0d0
+ fac_shield(j)=1.0d0
+ else
+ ees0plist(num_conti,i)=j
+ endif
! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
if (ees0tmp.gt.0) then
endif
! ees0mij=0.0D0
ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j)
ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
- *sss_ele_cut
+ *sss_ele_cut &
+ *fac_shield(i)*fac_shield(j)
! 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
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)
gacontp_hb2(k,num_conti,i)= & !ghalfp+
(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+ ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
- *sss_ele_cut
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)
gacontp_hb3(k,num_conti,i)=gggp(k) &
- *sss_ele_cut
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)
gacontm_hb1(k,num_conti,i)= & !ghalfm+
(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+ ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
- *sss_ele_cut
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)
gacontm_hb2(k,num_conti,i)= & !ghalfm+
(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+ ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
- *sss_ele_cut
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)
gacontm_hb3(k,num_conti,i)=gggm(k) &
- *sss_ele_cut
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)
enddo
! Diagnostics. Comment out or remove after debugging!
!el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
!el num_conti,j1,j2
!el local variables
- integer :: i,j,l
- real(kind=8) :: eello_turn3
+ integer :: i,j,l,k,ilist,iresshield
+ real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
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
+
a_temp(1,1)=a22
a_temp(1,2)=a23
a_temp(2,1)=a32
call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
call transpose2(auxmat(1,1),auxmat1(1,1))
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0d0
+ fac_shield(j)=1.0d0
+ endif
+
+ eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+ eello_t3= &
+ 0.5d0*(pizda(1,1)+pizda(2,2)) &
+ *fac_shield(i)*fac_shield(j)
+
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
+ (shield_mode.gt.0)) then
+!C print *,i,j
+
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
+ gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
+ gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
+ +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
+ gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
+ gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
+ +rlocshield
+
+ enddo
+ enddo
+
+ do k=1,3
+ gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
+ grad_shield(k,i)*eello_t3/fac_shield(i)
+ gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
+ grad_shield(k,j)*eello_t3/fac_shield(j)
+ gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
+ grad_shield(k,i)*eello_t3/fac_shield(i)
+ gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
+ grad_shield(k,j)*eello_t3/fac_shield(j)
+ enddo
+ endif
+
!d write (2,*) 'i,',i,' j',j,'eello_turn3',
!d & 0.5d0*(pizda(1,1)+pizda(2,2)),
!d & ' eello_turn3_num',4*eello_turn3_num
call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
call transpose2(auxmat2(1,1),auxmat3(1,1))
call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
- gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
+ gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
! Derivatives in gamma(i+1)
call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
call transpose2(auxmat2(1,1),auxmat3(1,1))
call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
- +0.5d0*(pizda(1,1)+pizda(2,2))
+ +0.5d0*(pizda(1,1)+pizda(2,2)) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
! Cartesian derivatives
do l=1,3
! ghalf1=0.5d0*agg(l,1)
a_temp(2,2)=aggi(l,4)!+ghalf4
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,i)=gcorr3_turn(l,i) &
- +0.5d0*(pizda(1,1)+pizda(2,2))
+ +0.5d0*(pizda(1,1)+pizda(2,2)) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
a_temp(1,1)=aggi1(l,1)!+agg(l,1)
a_temp(1,2)=aggi1(l,2)!+agg(l,2)
a_temp(2,1)=aggi1(l,3)!+agg(l,3)
a_temp(2,2)=aggi1(l,4)!+agg(l,4)
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
- +0.5d0*(pizda(1,1)+pizda(2,2))
+ +0.5d0*(pizda(1,1)+pizda(2,2)) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
a_temp(1,1)=aggj(l,1)!+ghalf1
a_temp(1,2)=aggj(l,2)!+ghalf2
a_temp(2,1)=aggj(l,3)!+ghalf3
a_temp(2,2)=aggj(l,4)!+ghalf4
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,j)=gcorr3_turn(l,j) &
- +0.5d0*(pizda(1,1)+pizda(2,2))
+ +0.5d0*(pizda(1,1)+pizda(2,2)) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
a_temp(1,1)=aggj1(l,1)
a_temp(1,2)=aggj1(l,2)
a_temp(2,1)=aggj1(l,3)
a_temp(2,2)=aggj1(l,4)
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
- +0.5d0*(pizda(1,1)+pizda(2,2))
+ +0.5d0*(pizda(1,1)+pizda(2,2)) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
enddo
+ gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
+ ssgradlipi*eello_t3/4.0d0*lipscale
+ gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
+ ssgradlipj*eello_t3/4.0d0*lipscale
+ gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
+ ssgradlipi*eello_t3/4.0d0*lipscale
+ gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
+ ssgradlipj*eello_t3/4.0d0*lipscale
+
return
end subroutine eturn3
!-----------------------------------------------------------------------------
!el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
!el num_conti,j1,j2
!el local variables
- integer :: i,j,iti1,iti2,iti3,l
- real(kind=8) :: eello_turn4,s1,s2,s3
-
+ integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
+ real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
+ rlocshield
+
j=i+3
+! if (j.ne.20) return
+! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!
! Fourth-order contributions
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!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
+
a_temp(1,1)=a22
a_temp(1,2)=a23
a_temp(2,1)=a32
a_temp(2,2)=a33
- iti1=itortyp(itype(i+1))
- iti2=itortyp(itype(i+2))
- iti3=itortyp(itype(i+3))
+ iti1=itortyp(itype(i+1,1))
+ iti2=itortyp(itype(i+2,1))
+ iti3=itortyp(itype(i+3,1))
! 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 matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
- eello_turn4=eello_turn4-(s1+s2+s3)
+ if (shield_mode.eq.0) then
+ fac_shield(i)=1.0
+ fac_shield(j)=1.0
+ endif
+
+ eello_turn4=eello_turn4-(s1+s2+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+ eello_t4=-(s1+s2+s3) &
+ *fac_shield(i)*fac_shield(j)
+!C Now derivative over shield:
+ if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
+ (shield_mode.gt.0)) then
+!C print *,i,j
+
+ do ilist=1,ishield_list(i)
+ iresshield=shield_list(ilist,i)
+ do k=1,3
+ rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
+! print *,"rlocshield",rlocshield,grad_shield_side(k,ilist,i),iresshield
+ gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
+ gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
+ +rlocshield
+ enddo
+ enddo
+ do ilist=1,ishield_list(j)
+ iresshield=shield_list(ilist,j)
+ do k=1,3
+! print *,"rlocshieldj",j,rlocshield,grad_shield_side(k,ilist,j),iresshield
+ rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
+ gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
+ rlocshield &
+ +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
+ gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
+ +rlocshield
+! print *,"after", gshieldc_t4(k,iresshield-1),iresshield-1,gshieldc_t4(k,iresshield)
+
+ enddo
+ enddo
+ do k=1,3
+ gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
+ grad_shield(k,i)*eello_t4/fac_shield(i)
+ gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
+ grad_shield(k,j)*eello_t4/fac_shield(j)
+ gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
+ grad_shield(k,i)*eello_t4/fac_shield(i)
+ gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
+ grad_shield(k,j)*eello_t4/fac_shield(j)
+! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1)
+ enddo
+ 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),
s1=scalar2(b1(1,iti2),auxvec(1))
call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
+ gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
! Derivatives in gamma(i+1)
call transpose2(EUgder(1,1,i+2),e2tder(1,1))
call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
+ gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
! Derivatives in gamma(i+2)
call transpose2(EUgder(1,1,i+3),e3tder(1,1))
call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
+ gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
! Cartesian derivatives
! Derivatives of this turn contributions in DC(i+2)
if (j.lt.nres-1) then
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
ggg(l)=-(s1+s2+s3)
- gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
+ gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
enddo
endif
! Remaining derivatives of this turn contribution
call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
+ gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
a_temp(1,1)=aggi1(l,1)
a_temp(1,2)=aggi1(l,2)
a_temp(2,1)=aggi1(l,3)
call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
+ gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
a_temp(1,1)=aggj(l,1)
a_temp(1,2)=aggj(l,2)
a_temp(2,1)=aggj(l,3)
call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
+! if (j.lt.nres-1) then
+ gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+! endif
+
a_temp(1,1)=aggj1(l,1)
a_temp(1,2)=aggj1(l,2)
a_temp(2,1)=aggj1(l,3)
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
- gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
+! if (j.lt.nres-1) then
+! print *,"juest before",j1, gcorr4_turn(l,j1)
+ gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+! if (shield_mode.gt.0) then
+! print *,"juest after",j1, gcorr4_turn(l,j1),gshieldc_t4(k,j1),gshieldc_loc_t4(k,j1),gel_loc_turn4(i+2)
+! else
+! print *,"juest after",j1, gcorr4_turn(l,j1),gel_loc_turn4(i+2)
+! endif
+! endif
enddo
+ gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
+ ssgradlipi*eello_t4/4.0d0*lipscale
+ gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
+ ssgradlipj*eello_t4/4.0d0*lipscale
+ gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
+ ssgradlipi*eello_t4/4.0d0*lipscale
+ gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
+ ssgradlipj*eello_t4/4.0d0*lipscale
+
return
end subroutine eturn4
!-----------------------------------------------------------------------------
! implicit none
real(kind=8),dimension(3) :: u,vec
real(kind=8),dimension(3,3) ::ugrad,ungrad
- real(kind=8) :: unorm !,scalar
+ real(kind=8) :: unorm !,scalar
integer :: i,j
! write (2,*) 'ugrad',ugrad
! write (2,*) 'u',u
!d print '(a)','Enter ESCP'
!d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
do i=iatscp_s,iatscp_e
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ 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))
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- if (itype(j).eq.ntyp1) cycle
- itypj=iabs(itype(j))
+ if (itype(j,1).eq.ntyp1) cycle
+ itypj=iabs(itype(j,1))
! Uncomment following three lines for SC-p interactions
! xj=c(1,nres+j)-xi
! yj=c(2,nres+j)-yi
!d print '(a)','Enter ESCP'
!d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
do i=iatscp_s,iatscp_e
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ 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))
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
! Uncomment following three lines for SC-p interactions
! xj=c(1,nres+j)-xi
! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
if (.not.dyn_ss .and. i.le.nss) then
! 15/02/13 CC dynamic SSbond - additional check
- if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
- iabs(itype(jjj)).eq.1) then
+ if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
+ iabs(itype(jjj,1)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
!d write (iout,*) "eij",eij
endif
+ else if (ii.gt.nres .and. jj.gt.nres) then
+!c Restraints from contact prediction
+ dd=dist(ii,jj)
+ if (constr_dist.eq.11) then
+ ehpb=ehpb+fordepth(i)**4.0d0 &
+ *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0 &
+ *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+ if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
+ ehpb,fordepth(i),dd
+ else
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+!c write (iout,*) "beta nmr",
+!c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ dd=dist(ii,jj)
+ rdis=dd-dhpb(i)
+!C Get the force constant corresponding to this distance.
+ waga=forcon(i)
+!C Calculate the contribution to energy.
+ ehpb=ehpb+waga*rdis*rdis
+!c write (iout,*) "beta reg",dd,waga*rdis*rdis
+!C
+!C Evaluate gradient.
+!C
+ fac=waga*rdis/dd
+ endif
+ endif
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
+ do j=1,3
+ ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
+ ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
+ enddo
+ do k=1,3
+ ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+ ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+ enddo
else
-! Calculate the distance between the two points and its difference from the
-! target distance.
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
-! Get the force constant corresponding to this distance.
- waga=forcon(i)
-! Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-!
-! Evaluate gradient.
-!
- fac=waga*rdis/dd
-!d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
-!d & ' waga=',waga,' fac=',fac
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
-!d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
-! If this is a SC-SC distance, we need to calculate the contributions to the
-! Cartesian gradient in the SC vectors (ghpbx).
- if (iii.lt.ii) then
+ dd=dist(ii,jj)
+ if (constr_dist.eq.11) then
+ ehpb=ehpb+fordepth(i)**4.0d0 &
+ *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0 &
+ *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+ if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
+ ehpb,fordepth(i),dd
+ else
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+!c write (iout,*) "alph nmr",
+!c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ rdis=dd-dhpb(i)
+!C Get the force constant corresponding to this distance.
+ waga=forcon(i)
+!C Calculate the contribution to energy.
+ ehpb=ehpb+waga*rdis*rdis
+!c write (iout,*) "alpha reg",dd,waga*rdis*rdis
+!C
+!C Evaluate gradient.
+!C
+ fac=waga*rdis/dd
+ endif
+ endif
+
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
+!cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
+!C If this is a SC-SC distance, we need to calculate the contributions to the
+!C Cartesian gradient in the SC vectors (ghpbx).
+ if (iii.lt.ii) then
do j=1,3
ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
enddo
- endif
-!grad do j=iii,jjj-1
-!grad do k=1,3
-!grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
-!grad enddo
-!grad enddo
- do k=1,3
- ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
- ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
- enddo
+ endif
+!cgrad do j=iii,jjj-1
+!cgrad do k=1,3
+!cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
+!cgrad enddo
+!cgrad enddo
+ do k=1,3
+ ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+ ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+ enddo
endif
enddo
- ehpb=0.5D0*ehpb
+ if (constr_dist.ne.11) ehpb=0.5D0*ehpb
+
return
end subroutine edis
!-----------------------------------------------------------------------------
deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
cosphi,ggk
- itypi=iabs(itype(i))
+ itypi=iabs(itype(i,1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
dzi=dc_norm(3,nres+i)
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(nres+i)
- itypj=iabs(itype(j))
+ itypj=iabs(itype(j,1))
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
xj=c(1,nres+j)-xi
! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
do i=ibondp_start,ibondp_end
- if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
- if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
+ if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
+ if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
!C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
!C do j=1,3
!C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
! endif
enddo
estr=0.5d0*AKP*estr+estr1
+! print *,"estr_bb",estr,AKP
!
! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
!
do i=ibond_start,ibond_end
- iti=iabs(itype(i))
+ iti=iabs(itype(i,1))
+ if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
if (iti.ne.10 .and. iti.ne.ntyp1) then
nbi=nbondterm(iti)
if (nbi.eq.1) then
"estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
AKSC(1,iti),AKSC(1,iti)*diff*diff
estr=estr+0.5d0*AKSC(1,iti)*diff*diff
+! print *,"estr_sc",estr
do j=1,3
gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
enddo
usumsqder=usumsqder+ud(j)*uprod2
enddo
estr=estr+uprod/usum
+! print *,"estr_sc",estr,i
+
+ if (energy_dec) write (iout,*) &
+ "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
+ AKSC(1,iti),uprod/usum
do j=1,3
gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
enddo
etheta=0.0D0
! write (*,'(a,i2)') 'EBEND ICG=',icg
do i=ithet_start,ithet_end
- if (itype(i-1).eq.ntyp1) cycle
+ if (itype(i-1,1).eq.ntyp1) cycle
! Zero the energy function and its derivative at 0 or pi.
call splinthet(theta(i),0.5d0*delta,ss,ssd)
- it=itype(i-1)
- ichir1=isign(1,itype(i-2))
- ichir2=isign(1,itype(i))
- if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
- if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
- if (itype(i-1).eq.10) then
- itype1=isign(10,itype(i-2))
- ichir11=isign(1,itype(i-2))
- ichir12=isign(1,itype(i-2))
- itype2=isign(10,itype(i))
- ichir21=isign(1,itype(i))
- ichir22=isign(1,itype(i))
+ it=itype(i-1,1)
+ ichir1=isign(1,itype(i-2,1))
+ ichir2=isign(1,itype(i,1))
+ if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
+ if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
+ if (itype(i-1,1).eq.10) then
+ itype1=isign(10,itype(i-2,1))
+ ichir11=isign(1,itype(i-2,1))
+ ichir12=isign(1,itype(i-2,1))
+ itype2=isign(10,itype(i,1))
+ ichir21=isign(1,itype(i,1))
+ ichir22=isign(1,itype(i,1))
endif
- if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
+ if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
if (phii.ne.phii) phii=150.0
y(1)=0.0D0
y(2)=0.0D0
endif
- if (i.lt.nres .and. itype(i).ne.ntyp1) then
+ if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
if (phii1.ne.phii1) phii1=150.0
if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
enddo
+! print *,ithetaconstr_start,ithetaconstr_end,"TU"
+
! Ufff.... We've done all this!!!
return
end subroutine ebend
end subroutine theteng
#else
!-----------------------------------------------------------------------------
- subroutine ebend(etheta)
+ subroutine ebend(etheta,ethetacnstr)
!
! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
! angles gamma and its derivatives in consecutive thetas and gammas.
!el local variables
integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
- real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
+ real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
+! local variables for constrains
+ real(kind=8) :: difi,thetiii
+ integer itheta
etheta=0.0D0
do i=ithet_start,ithet_end
- if (itype(i-1).eq.ntyp1) cycle
- if (itype(i-2).eq.ntyp1.or.itype(i).eq.ntyp1) cycle
- if (iabs(itype(i+1)).eq.20) iblock=2
- if (iabs(itype(i+1)).ne.20) iblock=1
+ if (itype(i-1,1).eq.ntyp1) cycle
+ if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
+ if (iabs(itype(i+1,1)).eq.20) iblock=2
+ if (iabs(itype(i+1,1)).ne.20) iblock=1
dethetai=0.0d0
dephii=0.0d0
dephii1=0.0d0
theti2=0.5d0*theta(i)
- ityp2=ithetyp((itype(i-1)))
+ ityp2=ithetyp((itype(i-1,1)))
do k=1,nntheterm
coskt(k)=dcos(k*theti2)
sinkt(k)=dsin(k*theti2)
enddo
- if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
+ if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
if (phii.ne.phii) phii=150.0
#else
phii=phi(i)
#endif
- ityp1=ithetyp((itype(i-2)))
+ ityp1=ithetyp((itype(i-2,1)))
! propagation of chirality for glycine type
do k=1,nsingle
cosph1(k)=dcos(k*phii)
enddo
else
phii=0.0d0
- ityp1=ithetyp(itype(i-2))
+ ityp1=ithetyp(itype(i-2,1))
do k=1,nsingle
cosph1(k)=0.0d0
sinph1(k)=0.0d0
enddo
endif
- if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
+ if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
if (phii1.ne.phii1) phii1=150.0
#else
phii1=phi(i+1)
#endif
- ityp3=ithetyp((itype(i)))
+ ityp3=ithetyp((itype(i,1)))
do k=1,nsingle
cosph2(k)=dcos(k*phii1)
sinph2(k)=dsin(k*phii1)
enddo
else
phii1=0.0d0
- ityp3=ithetyp(itype(i))
+ ityp3=ithetyp(itype(i,1))
do k=1,nsingle
cosph2(k)=0.0d0
sinph2(k)=0.0d0
if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
gloc(nphi+i-2,icg)=wang*dethetai
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
#endif
escloc=0.0D0
! write (iout,'(a)') 'ESC'
do i=loc_start,loc_end
- it=itype(i)
+ it=itype(i,1)
if (it.eq.ntyp1) cycle
if (it.eq.10) goto 1
nlobit=nlob(iabs(it))
delta=0.02d0*pi
escloc=0.0D0
do i=loc_start,loc_end
- if (itype(i).eq.ntyp1) cycle
+ if (itype(i,1).eq.ntyp1) cycle
costtab(i+1) =dcos(theta(i+1))
sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
cosfac=dsqrt(cosfac2)
sinfac2=0.5d0/(1.0d0-costtab(i+1))
sinfac=dsqrt(sinfac2)
- it=iabs(itype(i))
+ it=iabs(itype(i,1))
if (it.eq.10) goto 1
!
! Compute the axes of tghe local cartesian coordinates system; store in
y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
enddo
do j = 1,3
- z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
+ z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
enddo
! write (2,*) "i",i
! write (2,*) "x_prime",(x_prime(j),j=1,3)
! Compute the energy of the ith side cbain
!
! write (2,*) "xx",xx," yy",yy," zz",zz
- it=iabs(itype(i))
+ it=iabs(itype(i,1))
do j = 1,65
x(j) = sc_parmin(j,it)
enddo
!c diagnostics - remove later
xx1 = dcos(alph(2))
yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
+ zz1 = -dsign(1.0,dfloat(itype(i,1)))*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
! & dscp1,dscp2,sumene
! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
-! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
+! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
! & ,zz,xx,yy
!#define DEBUG
#ifdef DEBUG
!
! Compute the gradient of esc
!
-! zz=zz*dsign(1.0,dfloat(itype(i)))
+! zz=zz*dsign(1.0,dfloat(itype(i,1)))
pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
+(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
+(pom1+pom2)*pom_dx
#ifdef DEBUG
- write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
+ write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
#endif
!
sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
+(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
+(pom1-pom2)*pom_dy
#ifdef DEBUG
- write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
+ write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
#endif
!
de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
+x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
+ ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
#ifdef DEBUG
- write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
+ write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
#endif
!
de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
-0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
+pom1*pom_dt1+pom2*pom_dt2
#ifdef DEBUG
- write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
+ write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
#endif
!
!
dZZ_Ci(k)=0.0d0
do j=1,3
dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
- *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
+ *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
- *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
+ *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
enddo
dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
etors=0.0D0
do i=iphi_start,iphi_end
etors_ii=0.0D0
- if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
- .or. itype(i).eq.ntyp1) cycle
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
+ if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
+ .or. itype(i,1).eq.ntyp1) cycle
+ itori=itortyp(itype(i-2,1))
+ itori1=itortyp(itype(i-1,1))
phii=phi(i)
gloci=0.0D0
! Proline-Proline pair is a special case...
'etor',i,etors_ii
if (lprn) &
write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
- restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
+ restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
(v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
difi=phii-phi0(i)
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
endif
! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
! lprn=.true.
etors=0.0D0
do i=iphi_start,iphi_end
- if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
- .or. itype(i-3).eq.ntyp1 &
- .or. itype(i).eq.ntyp1) cycle
+ if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
+ .or. itype(i-3,1).eq.ntyp1 &
+ .or. itype(i,1).eq.ntyp1) cycle
etors_ii=0.0D0
- if (iabs(itype(i)).eq.20) then
+ if (iabs(itype(i,1)).eq.20) then
iblock=2
else
iblock=1
endif
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
+ itori=itortyp(itype(i-2,1))
+ itori1=itortyp(itype(i-1,1))
phii=phi(i)
gloci=0.0D0
! Regular cosine and sine terms
'etor',i,etors_ii-v0(itori,itori1,iblock)
if (lprn) &
write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
- restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
+ restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
(v1(j,itori,itori1,iblock),j=1,6),&
(v2(j,itori,itori1,iblock),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
difi=pinorm(phii-phi0(i))
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else
difi=0.0
endif
! write(iout,*) "a tu??"
do i=iphid_start,iphid_end
etors_d_ii=0.0D0
- if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
- .or. itype(i-3).eq.ntyp1 &
- .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- itori2=itortyp(itype(i))
+ if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
+ .or. itype(i-3,1).eq.ntyp1 &
+ .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ itori=itortyp(itype(i-2,1))
+ itori1=itortyp(itype(i-1,1))
+ itori2=itortyp(itype(i,1))
phii=phi(i)
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
iblock=1
- if (iabs(itype(i+1)).eq.20) iblock=2
+ if (iabs(itype(i+1,1)).eq.20) iblock=2
! Regular cosine and sine terms
do j=1,ntermd_1(itori,itori1,itori2,iblock)
! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
esccor=0.0D0
do i=itau_start,itau_end
- if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
+ if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
esccor_ii=0.0D0
- isccori=isccortyp(itype(i-2))
- isccori1=isccortyp(itype(i-1))
+ 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)
! 2 = Ca...Ca...Ca...SC
! 3 = SC...Ca...Ca...SCi
gloci=0.0D0
- if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
- (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
- (itype(i-1).eq.ntyp1))) &
- .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
- .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
- .or.(itype(i).eq.ntyp1))) &
- .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
- (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
- (itype(i-3).eq.ntyp1)))) cycle
- if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
- if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
+ 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)
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)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
+ 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
real(kind=8),dimension(3) :: gx,gx1
logical :: lprn
!el local variables
- integer :: i,j,k,l,jj,kk,ll
+ 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
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
lprn=.false.
eij=facont_hb(jj,i)
!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
allocate(dipderx(3,5,4,maxconts,nres))
!
- iti1 = itortyp(itype(i+1))
+ iti1 = itortyp(itype(i+1,1))
if (j.lt.nres-1) then
- itj1 = itortyp(itype(j+1))
+ itj1 = itortyp(itype(j+1,1))
else
itj1=ntortyp+1
endif
if (l.eq.j+1) then
! parallel orientation of the two CA-CA-CA frames.
if (i.gt.1) then
- iti=itortyp(itype(i))
+ iti=itortyp(itype(i,1))
else
iti=ntortyp+1
endif
- itk1=itortyp(itype(k+1))
- itj=itortyp(itype(j))
+ itk1=itortyp(itype(k+1,1))
+ itj=itortyp(itype(j,1))
if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
+ itl1=itortyp(itype(l+1,1))
else
itl1=ntortyp+1
endif
else
! Antiparallel orientation of the two CA-CA-CA frames.
if (i.gt.1) then
- iti=itortyp(itype(i))
+ iti=itortyp(itype(i,1))
else
iti=ntortyp+1
endif
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
+ 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))
+ itj1=itortyp(itype(j+1,1))
else
itj1=ntortyp+1
endif
! o o o o C
! /l\ / \ \ / \ / \ / C
! / \ / \ \ / \ / \ / C
-! j| o |l1 | o | o| o | | o |o C
+! j| o |l1 | o | o| o | | o |o C
! \ |/k\| |/ \| / |/ \| |/ \| C
! \i/ \ / \ / / \ / \ C
! o k1 o C
! o o o o C
! /j\ / \ \ / \ / \ / C
! / \ / \ \ / \ / \ / C
-! j1| o |l | o | o| o | | o |o C
+! j1| o |l | o | o| o | | o |o C
! \ |/k\| |/ \| / |/ \| |/ \| C
! \i/ \ / \ / / \ / \ C
! o k1 o C
!d write (iout,*)
!d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
!d & ' and',k,l
- itk=itortyp(itype(k))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
+ 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
! i i C
! C
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- itk=itortyp(itype(k))
+ 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))
!
! 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))
+ iti=itortyp(itype(i,1))
if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
+ itj1=itortyp(itype(j+1,1))
else
itj1=ntortyp+1
endif
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
+ itk=itortyp(itype(k,1))
+ itk1=itortyp(itype(k+1,1))
if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
+ itl1=itortyp(itype(l+1,1))
else
itl1=ntortyp+1
endif
! 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))
- itj=itortyp(itype(j))
+ iti=itortyp(itype(i,1))
+ itj=itortyp(itype(j,1))
if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
+ itj1=itortyp(itype(j+1,1))
else
itj1=ntortyp+1
endif
- itk=itortyp(itype(k))
+ itk=itortyp(itype(k,1))
if (k.lt.nres-1) then
- itk1=itortyp(itype(k+1))
+ itk1=itortyp(itype(k+1,1))
else
itk1=ntortyp+1
endif
- itl=itortyp(itype(l))
+ itl=itortyp(itype(l,1))
if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
+ itl1=itortyp(itype(l+1,1))
else
itl1=ntortyp+1
endif
j=i+4
k=i+1
l=i+3
- iti=itortyp(itype(i))
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
+ 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
#ifdef MPI
include 'mpif.h'
#endif
- real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
+ real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
gloc_scbuf !(3,maxres)
real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
call flush(iout)
#endif
#ifdef SPLITELE
- do i=1,nct
+ do i=0,nct
do j=1,3
gradbufc(j,i)=wsc*gvdwc(j,i)+ &
wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
wcorr5*gradcorr5_long(j,i)+ &
wcorr6*gradcorr6_long(j,i)+ &
wturn6*gcorr6_turn_long(j,i)+ &
- wstrain*ghpbc(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
#else
- do i=1,nct
+ do i=0,nct
do j=1,3
gradbufc(j,i)=wsc*gvdwc(j,i)+ &
wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
wcorr5*gradcorr5_long(j,i)+ &
wcorr6*gradcorr6_long(j,i)+ &
wturn6*gcorr6_turn_long(j,i)+ &
- wstrain*ghpbc(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
#endif
enddo
call flush(iout)
#endif
- do i=1,nres
+ do i=0,nres
do j=1,3
gradbufc_sum(j,i)=gradbufc(j,i)
enddo
#ifdef TIMING
! time_allreduce=time_allreduce+MPI_Wtime()-time00
#endif
- do i=nnt,nres
+ do i=0,nres
do k=1,3
gradbufc(k,i)=0.0d0
enddo
do j=1,3
gradbufc(j,nres-1)=gradbufc_sum(j,nres)
enddo
- do i=nres-2,nnt,-1
+ do i=nres-2,-1,-1
do j=1,3
gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
call flush(iout)
#endif
!el#undef DEBUG
- do i=1,nres
+ do i=-1,nres
do j=1,3
gradbufc_sum(j,i)=gradbufc(j,i)
gradbufc(j,i)=0.0d0
do j=1,3
gradbufc(j,nres-1)=gradbufc_sum(j,nres)
enddo
- do i=nres-2,nnt,-1
+ do i=nres-2,-1,-1
do j=1,3
gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
!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 i=-1,nct
do j=1,3
#ifdef SPLITELE
gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
wcorr6*gradcorr6(j,i)+ &
wturn6*gcorr6_turn(j,i)+ &
wsccor*gsccorc(j,i) &
- +wscloc*gscloc(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)+ &
wcorr6*gradcorr6(j,i)+ &
wturn6*gcorr6_turn(j,i)+ &
wsccor*gsccorc(j,i) &
- +wscloc*gscloc(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)
+
+
+
+
#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)
+ +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)
+
enddo
- enddo
+ enddo
+!#define DEBUG
#ifdef DEBUG
write (iout,*) "gloc before 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=1,nres
+ do i=0,nres
gradbufc(j,i)=gradc(j,i,icg)
gradbufx(j,i)=gradx(j,i,icg)
enddo
call MPI_Barrier(FG_COMM,IERR)
time_barrier_g=time_barrier_g+MPI_Wtime()-time00
time00=MPI_Wtime()
- call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
+ 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,1),gradx(1,1,icg),3*nres,&
+ 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)
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=1,nres
endif
endif
endif
-!el#define DEBUG
+!#define DEBUG
#ifdef DEBUG
write (iout,*) "gradc gradx gloc"
do i=1,nres
i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
enddo
#endif
-!el#undef DEBUG
+!#undef DEBUG
#ifdef TIMING
time_sumgradient=time_sumgradient+MPI_Wtime()-time01
#endif
! 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
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
- -2.0D0*alf12*eps3der+sigder*sigsq_om12
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
! diagnostics only
! eom1=0.0d0
! eom2=0.0d0
do k=1,3
gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
!C print *,'gg',k,gg(k)
- enddo
+ 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) &
+ 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) &
+ 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
!grad enddo
!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)+gg_lipi(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
enddo
return
end subroutine sc_grad
!
ind1=0
do i=1,nres-2
- ind1=ind1+1
+ ind1=ind1+1
!
! Derivatives of DC(i+1) in theta(i+2)
!
! theta(nres) and phi(i+3) thru phi(nres).
!
do j=i+1,nres-2
- ind1=ind1+1
- ind=indmat(i+1,j+1)
+ 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
enddo
do k=1,3
dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
- enddo
+ enddo
do k=1,3
dxoijk=0.0D0
do l=1,3
! Derivatives in alpha and omega:
!
do i=2,nres-1
-! dsci=dsc(itype(i))
+! dsci=dsc(itype(i,1))
dsci=vbld(i+nres)
#ifdef OSF
alphi=alph(i)
if(alphi.ne.alphi) alphi=100.0
if(omegi.ne.omegi) omegi=-100.0
#else
- alphi=alph(i)
- omegi=omeg(i)
+ alphi=alph(i)
+ omegi=omeg(i)
#endif
!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
+ 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)
+ xp=temp(1,j)
+ yp=temp(2,j)
+ xxp= xp*cost2+yp*sint2
+ yyp=-xp*sint2+yp*cost2
+ zzp=temp(3,j)
+ xx(1)=xxp
+ xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
+ xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
+ do k=1,3
+ dj=0.0D0
+ do l=1,3
+ dj=dj+prod(k,l,i-1)*xx(l)
enddo
- dxds(jjj+k,i)=dj
+ dxds(jjj+k,i)=dj
enddo
- jjj=jjj+3
- enddo
+ jjj=jjj+3
+ enddo
enddo
return
end subroutine 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)
+ alphi=alph(i)
+ alph(i)=alph(i)+aincr
+ do k=1,3
+ temp(k,i)=dc(k,nres+i)
enddo
- call chainbuild
- do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
+ call chainbuild
+ do k=1,3
+ gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
+ xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
enddo
write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
write (iout,'(a)')
- alph(i)=alphi
- call chainbuild
+ 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)
+ 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
+ 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))
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
+ omeg(i)=omegi
+ call chainbuild
enddo
write (iout,'(a)')
write (iout,'(a)') '**************** dx/dtheta'
write (iout,'(a)')
do i=3,nres
- theti=theta(i)
+ theti=theta(i)
theta(i)=theta(i)+aincr
do j=i-1,nres-1
do k=1,3
enddo
call chainbuild
do j=i-1,nres-1
- ii = indmat(i-2,j)
+ 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))/ &
+ 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)') &
enddo
call chainbuild
do j=i-1,nres-1
- ii = indmat(i-2,j)
+ ii = indmat(i-2,j)
! print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
+ 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
enddo
call chainbuild
do j=i+1,nres-1
- ii = indmat(i,j)
+ 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))/ &
+ 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)')
+ write (iout,'(a)')
enddo
do j=1,nres
do k=1,3
enddo
call chainbuild
do j=i+2,nres-1
- ii = indmat(i+1,j)
+ ii = indmat(i+1,j)
! print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
+ 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)')
+ write (iout,'(a)')
enddo
do j=1,nres
do k=1,3
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)
+ do j=1,3
+ 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
+ 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
+ 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
+ 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)
+ 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)/)') &
+ 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
! call intcartderiv
! call checkintcartgrad
call zerograd
- aincr=1.0D-5
+ aincr=1.0D-4
write(iout,*) 'Calling CHECK_ECARTINT.'
nf=0
icall=0
- write (iout,*) "Before geom_to_var"
call geom_to_var(nvar,x)
- write (iout,*) "after geom_to_var"
write (iout,*) "split_ene ",split_ene
call flush(iout)
if (.not.split_ene) then
- write(iout,*) 'Calling CHECK_ECARTINT if'
+ call zerograd
call etotal(energia)
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
etot=energia(0)
- write (iout,*) "etot",etot
- call flush(iout)
-!el call enerprint(energia)
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
call cartgrad
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
- write (iout,*) "exit cartgrad"
- call flush(iout)
icall =1
do i=1,nres
write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
do j=1,3
grad_s(j,0)=gcart(j,0)
enddo
-!elwrite(iout,*) 'Calling CHECK_ECARTINT if'
do i=1,nres
do j=1,3
grad_s(j,i)=gcart(j,i)
enddo
enddo
else
-write(iout,*) 'Calling CHECK_ECARTIN else.'
!- split gradient check
call zerograd
call etotal_long(energia)
!el call enerprint(energia)
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
icall =1
- write (iout,*) "longrange grad"
do i=1,nres
write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
(gxcart(j,i),j=1,3)
enddo
call zerograd
call etotal_short(energia)
-!el call enerprint(energia)
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
+ call enerprint(energia)
call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
icall =1
- write (iout,*) "shortrange grad"
do i=1,nres
write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
(gxcart(j,i),j=1,3)
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)
+ 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
+ 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+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)
write (iout,*) "ij",i,j," etot1",etot1
endif
!- end split gradient
! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- c(j,i)=ddc(j)-aincr
+ c(j,i)=ddc(j)-aincr
if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
dc(j,i+nres)=c(j,i+nres)-c(j,i)
call int_from_cart1(.false.)
if (.not.split_ene) then
+ call zerograd
call etotal(energia1)
etot2=energia1(0)
write (iout,*) "ij",i,j," etot2",etot2
- ggg(j)=(etot1-etot2)/(2*aincr)
+ ggg(j)=(etot1-etot2)/(2*aincr)
else
!- split gradient
call etotal_long(energia1)
etot21=energia1(0)
- ggg(j)=(etot11-etot21)/(2*aincr)
+ ggg(j)=(etot11-etot21)/(2*aincr)
call etotal_short(energia1)
etot22=energia1(0)
- ggg1(j)=(etot12-etot22)/(2*aincr)
+ ggg1(j)=(etot12-etot22)/(2*aincr)
!- end split gradient
! write (iout,*) "etot21",etot21," etot22",etot22
endif
! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- c(j,i)=ddc(j)
+ c(j,i)=ddc(j)
if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
dc_norm(j,i)=dcnorm_safe2(j)
dc_norm(j,i+nres)=dxnorm_safe(j)
enddo
- do j=1,3
- c(j,i+nres)=ddx(j)+aincr
+ do j=1,3
+ c(j,i+nres)=ddx(j)+aincr
dc(j,i+nres)=c(j,i+nres)-c(j,i)
call int_from_cart1(.false.)
if (.not.split_ene) then
+ call zerograd
call etotal(energia1)
etot1=energia1(0)
else
etot12=energia1(0)
endif
!- end split gradient
- c(j,i+nres)=ddx(j)-aincr
+ c(j,i+nres)=ddx(j)-aincr
dc(j,i+nres)=c(j,i+nres)-c(j,i)
call int_from_cart1(.false.)
if (.not.split_ene) then
- call etotal(energia1)
+ call zerograd
+ call etotal(energia1)
etot2=energia1(0)
- ggg(j+3)=(etot1-etot2)/(2*aincr)
+ ggg(j+3)=(etot1-etot2)/(2*aincr)
else
!- split gradient
call etotal_long(energia1)
etot21=energia1(0)
- ggg(j+3)=(etot11-etot21)/(2*aincr)
+ ggg(j+3)=(etot11-etot21)/(2*aincr)
call etotal_short(energia1)
etot22=energia1(0)
- ggg1(j+3)=(etot12-etot22)/(2*aincr)
+ ggg1(j+3)=(etot12-etot22)/(2*aincr)
!- end split gradient
endif
! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- c(j,i+nres)=ddx(j)
+ c(j,i+nres)=ddx(j)
dc(j,i+nres)=c(j,i+nres)-c(j,i)
dc_norm(j,i+nres)=dxnorm_safe(j)
call int_from_cart1(.false.)
enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
if (split_ene) then
write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
call etotal(energia)
etot=energia(0)
!el call enerprint(energia)
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
icall =1
do i=1,nres
write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
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
call zerograd
call etotal_long(energia)
!el call enerprint(energia)
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
icall =1
- write (iout,*) "longrange grad"
do i=1,nres
write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
(gxcart(j,i),j=1,3)
do i=1,nres
do j=1,3
grad_s(j,i)=gcart(j,i)
+! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
grad_s(j+3,i)=gxcart(j,i)
enddo
enddo
call zerograd
call etotal_short(energia)
!el call enerprint(energia)
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
icall =1
- write (iout,*) "shortrange grad"
do i=1,nres
write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
(gxcart(j,i),j=1,3)
write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
do i=0,nres
do j=1,3
- xx(j)=c(j,i+nres)
- ddc(j)=dc(j,i)
- ddx(j)=dc(j,i+nres)
+ xx(j)=c(j,i+nres)
+ ddc(j)=dc(j,i)
+ ddx(j)=dc(j,i+nres)
do k=1,3
dcnorm_safe(k)=dc_norm(k,i)
dxnorm_safe(k)=dc_norm(k,i+nres)
enddo
enddo
- do j=1,3
- dc(j,i)=ddc(j)+aincr
+ do j=1,3
+ dc(j,i)=ddc(j)+aincr
call chainbuild_cart
#ifdef MPI
! Broadcast the order to compute internal coordinates to the slaves.
#endif
! call int_from_cart1(.false.)
if (.not.split_ene) then
+ call zerograd
call etotal(energia1)
etot1=energia1(0)
+! call enerprint(energia1)
else
!- split gradient
call etotal_long(energia1)
endif
!- end split gradient
! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- dc(j,i)=ddc(j)-aincr
+ dc(j,i)=ddc(j)-aincr
call chainbuild_cart
! call int_from_cart1(.false.)
if (.not.split_ene) then
+ call zerograd
call etotal(energia1)
etot2=energia1(0)
- ggg(j)=(etot1-etot2)/(2*aincr)
+ ggg(j)=(etot1-etot2)/(2*aincr)
else
!- split gradient
call etotal_long(energia1)
etot21=energia1(0)
- ggg(j)=(etot11-etot21)/(2*aincr)
+ ggg(j)=(etot11-etot21)/(2*aincr)
call etotal_short(energia1)
etot22=energia1(0)
- ggg1(j)=(etot12-etot22)/(2*aincr)
+ ggg1(j)=(etot12-etot22)/(2*aincr)
!- end split gradient
! write (iout,*) "etot21",etot21," etot22",etot22
endif
! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- dc(j,i)=ddc(j)
+ dc(j,i)=ddc(j)
call chainbuild_cart
enddo
- do j=1,3
- dc(j,i+nres)=ddx(j)+aincr
+ do j=1,3
+ dc(j,i+nres)=ddx(j)+aincr
call chainbuild_cart
! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
! write (iout,*)
if (.not.split_ene) then
+ call zerograd
call etotal(energia1)
etot1=energia1(0)
else
endif
!- end split gradient
! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- dc(j,i+nres)=ddx(j)-aincr
+ dc(j,i+nres)=ddx(j)-aincr
call chainbuild_cart
! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
! write (iout,*) "dxnormnormsafe",dsqrt(
! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
if (.not.split_ene) then
+ call zerograd
call etotal(energia1)
etot2=energia1(0)
- ggg(j+3)=(etot1-etot2)/(2*aincr)
+ ggg(j+3)=(etot1-etot2)/(2*aincr)
else
!- split gradient
call etotal_long(energia1)
etot21=energia1(0)
- ggg(j+3)=(etot11-etot21)/(2*aincr)
+ ggg(j+3)=(etot11-etot21)/(2*aincr)
call etotal_short(energia1)
etot22=energia1(0)
- ggg1(j+3)=(etot12-etot22)/(2*aincr)
+ ggg1(j+3)=(etot12-etot22)/(2*aincr)
!- end split gradient
endif
! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- dc(j,i+nres)=ddx(j)
+ dc(j,i+nres)=ddx(j)
call chainbuild_cart
enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
if (split_ene) then
write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
call var_to_geom(nvar,x)
call chainbuild
icall=1
- print *,'ICG=',ICG
+! print *,'ICG=',ICG
call etotal(energia)
etot = energia(0)
!el call enerprint(energia)
- print *,'ICG=',ICG
+! print *,'ICG=',ICG
#ifdef MPL
if (MyID.ne.BossID) then
call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
endif
return
end function sscagrad_ele
+ real(kind=8) function sscalelip(r)
+ real(kind=8) r,gamm
+ sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
+ return
+ end function sscalelip
+!C-----------------------------------------------------------------------
+ real(kind=8) function sscagradlip(r)
+ real(kind=8) r,gamm
+ sscagradlip=r*(6.0d0*r-6.0d0)
+ return
+ end function sscagradlip
+
!!!!!!!!!!!!!!!
!-----------------------------------------------------------------------------
subroutine elj_long(evdw)
! include 'COMMON.IOUNITS'
! include 'COMMON.CONTACTS'
real(kind=8),parameter :: accur=1.0d-10
- real(kind=8),dimension(3) :: gg
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
!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
! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
!d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
!d & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
rrij=1.0D0/rij
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
evdwij=e1+e2
evdw=evdw+(1.0d0-sss)*evdwij
!
! include 'COMMON.IOUNITS'
! include 'COMMON.CONTACTS'
real(kind=8),parameter :: accur=1.0d-10
- real(kind=8),dimension(3) :: gg
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
!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
! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
!d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
!d & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
rrij=1.0D0/rij
eps0ij=eps(itypi,itypj)
fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
evdwij=e1+e2
evdw=evdw+sss*evdwij
!
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
! include 'COMMON.NAMES'
- real(kind=8),dimension(3) :: gg
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
logical :: scheck
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
!
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
if (sss.lt.1.0d0) then
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
evdwij=e_augm+e1+e2
!d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
!d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
!d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
+!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
!d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
!d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
!d & (c(k,i),k=1,3),(c(k,j),k=1,3)
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
! include 'COMMON.NAMES'
- real(kind=8),dimension(3) :: gg
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
logical :: scheck
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
!
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
if (sss.gt.0.0d0) then
r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
evdwij=e_augm+e1+e2
!d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
!d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
!d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
+!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
!d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
!d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
!d & (c(k,i),k=1,3),(c(k,j),k=1,3)
! endif
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
!el ind=ind+1
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
! Calculate whole angle-dependent part of epsilon and contributions
! to its derivatives
fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ 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(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ 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),i,restyp(itypj),j,
+!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),
! endif
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
!el ind=ind+1
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
! Calculate whole angle-dependent part of epsilon and contributions
! to its derivatives
fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ 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*sss
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ 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),i,restyp(itypj),j,
+!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),
real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
real(kind=8) :: sss,e1,e2,evdw,sss_grad
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init
+ dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
+ ssgradlipi,ssgradlipj
+
evdw=0.0D0
!cccc energy_dec=.false.
! if (icall.eq.0) lprn=.false.
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
if (yi.lt.0) yi=yi+boxysize
zi=mod(zi,boxzsize)
if (zi.lt.0) zi=zi+boxzsize
+ if ((zi.gt.bordlipbot) &
+ .and.(zi.lt.bordliptop)) then
+!C the energy transfer exist
+ if (zi.lt.buflipbot) then
+!C what fraction I am in
+ fracinbuf=1.0d0- &
+ ((zi-bordlipbot)/lipbufthick)
+!C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
!
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
+! 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)
+!C search over all next residues
+! if (dyn_ss_mask(k)) then
+!C check if they are cysteins
+!C write(iout,*) 'k=',k
+
+!c write(iout,*) "PRZED TRI", evdwij
+! evdwij_przed_tri=evdwij
+! call triple_ssbond_ene(i,j,k,evdwij)
+!c if(evdwij_przed_tri.ne.evdwij) then
+!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
+!c endif
+
+!c write(iout,*) "PO TRI", evdwij
+!C call the energy function that removes the artifical triple disulfide
+!C bond the soubroutine is located in ssMD.F
+! evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,'tss'
+! endif!dyn_ss_mask(k)
+! enddo! k
+
+ ELSE
!el ind=ind+1
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
! & 1.0d0/vbld(j+nres)
-! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
sig0ij=sigma(itypi,itypj)
chi1=chi(itypi,itypj)
chi2=chi(itypj,itypi)
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
if (rij_shift.le.0.0D0) then
evdw=1.0D20
!d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-!d & restyp(itypi),i,restyp(itypj),j,
+!d & restyp(itypi,1),i,restyp(itypj,1),j,
!d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
return
endif
!---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
evdwij=evdwij*eps2rt*eps3rt
evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi),i,restyp(itypj),j,&
+ restyp(itypi,1),i,restyp(itypj,1),j,&
epsi,sigm,chi1,chi2,chip1,chip2,&
eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
gg(3)=zj*fac
! Calculate angular part of the gradient.
call sc_grad_scale(1.0d0-sss)
+ ENDIF !mask_dyn_ss
endif
enddo ! j
enddo ! iint
real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init
+ dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
+ ssgradlipi,ssgradlipj
evdw=0.0D0
!cccc energy_dec=.false.
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
! if (icall.eq.0) lprn=.false.
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
if (yi.lt.0) yi=yi+boxysize
zi=mod(zi,boxzsize)
if (zi.lt.0) zi=zi+boxzsize
+ if ((zi.gt.bordlipbot) &
+ .and.(zi.lt.bordliptop)) then
+!C the energy transfer exist
+ if (zi.lt.buflipbot) then
+!C what fraction I am in
+ fracinbuf=1.0d0- &
+ ((zi-bordlipbot)/lipbufthick)
+!C lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
!
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
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,' ss'
+ do k=j+1,iend(i,iint)
+!C search over all next residues
+ if (dyn_ss_mask(k)) then
+!C check if they are cysteins
+!C write(iout,*) 'k=',k
+
+!c write(iout,*) "PRZED TRI", evdwij
+! evdwij_przed_tri=evdwij
+ call triple_ssbond_ene(i,j,k,evdwij)
+!c if(evdwij_przed_tri.ne.evdwij) then
+!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
+!c endif
+
+!c write(iout,*) "PO TRI", evdwij
+!C call the energy function that removes the artifical triple disulfide
+!C bond the soubroutine is located in ssMD.F
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
+
+! if (energy_dec) write (iout,*) &
+! 'evdw',i,j,evdwij,' ss'
+ ELSE
!el ind=ind+1
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
! & 1.0d0/vbld(j+nres)
-! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
sig0ij=sigma(itypi,itypj)
chi1=chi(itypi,itypj)
chi2=chi(itypj,itypi)
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
if (rij_shift.le.0.0D0) then
evdw=1.0D20
!d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-!d & restyp(itypi),i,restyp(itypj),j,
+!d & restyp(itypi,1),i,restyp(itypj,1),j,
!d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
return
endif
!---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ e1=fac*fac*aa
+ e2=fac*bb
evdwij=eps1*eps2rt*eps3rt*(e1+e2)
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
evdwij=evdwij*eps2rt*eps3rt
evdw=evdw+evdwij*sss*sss_ele_cut
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi),i,restyp(itypj),j,&
+ restyp(itypi,1),i,restyp(itypj,1),j,&
epsi,sigm,chi1,chi2,chip1,chip2,&
eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
! Calculate angular part of the gradient.
call sc_grad_scale(sss)
endif
+ ENDIF !mask_dyn_ss
enddo ! j
enddo ! iint
enddo ! i
! if (icall.eq.0) lprn=.true.
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
!el ind=ind+1
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
!---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ 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+e_augm)*(1.0d0-sss)
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi),i,restyp(itypj),j,&
+ restyp(itypi,1),i,restyp(itypj,1),j,&
epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
chi1,chi2,chip1,chip2,&
eps1,eps2rt**2,eps3rt**2,&
! if (icall.eq.0) lprn=.true.
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1)
+ itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
!el ind=ind+1
- itypj=itype(j)
+ itypj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
!---------------------------------------------------------------
rij_shift=1.0D0/rij_shift
fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ 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+e_augm)*sss
if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi),i,restyp(itypj),j,&
+ restyp(itypi,1),i,restyp(itypj,1),j,&
epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
chi1,chi2,chip1,chip2,&
eps1,eps2rt**2,eps3rt**2,&
#ifdef TIMING
time01=MPI_Wtime()
#endif
+! print *, "before set matrices"
call set_matrices
+! print *,"after set martices"
#ifdef TIMING
time_mat=time_mat+MPI_Wtime()-time01
#endif
! Loop over i,i+2 and i,i+3 pairs of the peptide groups
!
do i=iturn3_start,iturn3_end
- if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
- .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
+ if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
+ .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
+ 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
num_conti=0
call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
num_cont_hb(i)=num_conti
enddo
do i=iturn4_start,iturn4_end
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
- .or. itype(i+3).eq.ntyp1 &
- .or. itype(i+4).eq.ntyp1) cycle
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
+ .or. itype(i+3,1).eq.ntyp1 &
+ .or. itype(i+4,1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
+ 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
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).ne.ntyp1) &
+ if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
call eturn4(i,eello_turn4)
num_cont_hb(i)=num_conti
enddo ! i
! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
!
do i=iatel_s,iatel_e
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ 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)
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
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
do j=ielstart(i),ielend(i)
- if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
+ if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
call eelecij_scale(i,j,ees,evdw1,eel_loc)
enddo ! j
num_cont_hb(i)=num_conti
! include 'COMMON.VECTORS'
! include 'COMMON.FFIELD'
! include 'COMMON.TIME1'
- real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
+ real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
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) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init,sss_grad
+ integer xshift,yshift,zshift
+
!el integer :: num_conti,j1,j2
!el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
!el dz_normi,xmedi,ymedi,zmedi
0.0d0,1.0d0,0.0d0,&
0.0d0,0.0d0,1.0d0/),shape(unmat))
!el local variables
- integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
+ integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
-! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
-! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
+! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
+! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
#ifdef MPI
time00=MPI_Wtime()
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-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
rrmij=1.0D0/rij
rij=dsqrt(rij)
rmij=1.0D0/rij
! For extracting the short-range part of Evdwpp
sss=sscale(rij/rpp(iteli,itelj))
+ sss_ele_cut=sscale_ele(rij)
+ sss_ele_grad=sscagrad_ele(rij)
+ sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
+! sss_ele_cut=1.0d0
+! sss_ele_grad=0.0d0
+ if (sss_ele_cut.le.0.0) go to 128
r3ij=rrmij*rmij
r6ij=r3ij*r3ij
eesij=el1+el2
! 12/26/95 - for the evaluation of multi-body H-bonding interactions
ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij
- evdw1=evdw1+evdwij*(1.0d0-sss)
+ ees=ees+eesij*sss_ele_cut
+ evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
!d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
!d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
!d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
! Calculate contributions to the Cartesian gradient.
!
#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
- facel=-3*rrmij*(el1+eesij)
+ facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
+ facel=-3*rrmij*(el1+eesij)*sss_ele_cut
fac1=fac
erij(1)=xj*rmij
erij(2)=yj*rmij
!
! Radial derivatives. First process both termini of the fragment (i,j)
!
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
+ ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
+ ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
+ ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
! do k=1,3
! ghalf=0.5D0*ggg(k)
! gelc(k,i)=gelc(k,i)+ghalf
!grad gelc(l,k)=gelc(l,k)+ggg(l)
!grad enddo
!grad enddo
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
+ ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
+ -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
+ ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
+ -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
+ ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
+ -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
! do k=1,3
! ghalf=0.5D0*ggg(k)
! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
!grad enddo
!grad enddo
#else
- facvdw=ev1+evdwij*(1.0d0-sss)
- facel=el1+eesij
+ facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
+ facel=(el1+eesij)*sss_ele_cut
fac1=fac
fac=-3*rrmij*(facvdw+facvdw+facel)
erij(1)=xj*rmij
!d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
!d & (dcosg(k),k=1,3)
do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
+ ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
enddo
! do k=1,3
! ghalf=0.5D0*ggg(k)
do k=1,3
gelc(k,i)=gelc(k,i) &
+(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
- + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+ + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
+ *sss_ele_cut
gelc(k,j)=gelc(k,j) &
+(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
- + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+ + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
+ *sss_ele_cut
gelc_long(k,j)=gelc_long(k,j)+ggg(k)
gelc_long(k,i)=gelc_long(k,i)-ggg(k)
enddo
a32=a32*fac
a33=a33*fac
!d write (iout,'(4i5,4f10.5)')
-!d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
+!d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
!d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
!d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
!d & uy(:,j),uz(:,j)
eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
+a33*muij(4)
! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-
+! print *,"EELLOC",i,gel_loc_loc(i-1)
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
'eelloc',i,j,eel_loc_ij
! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
- eel_loc=eel_loc+eel_loc_ij
+ eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
! Partial derivatives in virtual-bond dihedral angles gamma
if (i.gt.1) &
gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
- a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
- +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
- a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
- +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
-! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
+ (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
+ +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
+ *sss_ele_cut
+ gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
+ (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
+ +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
+ *sss_ele_cut
+ xtemp(1)=xj
+ xtemp(2)=yj
+ xtemp(3)=zj
+
+! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
do l=1,3
- ggg(l)=agg(l,1)*muij(1)+ &
- agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
+ ggg(l)=(agg(l,1)*muij(1)+ &
+ agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
+ *sss_ele_cut &
+ +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
+
gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
!grad ghalf=0.5d0*ggg(l)
!grad enddo
! Remaining derivatives of eello
do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
- aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
- gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
- aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
- gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
- aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
- gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
- aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
+ gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
+ aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
+ *sss_ele_cut
+
+ gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
+ aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
+ *sss_ele_cut
+
+ gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
+ aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
+ *sss_ele_cut
+
+ gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
+ aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
+ *sss_ele_cut
+
enddo
ENDIF
! Change 12/26/95 to calculate four-body contributions to H-bonding energy
ees0mij=0
endif
! ees0mij=0.0D0
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
+ ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
+ *sss_ele_cut
+
+ ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
+ *sss_ele_cut
+
! Diagnostics. Comment out or remove after debugging!
! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
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
+! 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
+ gggp(1)=gggp(1)+ees0pijp*xj &
+ +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
+ gggp(2)=gggp(2)+ees0pijp*yj &
+ +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
+ gggp(3)=gggp(3)+ees0pijp*zj &
+ +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
+
+ gggm(1)=gggm(1)+ees0mijp*xj &
+ +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
+
+ gggm(2)=gggm(2)+ees0mijp*yj &
+ +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
+
+ gggm(3)=gggm(3)+ees0mijp*zj &
+ +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
+
! Derivatives due to the contact function
gacont_hbr(1,num_conti,i)=fprimcont*xj
gacont_hbr(2,num_conti,i)=fprimcont*yj
!
!grad ghalfp=0.5D0*gggp(k)
!grad ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)= & !ghalfp
- +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
- + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontp_hb2(k,num_conti,i)= & !ghalfp
- +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
- + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)= &!ghalfm
- +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
- + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontm_hb2(k,num_conti,i)= & !ghalfm
- +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
- + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontm_hb3(k,num_conti,i)=gggm(k)
+! gacontp_hb1(k,num_conti,i)= & !ghalfp
+! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+! gacontp_hb2(k,num_conti,i)= & !ghalfp
+! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+! gacontp_hb3(k,num_conti,i)=gggp(k)
+! gacontm_hb1(k,num_conti,i)= &!ghalfm
+! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+! gacontm_hb2(k,num_conti,i)= & !ghalfm
+! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+! gacontm_hb3(k,num_conti,i)=gggm(k)
+ 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
+
+ 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
+
+ gacontp_hb3(k,num_conti,i)=gggp(k) &
+ *sss_ele_cut
+
+ 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
+
+ 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
+
+ gacontm_hb3(k,num_conti,i)=gggm(k) &
+ *sss_ele_cut
+
enddo
ENDIF ! wcorr
endif ! num_conti.le.maxconts
enddo
endif
endif
+ 128 continue
! t_eelecij=t_eelecij+MPI_Wtime()-time00
return
end subroutine eelecij_scale
real(kind=8) :: scal_el=0.5d0
#endif
!el local variables
- integer :: i,j,k,iteli,itelj,num_conti
+ integer :: i,j,k,iteli,itelj,num_conti,isubchap
real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
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
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init,sss_grad
+ integer xshift,yshift,zshift
+
evdw1=0.0D0
! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
! & " iatel_e_vdw",iatel_e_vdw
call flush(iout)
do i=iatel_s_vdw,iatel_e_vdw
- if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
+ 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)
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
num_conti=0
! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
! & ' ielend',ielend_vdw(i)
call flush(iout)
do j=ielstart_vdw(i),ielend_vdw(i)
- if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
+ if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
!el ind=ind+1
iteli=itel(i)
itelj=itel(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-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
rrmij=1.0D0/rij
rij=dsqrt(rij)
sss=sscale(rij/rpp(iteli,itelj))
+ sss_ele_cut=sscale_ele(rij)
+ sss_ele_grad=sscagrad_ele(rij)
+ sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
+ if (sss_ele_cut.le.0.0) cycle
if (sss.gt.0.0d0) then
rmij=1.0D0/rij
r3ij=rrmij*rmij
if (energy_dec) then
write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
endif
- evdw1=evdw1+evdwij*sss
+ evdw1=evdw1+evdwij*sss*sss_ele_cut
!
! Calculate contributions to the Cartesian gradient.
!
- facvdw=-6*rrmij*(ev1+evdwij)*sss
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
+ facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
+! ggg(1)=facvdw*xj
+! ggg(2)=facvdw*yj
+! ggg(3)=facvdw*zj
+ ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
+ +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
+ ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
+ +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
+ ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
+ +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
+
do k=1,3
gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
!el local variables
- integer :: i,iint,j,k,iteli,itypj
- real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
+ integer :: i,iint,j,k,iteli,itypj,subchap
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
real(kind=8) :: evdw2,evdw2_14,evdwij
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init
+
evdw2=0.0D0
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
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ 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
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
+ itypj=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)
+ 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)
- sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
+ rij=dsqrt(1.0d0/rrij)
+ sss_ele_cut=sscale_ele(rij)
+ sss_ele_grad=sscagrad_ele(rij)
+! print *,sss_ele_cut,sss_ele_grad,&
+! (rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ sss=sscale((rij/rscp(itypj,iteli)))
+ sss_grad=sscale_grad(rij/rscp(itypj,iteli))
if (sss.lt.1.0d0) then
fac=rrij**expon2
if (iabs(j-i) .le. 2) then
e1=scal14*e1
e2=scal14*e2
- evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
+ evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
endif
evdwij=e1+e2
- evdw2=evdw2+evdwij*(1.0d0-sss)
+ evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
'evdw2',i,j,sss,evdwij
!
! Calculate contributions to the gradient in the virtual-bond and SC vectors.
!
- fac=-(evdwij+e1)*rrij*(1.0d0-sss)
+ fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
+ fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
+ -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
ggg(1)=xj*fac
ggg(2)=yj*fac
ggg(3)=zj*fac
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
!el local variables
- integer :: i,iint,j,k,iteli,itypj
- real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
+ integer :: i,iint,j,k,iteli,itypj,subchap
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
real(kind=8) :: evdw2,evdw2_14,evdwij
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init
+
evdw2=0.0D0
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
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ 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
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
+ itypj=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
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-
- sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
- if (sss.gt.0.0d0) then
-
- fac=rrij**expon2
- e1=fac*fac*aad(itypj,iteli)
- e2=fac*bad(itypj,iteli)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- evdw2_14=evdw2_14+(e1+e2)*sss
- endif
- evdwij=e1+e2
- evdw2=evdw2+evdwij*sss
- if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
- 'evdw2',i,j,sss,evdwij
-!
-! Calculate contributions to the gradient in the virtual-bond and SC vectors.
-!
- fac=-(evdwij+e1)*rrij*sss
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-! Uncomment following three lines for SC-p interactions
-! do k=1,3
-! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-! enddo
-! Uncomment following line for SC-p interactions
-! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
- do k=1,3
- gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
- gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
- enddo
- endif
- enddo
-
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
- gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
- gradx_scp(j,i)=expon*gradx_scp(j,i)
- enddo
+! 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)
+ rij=dsqrt(1.0d0/rrij)
+ sss_ele_cut=sscale_ele(rij)
+ sss_ele_grad=sscagrad_ele(rij)
+! print *,sss_ele_cut,sss_ele_grad,&
+! (rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ sss=sscale(rij/rscp(itypj,iteli))
+ sss_grad=sscale_grad(rij/rscp(itypj,iteli))
+ if (sss.gt.0.0d0) then
+
+ fac=rrij**expon2
+ e1=fac*fac*aad(itypj,iteli)
+ e2=fac*bad(itypj,iteli)
+ if (iabs(j-i) .le. 2) then
+ e1=scal14*e1
+ e2=scal14*e2
+ evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
+ endif
+ evdwij=e1+e2
+ evdw2=evdw2+evdwij*sss*sss_ele_cut
+ if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
+ 'evdw2',i,j,sss,evdwij
+!
+! Calculate contributions to the gradient in the virtual-bond and SC vectors.
+!
+ fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
+ fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
+ +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
+
+ ggg(1)=xj*fac
+ ggg(2)=yj*fac
+ ggg(3)=zj*fac
+! Uncomment following three lines for SC-p interactions
+! do k=1,3
+! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
+! enddo
+! Uncomment following line for SC-p interactions
+! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
+ do k=1,3
+ gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
+ gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
+ enddo
+ endif
+ enddo
+
+ enddo ! iint
+ enddo ! i
+ do i=1,nct
+ do j=1,3
+ gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
+ gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
+ gradx_scp(j,i)=expon*gradx_scp(j,i)
+ enddo
enddo
!******************************************************************************
!
!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
+ real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
nres6=6*nres
! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
!
! Calculate the virtual-bond-angle energy.
!
- call ebend(ebe)
+ call ebend(ebe,ethetacnstr)
!
! Calculate the SC local energy.
!
endif
return
end function gnmr1prim
-!-----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+ real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
+ real(kind=8) y,ymin,ymax,sigma
+ real(kind=8) wykl /4.0d0/
+ 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)
+ else
+ rlornmr1=0.0d0
+ endif
+ return
+ end function rlornmr1
+!------------------------------------------------------------------------------
+ real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
+ real(kind=8) y,ymin,ymax,sigma
+ real(kind=8) wykl /4.0d0/
+ if (y.lt.ymin) then
+ 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/ &
+ ((y-ymax)**wykl+sigma**wykl)**2
+ else
+ rlornmr1prim=0.0d0
+ endif
+ return
+ end function rlornmr1prim
+
real(kind=8) function harmonic(y,ymax)
! implicit none
real(kind=8) :: y,ymax
ind=0
ind1=0
do i=1,nres-2
- gthetai=0.0D0
- gphii=0.0D0
- do j=i+1,nres-1
+ gthetai=0.0D0
+ gphii=0.0D0
+ do j=i+1,nres-1
ind=ind+1
! ind=indmat(i,j)
! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
- do k=1,3
+ 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)
+ do k=1,3
+ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
enddo
enddo
- do j=i+1,nres-1
+ 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
- gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
- gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
+ do k=1,3
+ gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
+ gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
enddo
enddo
- if (i.gt.1) g(i-1)=gphii
- if (n.gt.nphi) g(nphi+i)=gthetai
+ if (i.gt.1) g(i-1)=gphii
+ if (n.gt.nphi) g(nphi+i)=gthetai
enddo
if (n.le.nphi+ntheta) goto 10
do i=2,nres-1
- if (itype(i).ne.10) then
+ if (itype(i,1).ne.10) then
galphai=0.0D0
- gomegai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
+ gomegai=0.0D0
+ do k=1,3
+ galphai=galphai+dxds(k,i)*gradx(k,i,icg)
enddo
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
+ do k=1,3
+ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
enddo
g(ialph(i,1))=galphai
- g(ialph(i,1)+nside)=gomegai
+ g(ialph(i,1)+nside)=gomegai
endif
enddo
!
real(kind=8) :: urparm(1)
real(kind=8) :: f
real(kind=8),external :: ufparm
- real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
+ real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
! if (jjj.gt.0) then
! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
! endif
! This subrouting calculates total Cartesian coordinate gradient.
! The subroutine chainbuild_cart and energy MUST be called beforehand.
!
-!el#define DEBUG
+!#define DEBUG
#ifdef TIMING
time00=MPI_Wtime()
#endif
call sum_gradient
#ifdef TIMING
#endif
+!#define DEBUG
!el write (iout,*) "After sum_gradient"
#ifdef DEBUG
!el write (iout,*) "After sum_gradient"
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
do i=1,nct
#endif
! call checkintcartgrad
! write(iout,*) 'calling int_to_cart'
+!#define DEBUG
#ifdef DEBUG
write (iout,*) "gcart, gxcart, gloc before int_to_cart"
#endif
- do i=1,nct
+ do i=0,nct
do j=1,3
gcart(j,i)=gradc(j,i,icg)
gxcart(j,i)=gradx(j,i,icg)
+! 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),&
#ifdef TIMING
time01=MPI_Wtime()
#endif
+! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
call int_to_cart
+! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
+
#ifdef TIMING
- time_inttocart=time_inttocart+MPI_Wtime()-time01
+ time_inttocart=time_inttocart+MPI_Wtime()-time01
#endif
#ifdef DEBUG
- 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)
- enddo
+ 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)
+ enddo
#endif
+!#undef DEBUG
#ifdef CARGRAD
#ifdef DEBUG
- write (iout,*) "CARGRAD"
+ write (iout,*) "CARGRAD"
#endif
- do i=nres,1,-1
- do j=1,3
- gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
-! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
- enddo
-! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
-! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
- enddo
-! Correction: dummy residues
- 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_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
- gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
- enddo
- endif
+ do i=nres,0,-1
+ do j=1,3
+ gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
+ ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
+ enddo
+ ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
+ ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
+ enddo
+ ! Correction: dummy residues
+ 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_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
+ 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
-!el#undef DEBUG
- return
- end subroutine cartgrad
-!-----------------------------------------------------------------------------
- subroutine zerograd
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.DERIV'
-! include 'COMMON.CHAIN'
-! include 'COMMON.VAR'
-! include 'COMMON.MD'
-! include 'COMMON.SCCOR'
-!
-!el local variables
- integer :: i,j,intertyp
-! Initialize Cartesian-coordinate gradient
-!
-! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
-! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
-
-! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
-! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
-! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
-! allocate(gradcorr_long(3,nres))
-! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
-! allocate(gcorr6_turn_long(3,nres))
-! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
-
-! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
-
-! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
-! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
-
-! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
-! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
-
-! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
-! allocate(gscloc(3,nres)) !(3,maxres)
-! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
-
-
-
-! common /deriv_scloc/
-! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
-! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
-! 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
- do intertyp=1,3
- gloc_sc(intertyp,i,icg)=0.0d0
- enddo
- enddo
- enddo
-!
-! Initialize the gradient of local energy terms.
-!
-! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
-! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
-! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
-! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
-! allocate(gel_loc_turn3(nres))
-! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
-! allocate(gsccor_loc(nres)) !(maxres)
+!#undef DEBUG
+ return
+ end subroutine cartgrad
+ !-----------------------------------------------------------------------------
+ subroutine zerograd
+ ! implicit real*8 (a-h,o-z)
+ ! include 'DIMENSIONS'
+ ! include 'COMMON.DERIV'
+ ! include 'COMMON.CHAIN'
+ ! include 'COMMON.VAR'
+ ! include 'COMMON.MD'
+ ! include 'COMMON.SCCOR'
+ !
+ !el local variables
+ integer :: i,j,intertyp,k
+ ! Initialize Cartesian-coordinate gradient
+ !
+ ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
+ ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
+
+ ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
+ ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
+ ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
+ ! allocate(gradcorr_long(3,nres))
+ ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
+ ! allocate(gcorr6_turn_long(3,nres))
+ ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
+
+ ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
+
+ ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
+ ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
+
+ ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
+ ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
+
+ ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
+ ! allocate(gscloc(3,nres)) !(3,maxres)
+ ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
+
+
+
+ ! common /deriv_scloc/
+ ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
+ ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
+ ! 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
+ 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
- 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
-!-----------------------------------------------------------------------------
- real(kind=8) function fdum()
- fdum=0.0D0
- return
- end function fdum
-!-----------------------------------------------------------------------------
-! intcartderiv.F
-!-----------------------------------------------------------------------------
- subroutine intcartderiv
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
+ !
+ ! Initialize the gradient of local energy terms.
+ !
+ ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
+ ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
+ ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
+ ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
+ ! allocate(gel_loc_turn3(nres))
+ ! 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
+ ! 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
+ !-----------------------------------------------------------------------------
+ real(kind=8) function fdum()
+ fdum=0.0D0
+ return
+ end function fdum
+ !-----------------------------------------------------------------------------
+ ! intcartderiv.F
+ !-----------------------------------------------------------------------------
+ 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.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.INTERACT'
-! include 'COMMON.DERIV'
-! 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
+ ! include 'COMMON.SETUP'
+ ! include 'COMMON.CHAIN'
+ ! include 'COMMON.VAR'
+ ! include 'COMMON.GEO'
+ ! include 'COMMON.INTERACT'
+ ! include 'COMMON.DERIV'
+ ! 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
-!el from module energy-------------
-!el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
-!el allocate(dsintau(3,3,3,itau_start:itau_end))
-!el allocate(dtauangle(3,3,3,itau_start:itau_end))
+ !el from module energy-------------
+ !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
+ !el allocate(dsintau(3,3,3,itau_start:itau_end))
+ !el allocate(dtauangle(3,3,3,itau_start:itau_end))
-!el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
-!el allocate(dsintau(3,3,3,0:nres2))
-!el allocate(dtauangle(3,3,3,0:nres2))
-!el allocate(domicron(3,2,2,0:nres2))
-!el allocate(dcosomicron(3,2,2,0:nres2))
+ !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
+ !el allocate(dsintau(3,3,3,0:nres2))
+ !el allocate(dtauangle(3,3,3,0:nres2))
+ !el allocate(domicron(3,2,2,0:nres2))
+ !el allocate(dcosomicron(3,2,2,0:nres2))
#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)
+ ! 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
-! Derivatives of theta's
+ ! 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
+ ! 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
+ ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
+ 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).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).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) 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
#if defined(MPI) && defined(PARINTDER)
-! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
+ ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
+ do i=max0(ithet_start-1,3),ithet_end
#else
- do i=3,nres
+ do i=3,nres
#endif
- if ((itype(i-1).ne.10).and.(itype(i-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
-!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/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/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/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),vbld(i-1+nres)
- domicron(j,2,2,i)=-1/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.
+ 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
+ !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)
+ !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)
+ ! 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
+ !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).eq.21 .or. itype(i-2).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)
-! 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).ne.ntyp1 .and. itype(i-2).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
-! Bug fixed 3/24/05 (AL)
- enddo
-! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- if (itype(i-1).ne.ntyp1 .and. itype(i-2).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/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/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/sing*dcosphi(j,3,i)
- endif
- enddo
- endif
- enddo
-!alculate derivative of Tauangle
+ ! 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)
+ ! 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)
+ ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
+ dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
+ endif
+ ! Bug fixed 3/24/05 (AL)
+ 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)
+!#define DEBUG
+#ifdef DEBUG
+ write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
+#endif
+!#undef DEBUG
+ 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
-!elwrite(iout,*) " vecpr",i,nres
+ do i=3,nres
+ !elwrite(iout,*) " vecpr",i,nres
#endif
- if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
-! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
-! & (itype(i-1).eq.ntyp1).or.(itype(i).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))
-!elwrite(iout,*) " vecpr5",i,nres
- 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)
-! 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
-! 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)
-! write(iout,*) "dsintau", 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)
-! & +(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
-! 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)
-! write (iout,*) "else",i
- enddo
- endif
-! do k=1,3
-! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
-! enddo
- enddo
-!C Second case Ca...Ca...Ca...SC
+ 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))
+ !elwrite(iout,*) " vecpr5",i,nres
+ 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)
+ ! 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
+ ! 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)
+ ! write(iout,*) "dsintau", 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)
+ ! & +(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
+ ! 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)
+ ! write (iout,*) "else",i
+ enddo
+ endif
+ ! do k=1,3
+ ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
+ ! 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).eq.ntyp1).or.(itype(i-1).eq.10).or. &
- (itype(i-2).eq.ntyp1).or.(itype(i-3).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))
-! 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)
-! 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)
-! 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)
-! 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)
-! 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)
-! & +(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
-! 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)
-! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
- enddo
- endif
- enddo
+ 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))
+ ! 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)
+ ! 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)
+ ! 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)
+ ! 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)
+ ! 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)
+ ! & +(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
+ ! 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)
+ ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
+ enddo
+ endif
+ enddo
-!CC third case SC...Ca...Ca...SC
+ !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).eq.ntyp1).or.(itype(i-1).eq.10).or. &
- (itype(i-2).eq.ntyp1).or.(itype(i-2).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)
-! 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)
-! 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)
-! & +(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
-! 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)
-! write(iout,*) "else",i
- enddo
- endif
- enddo
+ ! 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)
+ ! 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)
+ ! 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)
+ ! 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)
+ ! & +(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
+ ! 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)
+ ! write(iout,*) "else",i
+ enddo
+ endif
+ enddo
#ifdef CRYST_SC
-! Derivatives of side-chain angles alpha and omega
+ ! 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
+ do i=2,nres-1
#endif
- if(itype(i).ne.10 .and. itype(i).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
-! 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))
+ 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
+ ! 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
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
- do j=1,3
- do k=1,3
- dalpha(k,j,i)=0.0d0
- domega(k,j,i)=0.0d0
- enddo
- enddo
- endif
- enddo
+ 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
+ !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
#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
+ !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
#endif
- 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)
+!#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)
+ !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)
-!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(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)
#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
- return
- end subroutine intcartderiv
-!-----------------------------------------------------------------------------
- subroutine checkintcartgrad
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
+!#undef DEBUG
+ return
+ end subroutine intcartderiv
+ !-----------------------------------------------------------------------------
+ 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.GEO'
-! include 'COMMON.INTERACT'
-! 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
-! 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.)
+ ! include 'COMMON.CHAIN'
+ ! include 'COMMON.VAR'
+ ! include 'COMMON.GEO'
+ ! include 'COMMON.INTERACT'
+ ! 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
+ ! 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
+ call chainbuild_cart
dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
dc(j,i-1)=dcji
enddo
dc(j,i-3)=dcji+aincr
call chainbuild_cart
dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-3)=dcji
+ dc(j,i-3)=dcji
dcji=dc(j,i-2)
dc(j,i-2)=dcji+aincr
call chainbuild_cart
write (iout,*) &
"Analytical (upper) and numerical (lower) gradient of alpha"
do i=2,nres-1
- if(itype(i).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
+ 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
+ /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
+ /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
+ /aincr
dc(j,i+nres)=dcji
enddo
- endif
+ 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),&
write (iout,*) &
"Analytical (upper) and numerical (lower) gradient of omega"
do i=2,nres-1
- if(itype(i).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
+ 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
+ /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
+ /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
+ /aincr
dc(j,i+nres)=dcji
enddo
- endif
+ 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),&
! include 'COMMON.VAR'
integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
integer :: kkk,nsep=3
- real(kind=8) :: qm !dist,
+ real(kind=8) :: qm !dist,
real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
logical :: lprn=.false.
logical :: flag
(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).ne.10 .or. itype(jl).ne.10) then
+ 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+ &
endif
qq = qq+qqij+qqijCM
enddo
- enddo
+ enddo
qq = qq/nl
else
do il=seg1,seg2
(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).ne.10 .or. itype(jl).ne.10) then
+ 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+ &
logical :: lprn=.false.
logical :: flag
real(kind=8) :: sim,dd0,fac,ddqij
-!el sigm(x)=0.25d0*x ! local function
+!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
+ dxqwol(j,i)=0.0d0
enddo
enddo
nl=0
sim = sim*sim
dd0 = dij-d0ij
fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
+ 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).ne.10 .or. itype(jl).ne.10) then
+
+ 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+ &
dxqwol(k,il)=dxqwol(k,il)+ddqij
dxqwol(k,jl)=dxqwol(k,jl)-ddqij
enddo
- endif
+ endif
enddo
- enddo
+ enddo
else
do il=seg1,seg2
if((seg3-il).lt.3) then
dqwol(k,il)=dqwol(k,il)+ddqij
dqwol(k,jl)=dqwol(k,jl)-ddqij
enddo
- if (itype(il).ne.10 .or. itype(jl).ne.10) then
+ 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+ &
enddo
endif
enddo
- enddo
+ enddo
endif
enddo
do i=0,nres
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
+! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
+! hmnum=(hm2-hm1)/delta
! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
! & qinfrag(i,iset))
-! write(iout,*) "harmonicnum frag", hmnum
+! 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)
dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
enddo
enddo
- enddo
+ enddo
do i=1,npair
kstart=ifrag(1,ipair(1,i,iset),iset)
kend=ifrag(2,ipair(1,i,iset),iset)
! Calculating dU/dQ
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
+! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
+! hmnum=(hm2-hm1)/delta
! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
! & qinpair(i,iset))
-! write(iout,*) "harmonicnum pair ", hmnum
+! write(iout,*) "harmonicnum pair ", hmnum
! Calculating dQ/dXi
call qwolynes_prim(kstart,kend,.false.,&
lstart,lend)
do j=1,3
dudxconst(j,i)=duxconst(j,i)
enddo
- enddo
+ enddo
! write(iout,*) "dU/ddc backbone "
! do ii=0,nres
! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
cdummy(j,i)=dc(j,i)
dc(j,i)=dc(j,i)+delta
call chainbuild_cart
- uzap2=0.0d0
+ uzap2=0.0d0
do ii=1,nfrag
qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
idummy,idummy)
uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
qinpair(ii,iset))
enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
+ ducartan(j,i)=(uzap2-uzap1)/(delta)
enddo
enddo
! Calculating numerical gradients for dU/ddx
cdummy(j,i)=dc(j,i+nres)
dc(j,i+nres)=dc(j,i+nres)+delta
call chainbuild_cart
- uzap2=0.0d0
+ uzap2=0.0d0
do ii=1,nfrag
qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
idummy,idummy)
uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
qinpair(ii,iset))
enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
+ duxcartan(j,i)=(uzap2-uzap1)/(delta)
enddo
enddo
write(iout,*) "Numerical dUconst/ddc backbone "
!el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
!el allocate(dyn_ssbond_ij(0:nres+4,nres))
- itypi=itype(i)
+ 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)
- itypj=itype(j)
+ itypj=itype(j,1)
xj=c(1,nres+j)-c(1,nres+i)
yj=c(2,nres+j)-c(2,nres+i)
zj=c(3,nres+j)-c(3,nres+i)
ljXs=sig-sig0ij
ljA=eps1*eps2rt**2*eps3rt**2
- ljB=ljA*bb(itypi,itypj)
- ljA=ljA*aa(itypi,itypj)
- ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+ ljB=ljA*bb_aq(itypi,itypj)
+ ljA=ljA*aa_aq(itypi,itypj)
+ ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
ssXs=d0cm
deltat1=1.0d0-om1
! 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(itypi,itypj)/aa(itypi,itypj)
+ 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
havebond=.false.
ljd=rij-ljXs
fac=(1.0D0/ljd)**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
+ 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
eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
else
havebond=.false.
- ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
- d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
+ 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)
return
end subroutine dyn_ssbond_ene
+!--------------------------------------------------------------------------
+ subroutine triple_ssbond_ene(resi,resj,resk,eij)
+! implicit none
+! Includes
+ use calc_data
+ use comm_sschecks
+! include 'DIMENSIONS'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.LOCAL'
+! include 'COMMON.INTERACT'
+! include 'COMMON.VAR'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+#ifndef CLUST
+#ifndef WHAM
+ use MD_data
+! include 'COMMON.MD'
+! use MD, only: totT,t_bath
+#endif
+#endif
+ double precision h_base
+ external h_base
+
+!c Input arguments
+ integer resi,resj,resk,m,itypi,itypj,itypk
+
+!c Output arguments
+ double precision eij,eij1,eij2,eij3
+
+!c Local variables
+ logical havebond
+!c integer itypi,itypj,k,l
+ double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
+ double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
+ double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
+ double precision sig0ij,ljd,sig,fac,e1,e2
+ double precision dcosom1(3),dcosom2(3),ed
+ double precision pom1,pom2
+ double precision ljA,ljB,ljXs
+ double precision d_ljB(1:3)
+ double precision ssA,ssB,ssC,ssXs
+ double precision ssxm,ljxm,ssm,ljm
+ double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
+ eij=0.0
+ if (dtriss.eq.0) return
+ i=resi
+ j=resj
+ k=resk
+!C write(iout,*) resi,resj,resk
+ 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)
+ itypj=itype(j,1)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ dscj_inv=vbld_inv(j+nres)
+ itypk=itype(k,1)
+ xk=c(1,nres+k)
+ yk=c(2,nres+k)
+ zk=c(3,nres+k)
+
+ dxk=dc_norm(1,nres+k)
+ dyk=dc_norm(2,nres+k)
+ dzk=dc_norm(3,nres+k)
+ dscj_inv=vbld_inv(k+nres)
+ xij=xj-xi
+ xik=xk-xi
+ xjk=xk-xj
+ yij=yj-yi
+ yik=yk-yi
+ yjk=yk-yj
+ zij=zj-zi
+ zik=zk-zi
+ zjk=zk-zj
+ rrij=(xij*xij+yij*yij+zij*zij)
+ rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
+ rrik=(xik*xik+yik*yik+zik*zik)
+ rik=dsqrt(rrik)
+ rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
+ rjk=dsqrt(rrjk)
+!C there are three combination of distances for each trisulfide bonds
+!C The first case the ith atom is the center
+!C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
+!C distance y is second distance the a,b,c,d are parameters derived for
+!C this problem d parameter was set as a penalty currenlty set to 1.
+ if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
+ eij1=0.0d0
+ else
+ eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
+ endif
+!C second case jth atom is center
+ if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
+ eij2=0.0d0
+ else
+ eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
+ endif
+!C the third case kth atom is the center
+ if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
+ eij3=0.0d0
+ else
+ eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
+ endif
+!C eij2=0.0
+!C eij3=0.0
+!C eij1=0.0
+ eij=eij1+eij2+eij3
+!C write(iout,*)i,j,k,eij
+!C The energy penalty calculated now time for the gradient part
+!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
+ do m=1,3
+ 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)
+ 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
+ do m=1,3
+ 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)
+ 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
+ do m=1,3
+ 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)
+ enddo
+ return
+ end subroutine triple_ssbond_ene
+
+
+
!-----------------------------------------------------------------------------
real(kind=8) function h_base(x,deriv)
! A smooth function going 0->1 in range [0,1]
diff=newnss-nss
!mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
-
+! print *,newnss,nss,maxdim
do i=1,nss
found=.false.
+! print *,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
+! 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)
do i=1,newnss
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
+! 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)
return
end subroutine dyn_set_nss
-!-----------------------------------------------------------------------------
-#ifdef WHAM
- subroutine read_ssHist
-! implicit none
-! Includes
-! include 'DIMENSIONS'
-! include "DIMENSIONS.FREE"
-! include 'COMMON.FREE'
-! Local variables
- integer :: i,j
- 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))
+! Lipid transfer energy function
+ subroutine Eliptransfer(eliptran)
+!C this is done by Adasko
+!C print *,"wchodze"
+!C structure of box:
+!C water
+!C--bordliptop-- buffore starts
+!C--bufliptop--- here true lipid starts
+!C lipid
+!C--buflipbot--- lipid ends buffore starts
+!C--bordlipbot--buffore ends
+ real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
+ integer :: i
+ eliptran=0.0
+! 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
+
+ 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
+!C what fraction I am in
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
+!C lipbufthick is thickenes of lipid buffore
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
+
+!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
+!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
+!C print *, "doing sscalefor top part"
+!C print *,i,sslip,fracinbuf,ssgradlip
+ else
+ eliptran=eliptran+pepliptran
+!C print *,"I am in true lipid"
+ endif
+!C else
+!C eliptran=elpitran+0.0 ! I am in water
+ endif
+ if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
+ 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
+!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
+!c for each residue check if it is in lipid or lipid water border area
+!C respos=mod(c(3,i+nres),boxzsize)
+!C print *,positi,bordlipbot,buflipbot
+ if ((positi.gt.bordlipbot) &
+ .and.(positi.lt.bordliptop)) then
+!C the energy transfer exist
+ if (positi.lt.buflipbot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
+!C lipbufthick is thickenes of lipid buffore
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i,1))
+ gliptranx(3,i)=gliptranx(3,i) &
+ +ssgradlip*liptranene(itype(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- &
+ ((bordliptop-positi)/lipbufthick)
+ 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) &
+ +ssgradlip*liptranene(itype(i,1))
+!C print *, "doing sscalefor top part",sslip,fracinbuf
+ else
+ eliptran=eliptran+liptranene(itype(i,1))
+!C print *,"I am in true lipid"
+ endif
+ endif ! if in lipid or buffor
+!C else
+!C eliptran=elpitran+0.0 ! I am in water
+ if (energy_dec) write(iout,*) i,"eliptran=",eliptran
+ enddo
+ return
+ end subroutine Eliptransfer
+!----------------------------------NANO FUNCTIONS
+!C-----------------------------------------------------------------------
+!C-----------------------------------------------------------
+!C This subroutine is to mimic the histone like structure but as well can be
+!C utilizet to nanostructures (infinit) small modification has to be used to
+!C make it finite (z gradient at the ends has to be changes as well as the x,y
+!C gradient has to be modified at the ends
+!C The energy function is Kihara potential
+!C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
+!C 4eps is depth of well sigma is r_minimum r is distance from center of tube
+!C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
+!C simple Kihara potential
+ subroutine calctube(Etube)
+ real(kind=8),dimension(3) :: vectube
+ real(kind=8) :: Etube,xtemp,xminact,yminact,&
+ ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
+ 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
+ enddo
+!C first we calculate the distance from tube center
+!C for UNRES
+ do i=itube_start,itube_end
+!C lets ommit dummy atoms for now
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
+!C now calculate distance from center of tube and direction vectors
+ 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
+ vectube(1)=xtemp
+ vectube(2)=ytemp
+ vectube(1)=vectube(1)-tubecenter(1)
+ vectube(2)=vectube(2)-tubecenter(2)
+
+!C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
+!C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
+
+!C as the tube is infinity we do not calculate the Z-vector use of Z
+!C as chosen axis
+ vectube(3)=0.0d0
+!C now calculte the distance
+ tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+!C now normalize vector
+ vectube(1)=vectube(1)/tub_r
+ vectube(2)=vectube(2)/tub_r
+!C calculte rdiffrence between r and r0
+ rdiff=tub_r-tubeR0
+!C and its 6 power
+ rdiff6=rdiff**6.0d0
+!C for vectorization reasons we will sumup at the end to avoid depenence of previous
+ enetube(i)=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
+!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
+!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)
+!C lets ommit dummy atoms for now
+ if ((iti.eq.ntyp1) &
+!C in UNRES uncomment the line below as GLY has no side-chain...
+!C .or.(iti.eq.10)
+ ) 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
+ vectube(1)=xtemp
+ vectube(2)=ytemp
+!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
+!C & tubecenter(2)
+ vectube(1)=vectube(1)-tubecenter(1)
+ vectube(2)=vectube(2)-tubecenter(2)
+
+!C as the tube is infinity we do not calculate the Z-vector use of Z
+!C as chosen axis
+ vectube(3)=0.0d0
+!C now calculte the distance
+ tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+!C now normalize vector
+ vectube(1)=vectube(1)/tub_r
+ vectube(2)=vectube(2)/tub_r
+
+!C calculte rdiffrence between r and r0
+ rdiff=tub_r-tubeR0
+!C and its 6 power
+ rdiff6=rdiff**6.0d0
+!C for vectorization reasons we will sumup at the end to avoid depenence of previous
+ 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
+ fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/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
+!C print *,"ETUBE", etube
+ 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 4) add reading the center of tube
+!C 5) add COMMONs
+!C 6) add to zerograd
+!C 7) allocate matrices
+
+
+!C-----------------------------------------------------------------------
+!C-----------------------------------------------------------
+!C This subroutine is to mimic the histone like structure but as well can be
+!C utilizet to nanostructures (infinit) small modification has to be used to
+!C make it finite (z gradient at the ends has to be changes as well as the x,y
+!C gradient has to be modified at the ends
+!C The energy function is Kihara potential
+!C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
+!C 4eps is depth of well sigma is r_minimum r is distance from center of tube
+!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) :: 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
enddo
+!C first we calculate the distance from tube center
+!C first sugare-phosphate group for NARES this would be peptide group
+!C for UNRES
+ do i=itube_start,itube_end
+!C lets ommit dummy atoms for now
+
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
+!C now calculate distance from center of tube and direction vectors
+!C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+!C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
+!C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+!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
+ vectube(1)=xtemp
+ vectube(2)=ytemp
+ vectube(1)=vectube(1)-tubecenter(1)
+ vectube(2)=vectube(2)-tubecenter(2)
+
+!C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
+!C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
+
+!C as the tube is infinity we do not calculate the Z-vector use of Z
+!C as chosen axis
+ vectube(3)=0.0d0
+!C now calculte the distance
+ tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+!C now normalize vector
+ vectube(1)=vectube(1)/tub_r
+ vectube(2)=vectube(2)/tub_r
+!C calculte rdiffrence between r and r0
+ rdiff=tub_r-tubeR0
+!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
+!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
+!C the energy transfer exist
+ 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
+!C print *,ssgradtube, sstube,tubetranene(itype(i,1))
+ 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
+!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
+!C print *,"I am in true lipid"
+ endif
+ else
+!C sstube=0.0d0
+!C ssgradtube=0.0d0
+ 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)
+!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
+!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) &
+ +ssgradtube*enetube(i)/sstube/2.0d0
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ +ssgradtube*enetube(i)/sstube/2.0d0
- return
- end subroutine read_ssHist
-#endif
-!-----------------------------------------------------------------------------
- integer function indmat(i,j)
-!el
-! get the position of the jth ijth fragment of the chain coordinate system
-! in the fromto array.
- integer :: i,j
+ 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)
+!C lets ommit dummy atoms for now
+ 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
+
+ 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
+!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
+!C the energy transfer exist
+ 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
+!C print *,ssgradtube, 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)
+
+ 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))
+!C print *,"I am in true lipid"
+ endif
+ else
+!C sstube=0.0d0
+!C ssgradtube=0.0d0
+ 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
+ vectube(3)=0.0d0
+!C now calculte the distance
+ tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+!C now normalize vector
+ vectube(1)=vectube(1)/tub_r
+ vectube(2)=vectube(2)/tub_r
+!C calculte rdiffrence between r and r0
+ rdiff=tub_r-tubeR0
+!C and its 6 power
+ rdiff6=rdiff**6.0d0
+!C for vectorization reasons we will sumup at the end to avoid depenence of previous
+ 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)
+!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
+!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) &
+ +ssgradtube*enetube(i+nres)/sstube
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ +ssgradtube*enetube(i+nres)/sstube
- 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
- return
- end function sigm
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
- subroutine alloc_ener_arrays
-!EL Allocation of arrays used by module energy
- use MD_data, only: mset
-!el local variables
- integer :: i,j
+ enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)
+ enddo
+!C print *,"ETUBE", etube
+ return
+ end subroutine calctube2
+!=====================================================================================================================================
+ subroutine calcnano(Etube)
+ real(kind=8),dimension(3) :: vectube
- if(nres.lt.100) then
- maxconts=nres
- elseif(nres.lt.200) then
- maxconts=0.8*nres ! Max. number of contacts per residue
- else
+ real(kind=8) :: Etube,xtemp,xminact,yminact,&
+ ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
+ sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
+ integer:: i,j,iti,r
+
+ Etube=0.0d0
+! print *,itube_start,itube_end,"poczatek"
+ do i=itube_start,itube_end
+ 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 for UNRES
+ do i=itube_start,itube_end
+!C lets ommit dummy atoms for now
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
+!C now calculate distance from center of tube and direction vectors
+ xmin=boxxsize
+ 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
+
+
+ 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
+
+ vectube(1)=vectube(1)-tubecenter(1)
+ vectube(2)=vectube(2)-tubecenter(2)
+ vectube(3)=vectube(3)-tubecenter(3)
+
+!C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
+!C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
+!C as the tube is infinity we do not calculate the Z-vector use of Z
+!C as chosen axis
+!C vectube(3)=0.0d0
+!C now calculte the distance
+ tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+!C now normalize vector
+ vectube(1)=vectube(1)/tub_r
+ vectube(2)=vectube(2)/tub_r
+ vectube(3)=vectube(3)/tub_r
+!C calculte rdiffrence between r and r0
+ rdiff=tub_r-tubeR0
+!C and its 6 power
+ rdiff6=rdiff**6.0d0
+!C for vectorization reasons we will sumup at the end to avoid depenence of previous
+ enetube(i)=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
+!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
+!C &rdiff,fac
+ 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
+!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
+
+ do i=itube_start,itube_end
+ enecavtube(i)=0.0d0
+!C Lets not jump over memory as we use many times iti
+ iti=itype(i,1)
+!C lets ommit dummy atoms for now
+ if ((iti.eq.ntyp1) &
+!C in UNRES uncomment the line below as GLY has no side-chain...
+!C .or.(iti.eq.10)
+ ) 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
+ vectube(1)=xtemp
+ vectube(2)=ytemp
+ vectube(3)=ztemp
+
+!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
+!C & tubecenter(2)
+ vectube(1)=vectube(1)-tubecenter(1)
+ vectube(2)=vectube(2)-tubecenter(2)
+ vectube(3)=vectube(3)-tubecenter(3)
+!C now calculte the distance
+ tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+!C now normalize vector
+ vectube(1)=vectube(1)/tub_r
+ vectube(2)=vectube(2)/tub_r
+ vectube(3)=vectube(3)/tub_r
+
+!C calculte rdiffrence between r and r0
+ rdiff=tub_r-tubeR0
+!C and its 6 power
+ rdiff6=rdiff**6.0d0
+ 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
+!C enetube(i+nres)=0.0d0
+!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
+!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
+!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
+!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
+!C faccav=0.0
+ fac=fac+faccav
+!C 667 continue
+ 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 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
+! rdiff=r/100.0d0
+! rdiff6=rdiff**6.0d0
+! sc_aa_tube=sc_aa_tube_par(i)
+! sc_bb_tube=sc_bb_tube_par(i)
+! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
+! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
+! enecavtube(i)= &
+! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
+! /denominator
+
+! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
+! enddo
+! print *,"end",i,"a"
+! enddo
+!C print *,"ETUBE", etube
+ return
+ end subroutine calcnano
+
+!===============================================
+!--------------------------------------------------------------------------------
+!C first for shielding is setting of function of side-chains
+
+ subroutine set_shield_fac2
+ real(kind=8) :: div77_81=0.974996043d0, &
+ 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
+!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
+!C write(2,*) "ivec",ivec_start,ivec_end
+ do i=1,nres
+ fac_shield(i)=0.0d0
+ do j=1,3
+ grad_shield(j,i)=0.0d0
+ enddo
+ enddo
+ do i=ivec_start,ivec_end
+!C do i=1,nres-1
+!C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
+ ishield_list(i)=0
+ if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
+!Cif there two consequtive dummy atoms there is no peptide group between them
+!C the line below has to be changed for FGPROC>1
+ VolumeTotal=0.0
+ do k=1,nres
+ if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
+ dist_pep_side=0.0
+ dist_side_calf=0.0
+ do j=1,3
+!C first lets set vector conecting the ithe side-chain with kth side-chain
+ pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
+!C pep_side(j)=2.0d0
+!C and vector conecting the side-chain with its proper calfa
+ side_calf(j)=c(j,k+nres)-c(j,k)
+!C side_calf(j)=2.0d0
+ pept_group(j)=c(j,i)-c(j,i+1)
+!C lets have their lenght
+ dist_pep_side=pep_side(j)**2+dist_pep_side
+ dist_side_calf=dist_side_calf+side_calf(j)**2
+ dist_pept_group=dist_pept_group+pept_group(j)**2
+ enddo
+ dist_pep_side=sqrt(dist_pep_side)
+ 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
+ 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
+!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
+!C ishield_list is a list of non 0 side-chain that contribute to factor gradient
+!C this list is essential otherwise problem would be O3
+ shield_list(ishield_list(i),i)=k
+!C Lets have the sscale value
+ if (sh_frac_dist.gt.1.0) then
+ scale_fac_dist=1.0d0
+ do j=1,3
+ sh_frac_dist_grad(j)=0.0d0
+ enddo
+ else
+ scale_fac_dist=-sh_frac_dist*sh_frac_dist &
+ *(2.0d0*sh_frac_dist-3.0d0)
+ fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
+ /dist_pep_side/buff_shield*0.5d0
+ do j=1,3
+ sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
+!C sh_frac_dist_grad(j)=0.0d0
+!C scale_fac_dist=1.0d0
+!C print *,"jestem",scale_fac_dist,fac_help_scale,
+!C & sh_frac_dist_grad(j)
+ enddo
+ endif
+!C this is what is now we have the distance scaling now volume...
+ short=short_r_sidechain(itype(k,1))
+ long=long_r_sidechain(itype(k,1))
+ costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
+ sinthet=short/dist_pep_side*costhet
+! print *,"SORT",short,long,sinthet,costhet
+!C now costhet_grad
+!C costhet=0.6d0
+!C sinthet=0.8
+ costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
+!C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
+!C & -short/dist_pep_side**2/costhet)
+!C costhet_fac=0.0d0
+ do j=1,3
+ costhet_grad(j)=costhet_fac*pep_side(j)
+ enddo
+!C remember for the final gradient multiply costhet_grad(j)
+!C for side_chain by factor -2 !
+!C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
+!C pep_side0pept_group is vector multiplication
+ pep_side0pept_group=0.0d0
+ do j=1,3
+ pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
+ enddo
+ cosalfa=(pep_side0pept_group/ &
+ (dist_pep_side*dist_side_calf))
+ fac_alfa_sin=1.0d0-cosalfa**2
+ fac_alfa_sin=dsqrt(fac_alfa_sin)
+ rkprim=fac_alfa_sin*(long-short)+short
+!C rkprim=short
+
+!C now costhet_grad
+ cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
+!C cosphi=0.6
+ cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
+ sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
+ dist_pep_side**2)
+!C sinphi=0.8
+ do j=1,3
+ cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
+ +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
+ *(long-short)/fac_alfa_sin*cosalfa/ &
+ ((dist_pep_side*dist_side_calf))* &
+ ((side_calf(j))-cosalfa* &
+ ((pep_side(j)/dist_pep_side)*dist_side_calf))
+!C cosphi_grad_long(j)=0.0d0
+ cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
+ *(long-short)/fac_alfa_sin*cosalfa &
+ /((dist_pep_side*dist_side_calf))* &
+ (pep_side(j)- &
+ cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
+!C cosphi_grad_loc(j)=0.0d0
+ enddo
+!C print *,sinphi,sinthet
+ VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
+ /VSolvSphere_div
+!C & *wshield
+!C now the gradient...
+ do j=1,3
+ grad_shield(j,i)=grad_shield(j,i) &
+!C gradient po skalowaniu
+ +(sh_frac_dist_grad(j)*VofOverlap &
+!C gradient po costhet
+ +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
+ (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
+ sinphi/sinthet*costhet*costhet_grad(j) &
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
+!C grad_shield_side is Cbeta sidechain gradient
+ grad_shield_side(j,ishield_list(i),i)=&
+ (sh_frac_dist_grad(j)*-2.0d0&
+ *VofOverlap&
+ -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
+ (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
+ sinphi/sinthet*costhet*costhet_grad(j)&
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
+! 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*&
+ (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
+ sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
+ ))&
+ *wshield
+! print *,grad_shield_loc(j,ishield_list(i),i)
+ enddo
+ VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
+ enddo
+ fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
+
+! write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
+ enddo
+ return
+ end subroutine set_shield_fac2
+!----------------------------------------------------------------------------
+! SOUBROUTINE FOR AFM
+ subroutine AFMvel(Eafmforce)
+ use MD_data, only:totTafm
+ real(kind=8),dimension(3) :: diffafm
+ real(kind=8) :: afmdist,Eafmforce
+ integer :: i
+!C Only for check grad COMMENT if not used for checkgrad
+!C totT=3.0d0
+!C--------------------------------------------------------
+!C print *,"wchodze"
+ afmdist=0.0d0
+ Eafmforce=0.0d0
+ do i=1,3
+ diffafm(i)=c(i,afmend)-c(i,afmbeg)
+ afmdist=afmdist+diffafm(i)**2
+ enddo
+ afmdist=dsqrt(afmdist)
+! totTafm=3.0
+ Eafmforce=0.5d0*forceAFMconst &
+ *(distafminit+totTafm*velAFMconst-afmdist)**2
+!C Eafmforce=-forceAFMconst*(dist-distafminit)
+ do i=1,3
+ gradafm(i,afmend-1)=-forceAFMconst* &
+ (distafminit+totTafm*velAFMconst-afmdist) &
+ *diffafm(i)/afmdist
+ gradafm(i,afmbeg-1)=forceAFMconst* &
+ (distafminit+totTafm*velAFMconst-afmdist) &
+ *diffafm(i)/afmdist
+ enddo
+! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
+ return
+ end subroutine AFMvel
+!---------------------------------------------------------
+ subroutine AFMforce(Eafmforce)
+
+ real(kind=8),dimension(3) :: diffafm
+! real(kind=8) ::afmdist
+ real(kind=8) :: afmdist,Eafmforce
+ integer :: i
+ afmdist=0.0d0
+ Eafmforce=0.0d0
+ do i=1,3
+ diffafm(i)=c(i,afmend)-c(i,afmbeg)
+ afmdist=afmdist+diffafm(i)**2
+ enddo
+ afmdist=dsqrt(afmdist)
+! print *,afmdist,distafminit
+ Eafmforce=-forceAFMconst*(afmdist-distafminit)
+ do i=1,3
+ gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
+ gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
+ enddo
+!C print *,'AFM',Eafmforce
+ return
+ end subroutine AFMforce
+
+!-----------------------------------------------------------------------------
+#ifdef WHAM
+ subroutine read_ssHist
+! implicit none
+! Includes
+! include 'DIMENSIONS'
+! include "DIMENSIONS.FREE"
+! include 'COMMON.FREE'
+! Local variables
+ integer :: i,j
+ 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))
+ enddo
+
+ return
+ end subroutine read_ssHist
+#endif
+!-----------------------------------------------------------------------------
+ integer function indmat(i,j)
+!el
+! get the position of the jth ijth fragment of the chain coordinate system
+! in the fromto array.
+ integer :: i,j
+
+ 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
+ return
+ end function sigm
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+ subroutine alloc_ener_arrays
+!EL Allocation of arrays used by module energy
+ use MD_data, only: mset
+!el local variables
+ integer :: i,j
+
+ if(nres.lt.100) then
+ maxconts=nres
+ elseif(nres.lt.200) then
+ maxconts=0.8*nres ! Max. number of contacts per residue
+ else
maxconts=0.6*nres ! (maxconts=maxres/4)
endif
- maxcont=12*nres ! Max. number of SC contacts
- maxvar=6*nres ! Max. number of variables
+ maxcont=12*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(ielstart_vdw(nres))
allocate(ielend_vdw(nres))
!(maxres)
+ allocate(nint_gr_nucl(nres))
+ allocate(nscp_gr_nucl(nres))
+ allocate(ielstart_nucl(nres))
+ allocate(ielend_nucl(nres))
+!(maxres)
+ allocate(istart_nucl(nres,maxint_gr))
+ allocate(iend_nucl(nres,maxint_gr))
+!(maxres,maxint_gr)
+ allocate(iscpstart_nucl(nres,maxint_gr))
+ allocate(iscpend_nucl(nres,maxint_gr))
+!(maxres,maxint_gr)
+ allocate(ielstart_vdw_nucl(nres))
+ allocate(ielend_vdw_nucl(nres))
allocate(lentyp(0:nfgtasks-1))
!(0:maxprocs-1)
allocate(grij_hb_cont(3,maxconts,nres))
!(3,maxconts,maxres)
allocate(facont_hb(maxconts,nres))
+
allocate(ees0p(maxconts,nres))
allocate(ees0m(maxconts,nres))
allocate(d_cont(maxconts,nres))
+ allocate(ees0plist(maxconts,nres))
+
!(maxconts,maxres)
allocate(num_cont_hb(nres))
!(maxres)
!(6,maxdim)
allocate(dxds(6,nres))
!(6,maxres)
- allocate(gradx(3,nres,0:2))
- allocate(gradc(3,nres,0:2))
+ allocate(gradx(3,-1:nres,0:2))
+ allocate(gradc(3,-1:nres,0:2))
!(3,maxres,2)
- allocate(gvdwx(3,nres))
- allocate(gvdwc(3,nres))
- allocate(gelc(3,nres))
- allocate(gelc_long(3,nres))
- allocate(gvdwpp(3,nres))
- allocate(gvdwc_scpp(3,nres))
- allocate(gradx_scp(3,nres))
- allocate(gvdwc_scp(3,nres))
- allocate(ghpbx(3,nres))
- allocate(ghpbc(3,nres))
- allocate(gradcorr(3,nres))
- allocate(gradcorr_long(3,nres))
- allocate(gradcorr5_long(3,nres))
- allocate(gradcorr6_long(3,nres))
- allocate(gcorr6_turn_long(3,nres))
- allocate(gradxorr(3,nres))
- allocate(gradcorr5(3,nres))
- allocate(gradcorr6(3,nres))
+ allocate(gvdwx(3,-1:nres))
+ allocate(gvdwc(3,-1:nres))
+ allocate(gelc(3,-1:nres))
+ allocate(gelc_long(3,-1:nres))
+ allocate(gvdwpp(3,-1:nres))
+ allocate(gvdwc_scpp(3,-1:nres))
+ allocate(gradx_scp(3,-1:nres))
+ allocate(gvdwc_scp(3,-1:nres))
+ allocate(ghpbx(3,-1:nres))
+ allocate(ghpbc(3,-1:nres))
+ allocate(gradcorr(3,-1:nres))
+ allocate(gradcorr_long(3,-1:nres))
+ allocate(gradcorr5_long(3,-1:nres))
+ allocate(gradcorr6_long(3,-1:nres))
+ allocate(gcorr6_turn_long(3,-1:nres))
+ allocate(gradxorr(3,-1:nres))
+ allocate(gradcorr5(3,-1:nres))
+ allocate(gradcorr6(3,-1:nres))
+ allocate(gliptran(3,-1:nres))
+ allocate(gliptranc(3,-1:nres))
+ allocate(gliptranx(3,-1:nres))
+ allocate(gshieldx(3,-1:nres))
+ allocate(gshieldc(3,-1:nres))
+ allocate(gshieldc_loc(3,-1:nres))
+ allocate(gshieldx_ec(3,-1:nres))
+ allocate(gshieldc_ec(3,-1:nres))
+ allocate(gshieldc_loc_ec(3,-1:nres))
+ allocate(gshieldx_t3(3,-1:nres))
+ allocate(gshieldc_t3(3,-1:nres))
+ allocate(gshieldc_loc_t3(3,-1:nres))
+ allocate(gshieldx_t4(3,-1:nres))
+ allocate(gshieldc_t4(3,-1:nres))
+ allocate(gshieldc_loc_t4(3,-1:nres))
+ allocate(gshieldx_ll(3,-1:nres))
+ allocate(gshieldc_ll(3,-1:nres))
+ allocate(gshieldc_loc_ll(3,-1:nres))
+ allocate(grad_shield(3,-1:nres))
+ allocate(gg_tube_sc(3,-1:nres))
+ allocate(gg_tube(3,-1:nres))
+ allocate(gradafm(3,-1:nres))
+ allocate(gradb_nucl(3,-1:nres))
+ allocate(gradbx_nucl(3,-1:nres))
+ allocate(gvdwpsb1(3,-1:nres))
+ allocate(gelpp(3,-1:nres))
+ allocate(gvdwpsb(3,-1:nres))
+ allocate(gelsbc(3,-1:nres))
+ allocate(gelsbx(3,-1:nres))
+ allocate(gvdwsbx(3,-1:nres))
+ allocate(gvdwsbc(3,-1:nres))
+ allocate(gsbloc(3,-1:nres))
+ allocate(gsblocx(3,-1:nres))
+ allocate(gradcorr_nucl(3,-1:nres))
+ allocate(gradxorr_nucl(3,-1:nres))
+ allocate(gradcorr3_nucl(3,-1:nres))
+ allocate(gradxorr3_nucl(3,-1:nres))
+ allocate(gvdwpp_nucl(3,-1:nres))
+ allocate(gradpepcat(3,-1:nres))
+ allocate(gradpepcatx(3,-1:nres))
+ allocate(gradcatcat(3,-1:nres))
!(3,maxres)
+ allocate(grad_shield_side(3,50,nres))
+ allocate(grad_shield_loc(3,50,nres))
+! grad for shielding surroing
allocate(gloc(0:maxvar,0:2))
allocate(gloc_x(0:maxvar,2))
!(maxvar,2)
- allocate(gel_loc(3,nres))
- allocate(gel_loc_long(3,nres))
- allocate(gcorr3_turn(3,nres))
- allocate(gcorr4_turn(3,nres))
- allocate(gcorr6_turn(3,nres))
- allocate(gradb(3,nres))
- allocate(gradbx(3,nres))
+ allocate(gel_loc(3,-1:nres))
+ allocate(gel_loc_long(3,-1:nres))
+ allocate(gcorr3_turn(3,-1:nres))
+ allocate(gcorr4_turn(3,-1:nres))
+ allocate(gcorr6_turn(3,-1:nres))
+ allocate(gradb(3,-1:nres))
+ allocate(gradbx(3,-1:nres))
!(3,maxres)
allocate(gel_loc_loc(maxvar))
allocate(gel_loc_turn3(maxvar))
allocate(g_corr5_loc(maxvar))
allocate(g_corr6_loc(maxvar))
!(maxvar)
- allocate(gsccorc(3,nres))
- allocate(gsccorx(3,nres))
+ allocate(gsccorc(3,-1:nres))
+ allocate(gsccorx(3,-1:nres))
!(3,maxres)
- allocate(gsccor_loc(nres))
+ allocate(gsccor_loc(-1:nres))
!(maxres)
- allocate(dtheta(3,2,nres))
+ allocate(gvdwx_scbase(3,-1:nres))
+ allocate(gvdwc_scbase(3,-1:nres))
+ allocate(gvdwx_pepbase(3,-1:nres))
+ allocate(gvdwc_pepbase(3,-1:nres))
+ allocate(gvdwx_scpho(3,-1:nres))
+ allocate(gvdwc_scpho(3,-1:nres))
+ allocate(gvdwc_peppho(3,-1:nres))
+
+ allocate(dtheta(3,2,-1:nres))
!(3,2,maxres)
- allocate(gscloc(3,nres))
- allocate(gsclocx(3,nres))
+ allocate(gscloc(3,-1:nres))
+ allocate(gsclocx(3,-1:nres))
!(3,maxres)
- allocate(dphi(3,3,nres))
- allocate(dalpha(3,3,nres))
- allocate(domega(3,3,nres))
+ allocate(dphi(3,3,-1:nres))
+ allocate(dalpha(3,3,-1:nres))
+ allocate(domega(3,3,-1:nres))
!(3,3,maxres)
! common /deriv_scloc/
allocate(dXX_C1tab(3,nres))
!----------------------
! common.MD
! common /mdgrad/
- allocate(gcart(3,0:nres))
- allocate(gxcart(3,0:nres))
+ allocate(gcart(3,-1:nres))
+ allocate(gxcart(3,-1:nres))
!(3,0:MAXRES)
- allocate(gradcag(3,nres))
- allocate(gradxag(3,nres))
+ allocate(gradcag(3,-1:nres))
+ allocate(gradxag(3,-1:nres))
!(3,MAXRES)
! common /back_constr/
!el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
!----------------------
! common.sbridge
! common /sbridge/ in io_common: read_bridge
-!el allocate((:),allocatable :: iss !(maxss)
+!el allocate((:),allocatable :: iss !(maxss)
! common /links/ in io_common: read_bridge
!el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
!el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
! enddo
! enddo
- if (nss.gt.0) then
- allocate(idssb(nss),jdssb(nss))
+! if (nss.gt.0) then
+ allocate(idssb(maxdim),jdssb(maxdim))
+! allocate(newihpb(nss),newjhpb(nss))
!(maxdim)
- endif
+! endif
+ allocate(ishield_list(nres))
+ allocate(shield_list(50,nres))
allocate(dyn_ss_mask(nres))
+ allocate(fac_shield(nres))
+ allocate(enetube(nres*2))
+ allocate(enecavtube(nres*2))
+
!(maxres)
dyn_ss_mask(:)=.false.
!----------------------
! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
! allocate(vlor1sccor(maxterm_sccor,20,20))
! allocate(vlor2sccor(maxterm_sccor,20,20))
-! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
+! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
!----------------
allocate(gloc_sc(3,0:2*nres,0:10))
!(3,0:maxres2,10)maxres2=2*maxres
return
end subroutine alloc_ener_arrays
+!-----------------------------------------------------------------
+ subroutine ebond_nucl(estr_nucl)
+!c
+!c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
+!c
+
+ real(kind=8),dimension(3) :: u,ud
+ real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
+ real(kind=8) :: estr_nucl,diff
+ integer :: iti,i,j,k,nbi
+ estr_nucl=0.0d0
+!C print *,"I enter ebond"
+ if (energy_dec) &
+ 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
+! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
+! do j=1,3
+! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
+! & *dc(j,i-1)/vbld(i)
+! enddo
+! if (energy_dec) write(iout,*)
+! & "estr1",i,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
+! print *,estr_nucl
+ 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
+! print *,"partial sum", estr_nucl,AKP_nucl
+
+ if (energy_dec) &
+ write (iout,*) "ibondp_start,ibondp_end",&
+ ibond_nucl_start,ibond_nucl_end
+
+ 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)
+!C print *,iti,nbi
+ 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
+! 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)
+ enddo
+ endif
+ enddo
+!C print *,"I am about to leave ebond"
+ return
+ end subroutine ebond_nucl
+
!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+ subroutine ebend_nucl(etheta_nucl)
+ real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
+ real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
+ real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
+ logical :: lprn=.false., lprn1=.false.
+!el local variables
+ integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
+ real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
+ real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
+! local variables for constrains
+ real(kind=8) :: difi,thetiii
+ integer itheta
+ 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
+#ifdef OSF
+ phii=phi(i)
+ if (phii.ne.phii) phii=150.0
+#else
+ 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
+
+ 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)
+#else
+ 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
+ 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
+ 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
+ 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
+ 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
+! 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
+ enddo
+ return
+ end subroutine ebend_nucl
+!----------------------------------------------------
+ subroutine etor_nucl(etors_nucl)
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.TORSION'
+! include 'COMMON.INTERACT'
+! include 'COMMON.DERIV'
+! include 'COMMON.CHAIN'
+! include 'COMMON.NAMES'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.FFIELD'
+! include 'COMMON.TORCNSTR'
+! include 'COMMON.CONTROL'
+ real(kind=8) :: etors_nucl,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
+! 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)
+! print *,i,itori,itori1
+ 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
+!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
+!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) &
+ 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
+!c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
+ enddo
+ return
+ end subroutine etor_nucl
+!------------------------------------------------------------
+ subroutine epp_nucl_sub(evdw1,ees)
+!C
+!C This subroutine calculates the average interaction energy and its gradient
+!C in the virtual-bond vectors between non-adjacent peptide groups, based on
+!C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
+!C The potential depends both on the distance of peptide-group centers and on
+!C the orientation of the CA-CA virtual bonds.
+!C
+ integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
+ real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
+ 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
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ 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 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
+ real(kind=8) scal_el /0.5d0/
+ t_eelecij=0.0d0
+ ees=0.0D0
+ evdw1=0.0D0
+ ind=0
+!c
+!c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
+!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)
+! 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
+!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
+! 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
+!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
+!c phoshate-phosphate electrostatic interactions
+ 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
+!c fac=-eesij*fac
+ 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
+ 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)
+!c gelpp(k,i)=332.0d0*gelpp(k,i)
+ 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
+ return
+ end subroutine epp_nucl_sub
+!---------------------------------------------------------------------
+ subroutine epsb(evdwpsb,eelpsb)
+! use comm_locel
+!C
+!C This subroutine calculates the excluded-volume interaction energy between
+!C peptide-group centers and side chains and its gradient in virtual-bond and
+!C side-chain vectors.
+!C
+ 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
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init
+ integer xshift,yshift,zshift
+
+!cd print '(a)','Enter ESCP'
+!cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
+ eelpsb=0.0d0
+ 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
+!C Uncomment following three lines for SC-p interactions
+!c xj=c(1,nres+j)-xi
+!c yj=c(2,nres+j)-yi
+!c zj=c(3,nres+j)-zi
+!C Uncomment following three lines for Ca-p interactions
+! xj=c(1,j)-xi
+! yj=c(2,j)-yi
+! zj=c(3,j)-zi
+ 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"
+!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
+ enddo
+
+ 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
+ enddo
+ return
+ end subroutine epsb
+
+!------------------------------------------------------
+ subroutine esb_gb(evdwsb,eelsb)
+ use comm_locel
+ use calc_data_nucl
+ integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
+ 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
+ integer :: ii
+ logical lprn
+ evdw=0.0D0
+ eelsb=0.0d0
+ ecorr=0.0d0
+ evdwsb=0.0D0
+ lprn=.false.
+ 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)
+! 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)
+!C
+!C Calculate SC interaction energy.
+!C
+ 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
+! 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
+! 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)
+!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
+! 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
+!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)
+!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
+
+ 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
+!c fac=0.0d0
+!C Calculate the radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+!C Calculate angular part of the gradient.
+ call sc_grad_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.
+ return
+ end subroutine esb_gb
+!-------------------------------------------------------------------------------
+ subroutine eelsbij(eesij,num_conti2)
+ use comm_locel
+ use calc_data_nucl
+ 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
+ integer xshift,yshift,zshift,ilist,iresshield,num_conti2
+
+!c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
+ real(kind=8) scal_el /0.5d0/
+ integer :: iteli,itelj,kkk,kkll,m,isubchap
+ 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
+ ind=ind+1
+ itypi=itype(i,2)
+ itypj=itype(j,2)
+! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
+ ael6i=ael6_nucl(itypi,itypj)
+ ael3i=ael3_nucl(itypi,itypj)
+ ael63i=ael63_nucl(itypi,itypj)
+ ael32i=ael32_nucl(itypi,itypj)
+!c write (iout,*) "eelecij",i,j,itype(i),itype(j),
+!c & ael6i,ael3i,ael63i,al32i,rij,rrij
+ dxj=dc(1,j+nres)
+ dyj=dc(2,j+nres)
+ dzj=dc(3,j+nres)
+ dx_normi=dc_norm(1,i+nres)
+ dy_normi=dc_norm(2,i+nres)
+ dz_normi=dc_norm(3,i+nres)
+ dx_normj=dc_norm(1,j+nres)
+ dy_normj=dc_norm(2,j+nres)
+ dz_normj=dc_norm(3,j+nres)
+!c xj=c(1,j)+0.5D0*dxj-xmedi
+!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
+ else
+ cosa=om12
+ cosb=om1
+ cosg=om2
+ endif
+ r3ij=rij*rrij
+ r6ij=r3ij*r3ij
+ fac=cosa-3.0D0*cosb*cosg
+ facfac=fac*fac
+ fac1=3.0d0*(cosb*cosb+cosg*cosg)
+ fac3=ael6i*r6ij
+ fac4=ael3i*r3ij
+ fac5=ael63i*r6ij
+ fac6=ael32i*r6ij
+!c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
+!c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
+ el1=fac3*(4.0D0+facfac-fac1)
+ el2=fac4*fac
+ el3=fac5*(2.0d0-2.0d0*facfac+fac1)
+ el4=fac6*facfac
+ eesij=el1+el2+el3+el4
+!C 12/26/95 - for the evaluation of multi-body H-bonding interactions
+ 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
+ endif
+
+!C
+!C Calculate contributions to the Cartesian gradient.
+!C
+ facel=-3.0d0*rrij*(eesij+el1+el3+el4)
+ fac1=fac
+!c erij(1)=xj*rmij
+!c erij(2)=yj*rmij
+!c erij(3)=zj*rmij
+!*
+!* Radial derivatives. First process both termini of the fragment (i,j)
+!*
+ ggg(1)=facel*xj
+ ggg(2)=facel*yj
+ ggg(3)=facel*zj
+ 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)
+ enddo
+!*
+!* Angular part
+!*
+ ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
+ fac4=-3.0D0*fac4
+ fac3=-6.0D0*fac3
+ fac5= 6.0d0*fac5
+ fac6=-6.0d0*fac6
+ ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
+ fac6*fac1*cosg
+ 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)
+ enddo
+ do k=1,3
+ 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)
+ 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
+!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)
+!c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
+ 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 (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
+!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
+!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)
+!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
+!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
+!C Derivatives due to the contact function
+ gacont_hbr(1,num_conti,i)=fprimcont*xj
+ gacont_hbr(2,num_conti,i)=fprimcont*yj
+ gacont_hbr(3,num_conti,i)=fprimcont*zj
+ do k=1,3
+!c
+!c 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
+ endif
+ ENDIF
+ return
+ end subroutine eelsbij
+!------------------------------------------------------------------
+ subroutine sc_grad_nucl
+ use comm_locel
+ use calc_data_nucl
+ real(kind=8),dimension(3) :: dcosom1,dcosom2
+ eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
+ 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))
+ enddo
+ do k=1,3
+ 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
+ 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)
+ enddo
+ return
+ end subroutine sc_grad_nucl
+!-----------------------------------------------------------------------
+ subroutine esb(esbloc)
+!C Calculate the local energy of a side chain and its derivatives in the
+!C corresponding virtual-bond valence angles THETA and the spherical angles
+!C ALPHA and OMEGA derived from AM1 all-atom calculations.
+!C added by Urszula Kozlowska. 07/11/2007
+!C
+ real(kind=8),dimension(3):: x_prime,y_prime,z_prime
+ real(kind=8),dimension(9):: x
+ real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
+ sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
+ de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
+ real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
+ dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
+ real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
+ cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
+ integer::it,nlobit,i,j,k
+! common /sccalc/ time11,time12,time112,theti,it,nlobit
+ 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
+
+!c
+!C Compute the axes of tghe local cartesian coordinates system; store in
+!c x_prime, y_prime and z_prime
+!c
+ do j=1,3
+ x_prime(j) = 0.00
+ y_prime(j) = 0.00
+ z_prime(j) = 0.00
+ enddo
+!C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
+!C & dc_norm(3,i+nres)
+ do j = 1,3
+ x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
+ y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
+ enddo
+ do j = 1,3
+ z_prime(j) = -uz(j,i-1)
+! z_prime(j)=0.0
+ 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
+#ifdef CHECK_COORD
+!Cc diagnostics - remove later
+ xx1 = dcos(alph(2))
+ yy1 = dsin(alph(2))*dcos(omeg(2))
+ zz1 = -dsin(alph(2))*dsin(omeg(2))
+ write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
+ alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
+ xx1,yy1,zz1
+!C," --- ", xx_w,yy_w,zz_w
+!c end diagnostics
+#endif
+ 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)
+!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
+!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
+#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
+#endif
+!C
+ cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
+ cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
+ cosfac2xx=cosfac2*xx
+ sinfac2yy=sinfac2*yy
+ do k = 1,3
+ dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
+ vbld_inv(i+1)
+ dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
+ vbld_inv(i)
+ pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
+ pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
+!c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
+!c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
+!c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
+!c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
+ dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
+ dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
+ dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
+ dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
+ dZZ_Ci1(k)=0.0d0
+ dZZ_Ci(k)=0.0d0
+ do j=1,3
+ dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
+ dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
+ enddo
+
+ dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
+ dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
+ dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
+!c
+ dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
+ dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
+ enddo
+
+ do k=1,3
+ dXX_Ctab(k,i)=dXX_Ci(k)
+ dXX_C1tab(k,i)=dXX_Ci1(k)
+ dYY_Ctab(k,i)=dYY_Ci(k)
+ dYY_C1tab(k,i)=dYY_Ci1(k)
+ dZZ_Ctab(k,i)=dZZ_Ci(k)
+ dZZ_C1tab(k,i)=dZZ_Ci1(k)
+ dXX_XYZtab(k,i)=dXX_XYZ(k)
+ dYY_XYZtab(k,i)=dYY_XYZ(k)
+ dZZ_XYZtab(k,i)=dZZ_XYZ(k)
+ enddo
+ do k = 1,3
+!c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
+!c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
+!c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
+!c & dyy_ci(k)," dzz_ci",dzz_ci(k)
+!c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
+!c & dt_dci(k)
+!c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
+!c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
+ 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 & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
+
+!C to check gradient call subroutine check_grad
+
+ 1 continue
+ enddo
+ return
+ end subroutine esb
+!=-------------------------------------------------------
+ real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
+! implicit none
+ real(kind=8),dimension(9):: x(9)
+ real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
+ sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
+ integer i
+!c write (2,*) "enesc"
+!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
+ enesc_nucl=sumene
+ return
+ end function enesc_nucl
+!-----------------------------------------------------------------------------
+ subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
+#ifdef MPI
+ include 'mpif.h'
+ integer,parameter :: max_cont=2000
+ integer,parameter:: max_dim=2*(8*3+6)
+ integer, parameter :: msglen1=max_cont*max_dim
+ integer,parameter :: msglen2=2*msglen1
+ integer source,CorrelType,CorrelID,Error
+ real(kind=8) :: buffer(max_cont,max_dim)
+ integer status(MPI_STATUS_SIZE)
+ integer :: ierror,nbytes
+#endif
+ real(kind=8),dimension(3):: gx(3),gx1(3)
+ real(kind=8) :: time00
+ logical lprn,ldone
+ integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
+ real(kind=8) ecorr,ecorr3
+ integer :: n_corr,n_corr1,mm,msglen
+!C Set lprn=.true. for debugging
+ lprn=.false.
+ n_corr=0
+ n_corr1=0
+#ifdef MPI
+ if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
+
+ 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
+ endif
+!C Caution! Following code assumes that electrostatic interactions concerning
+!C a given atom are split among at most two processors!
+ CorrelType=477
+ CorrelID=fg_rank+1
+ ldone=.false.
+ do i=1,max_cont
+ do j=1,max_dim
+ buffer(i,j)=0.0D0
+ enddo
+ enddo
+ mm=mod(fg_rank,2)
+!c write (*,*) 'MyRank',MyRank,' mm',mm
+ if (mm) 20,20,10
+ 10 continue
+!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)
+!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)
+!C Clear the contacts of the atom passed to the neighboring processor
+ 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
+!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
+!cd write (iout,*) 'Processor ',fg_rank,
+!cd & ' has sent correlation contribution to processor',fg_rank-1,
+!cd & ' msglen=',msglen,' CorrelID=',CorrelID
+!c write (*,*) 'Processor ',fg_rank,
+!c & ' has sent correlation contribution to processor',fg_rank-1,
+!c & ' msglen=',msglen,' CorrelID=',CorrelID
+!c msglen=msglen1
+ endif ! (fg_rank.gt.0)
+ if (ldone) goto 30
+ ldone=.true.
+ 20 continue
+!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
+!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
+!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
+!c write (*,*) 'Processor',fg_rank,
+!c &' has received correlation contribution from processor',fg_rank+1,
+!c & ' msglen=',msglen,' nbytes=',nbytes
+!c write (*,*) 'The received BUFFER array:'
+!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,*) &
+ 'ERROR!!!! message length changed while processing correlations.'
+ write (*,*) &
+ 'ERROR!!!! message length changed while processing correlations.'
+ call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
+ endif ! msglen.eq.msglen1
+ endif ! fg_rank.lt.nfgtasks-1
+ if (ldone) goto 30
+ ldone=.true.
+ goto 10
+ 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
+ endif
+ ecorr=0.0D0
+ ecorr3=0.0d0
+!C Remove the loop below after debugging !!!
+! do i=nnt_molec(2),nct_molec(2)
+! do j=1,3
+! gradcorr_nucl(j,i)=0.0D0
+! gradxorr_nucl(j,i)=0.0D0
+! gradcorr3_nucl(j,i)=0.0D0
+! gradxorr3_nucl(j,i)=0.0D0
+! enddo
+! enddo
+! 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)
+! 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)
+!c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+!c & ' jj=',jj,' kk=',kk
+ if (j1.eq.j+1 .or. j1.eq.j-1) then
+!C
+!C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
+!C The system gains extra energy.
+!C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
+!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
+!C
+!C Contacts I-J and I-(J+1) occur simultaneously.
+!C The system loses extra energy.
+!C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
+!C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
+!C Need to implement full formulas 32 from Liwo et al., 1998.
+!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)
+!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
+!c & ' jj=',jj,' kk=',kk
+ if (j1.eq.j+1) then
+!C Contacts I-J and (I+1)-J occur simultaneously.
+!C The system loses extra energy.
+ 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
+!-----------------------------------------------------------
+ real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+ 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)
+! print *,"ehbcorr_nucl",ekont,ees
+!cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
+!C Following 4 lines for diagnostics.
+!cd ees0pkl=0.0D0
+!cd ees0pij=1.0D0
+!cd ees0mkl=0.0D0
+!cd ees0mij=1.0D0
+!cd write (iout,*)'Contacts have occurred for nucleic bases',
+!cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
+!cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
+!C Calculate the multi-body contribution to energy.
+! ecorr_nucl=ecorr_nucl+ekont*ees
+!C Calculate multi-body contributions to the gradient.
+ coeffpees0pij=coeffp*ees0pij
+ coeffmees0mij=coeffm*ees0mij
+ coeffpees0pkl=coeffp*ees0pkl
+ coeffmees0mkl=coeffm*ees0mkl
+ do ll=1,3
+ 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
+ enddo
+ ehbcorr_nucl=ekont*ees
+ return
+ end function ehbcorr_nucl
+!-------------------------------------------------------------------------
+
+ real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+ 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)
+!cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
+!C Following 4 lines for diagnostics.
+!cd ees0pkl=0.0D0
+!cd ees0pij=1.0D0
+!cd ees0mkl=0.0D0
+!cd ees0mij=1.0D0
+!cd write (iout,*)'Contacts have occurred for nucleic bases',
+!cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
+!cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
+!C Calculate the multi-body contribution to energy.
+! ecorr=ecorr+ekont*ees
+!C Calculate multi-body contributions to the gradient.
+ coeffpees0pij=coeffp*ees0pij
+ coeffmees0mij=coeffm*ees0mij
+ coeffpees0pkl=coeffp*ees0pkl
+ coeffmees0mkl=coeffm*ees0mkl
+ do ll=1,3
+ 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
+ enddo
+ ehbcorr3_nucl=ekont*ees
+ return
+ end function ehbcorr3_nucl
+#ifdef MPI
+ subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
+ integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
+ 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))
+ enddo ! i
+ buffer(1,indx+30)=dfloat(num_kont)
+ return
+ end subroutine pack_buffer
+!c------------------------------------------------------------------------------
+ subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
+ integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
+ real(kind=8):: buffer(dimen1,dimen2)
+! double precision zapas
+! common /contacts_hb/ zapas(3,maxconts,maxres,8),
+! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
+! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
+! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
+ num_kont=buffer(1,indx+30)
+ 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)
+ 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
+! write(iout,*) "itmp",itmp
+ 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)
+! 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
+ rcal =xj**2+yj**2+zj**2
+ 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
+
+! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
+ ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
+ enddo
+ enddo
+ return
+ end subroutine ecatcat
+!---------------------------------------------------------------------------
+ subroutine ecat_prot(ecation_prot)
+ 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
+! 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
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+ 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
+ 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)
+ drcp_norm(1)=xj/rcpm
+ drcp_norm(2)=yj/rcpm
+ drcp_norm(3)=zj/rcpm
+ dcmag=0.0
+ do k=1,3
+ dcmag=dcmag+dc(k,i)**2
+ enddo
+ dcmag=dsqrt(dcmag)
+ do k=1,3
+ 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
+ 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
+! 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
+ 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)
+
+! 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
+! 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)
+!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)
+! 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
+ 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)
+! 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
+ enddo !j
+ enddo !i
+ return
+ end subroutine ecat_prot
+
+!----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+ subroutine eprot_sc_base(escbase)
+ 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'
+! include 'COMMON.CONTROL'
+! include 'COMMON.SBRIDGE'
+ logical :: lprn
+!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) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ 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
+ 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 )
+! 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=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 )
+! chi1=0.0d0
+! chi2=0.0d0
+ chi12 = chi1 * chi2
+ chip1 = chipp_scbase( itypi, itypj,1 )
+ chip2 = chipp_scbase( itypi, itypj,2 )
+! chip1=0.0d0
+! chip2=0.0d0
+ 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)
+! 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)
+! write (*,*) "sig1 = ", sig1
+! write (*,*) "sig2 = ", sig2
+! alpha factors from Fcav/Gcav
+ 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)
+! used to determine whether we want to do quadrupole calculations
+! used by Fgb
+ eps_in = epsintab_scbase(itypi,itypj)
+ if (eps_in.eq.0.0) eps_in=1.0
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+! write (*,*) "eps_inout_fac = ", eps_inout_fac
+!-------------------------------------------------------------------
+! tail location and distance calculations
+ 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+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)
+ 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 = 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 = 0.0d0
+ 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
+! fac = rij * fac
+! Calculate distance derivative
+ 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
+! 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)
+! 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
+! 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
+! 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)
+! dFdL = 0.0d0
+ 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 &
+! -2.0D0*alf12*eps3der+sigder*sigsq_om12
+! print *,"EOMY",eom1,eom2,eom12
+! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
+! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
+! here dtail=0.0
+! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
+ DO k = 1, 3
+! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
+! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
+ pom = ertail(k)
+!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ 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)
+!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+ 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))
+!c! & - ( dFdR * ertail(k))
+
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
+!c! & + ( dFdR * ertail(k))
+
+ gg(k) = 0.0d0
+!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
+!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
+ END DO
+
+! else
+
+! endif
+!Now dipole-dipole
+ 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)
+!c!-------------------------------------------------------------------
+!c! ECL
+ 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))
+ c3= (w3/ Rhead ** 6.0d0) &
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ ECL = c1 - c2 + c3
+!c! write (*,*) "w1 = ", w1
+!c! write (*,*) "w2 = ", w2
+!c! write (*,*) "om1 = ", om1
+!c! write (*,*) "om2 = ", om2
+!c! write (*,*) "om12 = ", om12
+!c! write (*,*) "fac = ", fac
+!c! write (*,*) "c1 = ", c1
+!c! write (*,*) "c2 = ", c2
+!c! write (*,*) "Ecl = ", Ecl
+!c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
+!c! write (*,*) "c2_2 = ",
+!c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+!c!-------------------------------------------------------------------
+!c! dervative of ECL is GCL...
+!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))
+ c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
+ * (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 )
+ 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 )
+ c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
+ dGCLdOM2 = c1 - c2 + c3
+!c! dECL/dom12
+ c1 = w1 / (Rhead ** 3.0d0)
+ c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
+ c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
+ dGCLdOM12 = c1 - c2 + c3
+ 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 = d1i * vbld_inv(i+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)
+ END DO
+ endif
+!now charge with dipole eg. ARG-dG
+ if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
+ alphapol1 = alphapol_scbase(itypi,itypj)
+ w1 = wqdip_scbase(1,itypi,itypj)
+ w2 = wqdip_scbase(2,itypi,itypj)
+! w1=0.0d0
+! w2=0.0d0
+! pis = sig0head_scbase(itypi,itypj)
+! eps_head = epshead_scbase(itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! R1 - distance between head of ith side chain and tail of jth sidechain
+ 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
+ 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 * om1
+ hawk = w2 * (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) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * 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)
+! eps_inout_fac=0.0d0
+ 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)
+ 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
+! 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)
+ 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) )
+! bat=0.0d0
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
+ facd1 = d1i * vbld_inv(i+nres)
+ facd2 = d1j * 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)))
+! 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))
+! & - 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))
+! & + dGLJdR * pom
+
+
+ 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)
+! & + dGLJdR * erhead(k)
+
+ END DO
+ endif
+! print *,i,j,evdwij,epol,Fcav,ECL
+ escbase=escbase+evdwij+epol+Fcav+ECL
+ call sc_grad_scbase
+ enddo
+ enddo
+
+ return
+ end subroutine eprot_sc_base
+ SUBROUTINE sc_grad_scbase
+ use calc_data
+
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ 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
+
+! 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)
+ END DO
+ RETURN
+ END SUBROUTINE sc_grad_scbase
+
+
+ subroutine epep_sc_base(epepbase)
+ use calc_data
+ logical :: lprn
+!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) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ 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
+ 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
+!C itypi = itype(i,1)
+ 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 )
+! 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 )
+! chi1=0.0d0
+! chi2=0.0d0
+ 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)
+! 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
+! + 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)
+! 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)))
+
+! alpha factors from Fcav/Gcav
+ 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)
+! print *,i,j,rrij
+ rij = dsqrt(rrij)
+!----------------------------
+ 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)
+ 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.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 = 0.0d0
+ 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
+! 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
+! 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)
+! 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
+! 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
+! 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)
+! dFdL = 0.0d0
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ 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)
+!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ 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)
+!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+ 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
+! 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))
+!c! & + ( dFdR * ertail(k))
+
+ gg(k) = 0.0d0
+!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
+!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
+ END DO
+
+
+ w1 = wdipdip_pepbase(1,itypj)
+ w2 = -wdipdip_pepbase(3,itypj)/2.0
+ w3 = wdipdip_pepbase(2,itypj)
+! w1=0.0d0
+! w2=0.0d0
+!c!-------------------------------------------------------------------
+!c! ECL
+! w3=0.0d0
+ 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))
+ c3= (w3/ Rhead ** 6.0d0) &
+ * (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))
+ c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
+ * (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 )
+ 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 )
+ c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
+
+ dGCLdOM2 = c1 - c2 + c3
+!c! dECL/dom12
+ c1 = w1 / (Rhead ** 3.0d0)
+ c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
+ c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
+ dGCLdOM12 = c1 - c2 + c3
+ 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_pepbase(k,i) = gvdwx_scbase(k,i) &
+! - dGCLdR * pom
+ pom = erhead(k)
+!+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
+ + dGCLdR * pom
+
+ 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
+! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
+ 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
+ call sc_grad_pepbase
+ enddo
+ enddo
+ END SUBROUTINE epep_sc_base
+ SUBROUTINE sc_grad_pepbase
+ use calc_data
+
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ 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
+! 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 *,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)
+ END DO
+ RETURN
+ END SUBROUTINE sc_grad_pepbase
+ subroutine eprot_sc_phosphate(escpho)
+ 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'
+! include 'COMMON.CONTROL'
+! include 'COMMON.SBRIDGE'
+ logical :: lprn
+!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) :: 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
+ 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
+ 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
+ dxj = dc_norm( 1,j )
+ 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 )
+! chi1=0.0d0
+! chi2=0.0d0
+ 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)
+! 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)
+
+ b1 = alphasur_scpho(1,itypi)
+! b1=0.0d0
+ 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)
+ if (eps_in.eq.0.0) eps_in=1.0
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+! 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
+ 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
+! 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)
+ 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_sq=Rhead**2.0
+!-------------------------------------------------------------------
+! 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
+ dGCLdR=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+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)
+!----------------------------
+ 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 = 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 = 0.0d0
+ 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
+! 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
+! 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)
+! 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
+! 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)
+! dFdL = 0.0d0
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ 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)
+! 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)
+! +(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)
+!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+! gvdwx_scpho(k,j) = gvdwx_scpho(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_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+1) = gvdwc_scpho(k,j+1) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
+
+!c! & + ( dFdR * ertail(k))
+
+ 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)
+ if (wqq_scpho(itypi).ne.0.0) then
+ Qij=wqq_scpho(itypi)/eps_in
+ alpha_sco=1.d0/alphi_scpho(itypi)
+! Qij=0.0
+ 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
+ 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)
+ w2 = wqdip_scpho(2,itypi)
+! w1=0.0d0
+! w2=0.0d0
+! pis = sig0head_scbase(itypi,itypj)
+! eps_head = epshead_scbase(itypi,itypj)
+!c!-------------------------------------------------------------------
+
+!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 * om1
+ hawk = w2 * (1.0d0 - sqom2)
+ Ecl = sparrow / Rhead**2.0d0 &
+ - hawk / Rhead**4.0d0
+!c!-------------------------------------------------------------------
+ if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
+ 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
+!c! dF/dom1
+ dGCLdOM1 = (w1) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
+ endif
+
+!c--------------------------------------------------------------------
+!c Polarization energy
+!c Epol
+ 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
+ END DO
+!c! Pitagoras
+ R1 = dsqrt(R1)
+
+ alphapol1 = alphapol_scpho(itypi)
+! alphapol1=0.0
+ MomoFac1 = (1.0d0 - chi2 * sqom1)
+ RR1 = R1 * R1 / MomoFac1
+ ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
+! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
+ fgb1 = sqrt( RR1 + a12sq * ee1)
+! eps_inout_fac=0.0d0
+ 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)
+ 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
+! dPOLdR1 = 0.0d0
+! dPOLdOM1 = 0.0d0
+ dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
+ * (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)
+ END DO
+
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j) )
+ bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
+! bat=0.0d0
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
+ facd1 = d1i * vbld_inv(i+nres)
+ facd2 = d1j * vbld_inv(j)
+! 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)))
+! 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))
+! & - dGLJdR * pom
+
+ 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)
+! & - 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
+
+! & + 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=escpho+evdwij+epol+Fcav+ECL
+ call sc_grad_scpho
+ enddo
+
+ enddo
+
+ return
+ end subroutine eprot_sc_phosphate
+ SUBROUTINE sc_grad_scpho
+ use calc_data
+
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ 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
+! 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_scpho(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,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)),&
+! (eom2*(erij(k)-om2*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)
+ END DO
+ RETURN
+ END SUBROUTINE sc_grad_scpho
+ subroutine eprot_pep_phosphate(epeppho)
+ 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'
+! include 'COMMON.CONTROL'
+! include 'COMMON.SBRIDGE'
+ logical :: lprn
+!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) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ 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
+ 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
+! Gay-berne var's
+ sig0ij = sigma_peppho
+! chi1=0.0d0
+! chi2=0.0d0
+ chi12 = chi1 * chi2
+! chip1=0.0d0
+! chip2=0.0d0
+ chip12 = chip1 * chip2
+! chis1 = 0.0d0
+! chis2 = 0.0d0
+ 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)
+! b1=0.0d0
+ b2 = alphasur_peppho(2)
+ b3 = alphasur_peppho(3)
+ b4 = alphasur_peppho(4)
+ CALL sc_angular
+ sqom1=om1*om1
+ evdwij = 0.0d0
+ ECL = 0.0d0
+ Elj = 0.0d0
+ Equad = 0.0d0
+ Epol = 0.0d0
+ Fcav=0.0d0
+ eheadtail = 0.0d0
+ dGCLdR=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
+ rij_shift = rij
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_peppho
+! c1 = 0.0d0
+ c2 = fac * bb_peppho
+! c2 = 0.0d0
+ 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)
+ w1 = wqdip_peppho(1)
+ w2 = wqdip_peppho(2)
+! w1=0.0d0
+! w2=0.0d0
+! pis = sig0head_scbase(itypi,itypj)
+! eps_head = epshead_scbase(itypi,itypj)
+!c!-------------------------------------------------------------------
+
+!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 * om1
+ hawk = w2 * (1.0d0 - sqom1)
+ Ecl = sparrow * rij_shift**2.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
+!c! dF/dom1
+ dGCLdOM1 = (w1) * (rij_shift**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
+ eom1 = dGCLdOM1+dGCLdOM2
+ eom2 = 0.0
+
+ 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
+
+ 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)) !&
+! - (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)) !&
+! + (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
+ epeppho=epeppho+evdwij+Fcav+ECL
+! print *,i,j,evdwij,Fcav,ECL,rij_shift
+ enddo
+ enddo
+ end subroutine eprot_pep_phosphate
+!!!!!!!!!!!!!!!!-------------------------------------------------------------
+ subroutine emomo(evdw)
+ use calc_data
+ use comm_momo
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.NAMES'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+! include 'COMMON.CONTROL'
+! include 'COMMON.SBRIDGE'
+ logical :: lprn
+!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) :: 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,&
+ 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)
+ 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))
+! 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
+! print *, 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)
+! 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 (energy_dec) write (iout,*) &
+! 'evdw',i,j,evdwij,' ss'
+ do k=j+1,iend(i,iint)
+!C search over all next residues
+ if (dyn_ss_mask(k)) then
+!C check if they are cysteins
+!C write(iout,*) 'k=',k
+
+!c write(iout,*) "PRZED TRI", evdwij
+! evdwij_przed_tri=evdwij
+ call triple_ssbond_ene(i,j,k,evdwij)
+!c if(evdwij_przed_tri.ne.evdwij) then
+!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
+!c endif
+
+!c write(iout,*) "PO TRI", evdwij
+!C call the energy function that removes the artifical triple disulfide
+!C bond the soubroutine is located in ssMD.F
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
+ ELSE
+!el ind=ind+1
+ 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 )
+! print *,i,j,itypi,itypj
+! d1i=0.0d0
+! d1j=0.0d0
+! BetaT = 1.0d0 / (298.0d0 * Rb)
+! Gay-berne var's
+!1! sig0ij = sigma_scsc( itypi,itypj )
+! chi1=0.0d0
+! chi2=0.0d0
+! chip1=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)
+! 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)
+! write (*,*) "sig1 = ", sig1
+! chis1=0.0
+! chis2=0.0
+! chis12 = chis1 * chis2
+! sig1=0.0
+! sig2=0.0
+! write (*,*) "sig2 = ", sig2
+! alpha factors from Fcav/Gcav
+ b1cav = alphasur(1,itypi,itypj)
+! b1cav=0.0d0
+ 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)
+ 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)))
+
+! write (*,*) "eps_inout_fac = ", eps_inout_fac
+!-------------------------------------------------------------------
+! tail location and distance calculations
+ d1 = dhead(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+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)
+ 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
+ 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 = 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
+! fac = rij * fac
+! Calculate distance derivative
+ 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
+! we will use pom later in Gcav, so dont mess with it!
+ 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)
+! print *,"sig1,sig2",sig1,sig2,itypi,itypj
+! write (*,*) "sparrow = ", 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
+! print *,top,bot,"bot,top",ChiLambf,Chif
+ 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)
+! dFdL = 0.0d0
+ 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+nres) )
+ facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+ facd2 = dtail(2,itypi,itypj) * vbld_inv(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)
+!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)
+!c! & + ( dFdR * pom )
+
+ 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))
+!c! & + ( dFdR * ertail(k))
+
+ 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=0
+ IF (isel.eq.0) THEN
+!c! No charges - do nothing
+ eheadtail = 0.0d0
+
+ ELSE IF (isel.eq.4) THEN
+!c! Calculate dipole-dipole interactions
+ CALL edd(ecl)
+ eheadtail = ECL
+! eheadtail = 0.0d0
+
+ ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
+!c! Charge-nonpolar interactions
+ CALL eqn(epol)
+ eheadtail = epol
+! eheadtail = 0.0d0
+
+ ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
+!c! Nonpolar-charge interactions
+ CALL enq(epol)
+ eheadtail = epol
+! eheadtail = 0.0d0
+
+ ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
+!c! Charge-dipole interactions
+ CALL eqd(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+! eheadtail = 0.0d0
+
+ ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
+!c! Dipole-charge interactions
+ 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
+!c! Same charge-charge interaction ( +/+ or -/- )
+ 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
+!c! Different charge-charge interaction ( +/- or -/+ )
+ 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
+! evdw = evdw + Fcav + eheadtail
+
+ iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad
+ END IF
+!c!-------------------------------------------------------------------
+!c! NAPISY KONCOWE
+ END DO ! j
+ END DO ! iint
+ END DO ! i
+!c write (iout,*) "Number of loop steps in EGB:",ind
+!c energy_dec=.false.
+! print *,"EVDW KURW",evdw,nres
+
+ RETURN
+ END SUBROUTINE emomo
+!C------------------------------------------------------------------------------------
+ SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
+ use calc_data
+ use comm_momo
+ real (kind=8) :: facd3, facd4, federmaus, adler,&
+ Ecl,Egb,Epol,Fisocav,Elj,Fgb
+! 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)
+ 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)
+ Egb = -(332.0d0 * Qij * eps_inout_fac) / 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)
+ 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
+!c!-------------------------------------------------------------------
+ SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
+ use comm_momo
+ use calc_data
+
+ double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad
+ double precision ener(4)
+ double precision dcosom1(3),dcosom2(3)
+!c! used in Epol derivatives
+ double precision facd3, facd4
+ double precision federmaus, adler
+ integer istate,ii,jj
+ real (kind=8) :: Fgb
+! print *,"CALLING EQUAD"
+!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)
+ csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
+ + sigiso2(itypi,itypj)**2.0d0))
+!c!
+ w1 = wqdip(1,itypi,itypj)
+ w2 = wqdip(2,itypi,itypj)
+ pis = sig0head(itypi,itypj)
+ eps_head = epshead(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
+ eom2 = eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der&
+ + sigder * sigsq_om2&
+ + dCAVdOM2
+ eom12 = evdwij * eps1_om12 &
+ + 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)
+!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
+!c! this acts on Calpha
+ 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
+ eom1 = 0.0d0
+ eom2 = 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
+!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
+
+!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
+ 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)
+!c! Ecl = 0.0d0
+!c! write (*,*) "Ecl = ", Ecl
+!c! derivative of Ecl is Gcl...
+ dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
+!c! dGCLdR = 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
+!c! Egb = 0.0d0
+!c! write (*,*) "a1*a2 = ", a12sq
+!c! write (*,*) "Rhead = ", Rhead
+!c! write (*,*) "Rhead_sq = ", Rhead_sq
+!c! write (*,*) "ee = ", ee
+!c! write (*,*) "Fgb = ", Fgb
+!c! write (*,*) "fac = ", eps_inout_fac
+!c! write (*,*) "Qij = ", Qij
+!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
+!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
+!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 ))
+!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
+!c! dPOLdR1 = 0.0d0
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.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)))
+!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
+!c! Equad = 0.0d0
+!c! derivative of Equad...
+ 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)
+!c! dQUADdOM1 = 0.0d0
+ 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 )
+ ELSE
+ Beta1 = 0.0d0
+ Equad = 0.0d0
+ END IF
+!c!-------------------------------------------------------------------
+!c! Return the results
+!c! Angular stuff
+ 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
+!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))
+!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) &
+ -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
+
+ 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) &
+ -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
+
+!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)
+!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))
+!c! foreach cartesian dimension
+ 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
+ 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
+ END DO
+ eheadtail = (-dlog(eheadtail)) / betaT
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+ dQUADdOM1 = 0.0d0
+ dQUADdOM2 = 0.0d0
+ dQUADdOM12 = 0.0d0
+ RETURN
+ END SUBROUTINE energy_quad
+!!-----------------------------------------------------------
+ SUBROUTINE eqn(Epol)
+ use comm_momo
+ use calc_data
+
+ double precision facd4, federmaus,epol
+ alphapol1 = alphapol(itypi,itypj)
+!c! R1 - distance between head of ith side chain and tail of jth sidechain
+ R1 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ 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 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)
+ 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
+ DO k = 1, 3
+ 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))
+ facd1 = d1 * 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)))
+
+ 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)
+
+ END DO
+ RETURN
+ END SUBROUTINE eqn
+ SUBROUTINE enq(Epol)
+ use calc_data
+ use comm_momo
+ double precision facd3, adler,epol
+ alphapol2 = alphapol(itypj,itypi)
+!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+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) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
+
+ 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
+
+ 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 eqd(Ecl,Elj,Epol)
+ use calc_data
+ use comm_momo
+ double precision facd4, federmaus,ecl,elj,epol
+ alphapol1 = alphapol(itypi,itypj)
+ w1 = wqdip(1,itypi,itypj)
+ w2 = wqdip(2,itypi,itypj)
+ pis = sig0head(itypi,itypj)
+ eps_head = epshead(itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! R1 - distance between head of ith side chain and tail of jth sidechain
+ R1 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ 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 * Qi * om1
+ hawk = w2 * Qi * Qi * (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 * Qi) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * 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 edd(ECL)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
+
+ double precision ecl
+!c! csig = sigiso(itypi,itypj)
+ w1 = wqdip(1,itypi,itypj)
+ w2 = wqdip(2,itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! ECL
+ 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))
+ ECL = c1 - c2
+!c! write (*,*) "w1 = ", w1
+!c! write (*,*) "w2 = ", w2
+!c! write (*,*) "om1 = ", om1
+!c! write (*,*) "om2 = ", om2
+!c! write (*,*) "om12 = ", om12
+!c! write (*,*) "fac = ", fac
+!c! write (*,*) "c1 = ", c1
+!c! write (*,*) "c2 = ", c2
+!c! write (*,*) "Ecl = ", Ecl
+!c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
+!c! write (*,*) "c2_2 = ",
+!c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+!c!-------------------------------------------------------------------
+!c! dervative of ECL is GCL...
+!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))
+ 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 )
+ 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 )
+ 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)
+ 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
end module energy
projects / unres4.git / blobdiff