- module energy
+ module energy
!-----------------------------------------------------------------------------
use io_units
use names
! amino-acid residue.
! common /precomp1/
real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
- Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
+ Ctobr,Ctobrder,Dtobr2,Dtobr2der,gUb2 !(2,maxres)
real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
! This common block contains vectors and matrices dependent on two
real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
DtUg2EUgder !(2,2,2,maxres)
! common /rotat_old/
+ real(kind=8),dimension(4) :: gmuij,gmuij1,gmuij2,gmuji1,gmuji2
real(kind=8),dimension(:),allocatable :: costab,sintab,&
costab2,sintab2 !(maxres)
! This common block contains dipole-interaction matrices and their
gvdwc_peppho
!------------------------------IONS GRADIENT
real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
- gradpepcat,gradpepcatx
+ gradpepcat,gradpepcatx,gradnuclcat,gradnuclcatx,gradcattranx,&
+ gradcattranc,gradcatangc,gradcatangx
! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
-
+!----------------------------------------
+ real(kind=8),dimension(:,:),allocatable ::gradlipelec,gradlipbond,&
+ gradlipang,gradliplj,gradpepmart, gradpepmartx
real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
!-----------------------------------------------------------------------------
! common.sbridge
! common /dyn_ssbond/
- real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
+ real(kind=8),dimension(:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
!-----------------------------------------------------------------------------
! common.sccor
! Parameters of the SCCOR term
! common /przechowalnia/
real(kind=8),dimension(:,:,:),allocatable :: zapas
real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
+#ifdef FIVEDIAG
+ real(kind=8),dimension(:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+#else
real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+#endif
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!
! energy_p_new_barrier.F
!-----------------------------------------------------------------------------
subroutine etotal(energia)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
use MD_data
#ifndef ISNAN
! include 'COMMON.TIME1'
real(kind=8) :: time00
!el local variables
- integer :: n_corr,n_corr1,ierror
+ integer :: n_corr,n_corr1,ierror,imatupdate
real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
Eafmforce,ethetacnstr
- real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
+ real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6,ehomology_constr
! now energies for nulceic alone parameters
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
ecorr3_nucl
! energies for ions
- real(kind=8) :: ecation_prot,ecationcation
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl,ecat_prottran,ecation_protang
! energies for protein nucleic acid interaction
real(kind=8) :: escbase,epepbase,escpho,epeppho
+! energies for MARTINI
+ real(kind=8) :: elipbond,elipang,elipelec,eliplj,elipidprot
#ifdef MPI
real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
! shielding effect varibles for MPI
- real(kind=8) :: fac_shieldbuf(nres), &
- grad_shield_locbuf1(3*maxcontsshi*nres), &
- grad_shield_sidebuf1(3*maxcontsshi*nres), &
- grad_shield_locbuf2(3*maxcontsshi*nres), &
- grad_shield_sidebuf2(3*maxcontsshi*nres), &
- grad_shieldbuf1(3*nres), &
- grad_shieldbuf2(3*nres)
-
- integer ishield_listbuf(-1:nres), &
- shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj
-
-
+ real(kind=8) :: fac_shieldbuf(nres_molec(1)), &
+ grad_shield_locbuf1(3*maxcontsshi*nres_molec(1)), &
+ grad_shield_sidebuf1(3*maxcontsshi*nres_molec(1)), &
+ grad_shield_locbuf2(3*maxcontsshi*nres_molec(1)), &
+ grad_shield_sidebuf2(3*maxcontsshi*nres_molec(1)), &
+ grad_shieldbuf1(3*nres_molec(1)), &
+ grad_shieldbuf2(3*nres_molec(1))
+
+ integer ishield_listbuf(-1:nres_molec(1)), &
+ shield_listbuf(maxcontsshi,-1:nres_molec(1)),k,j,i,iii,impishi,mojint,jjj
+ integer :: imatupdate2
+! print *,"I START ENERGY"
+ imatupdate=100
+ imatupdate2=100
+! if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
! real(kind=8), dimension(:),allocatable:: fac_shieldbuf
! real(kind=8), dimension(:,:,:),allocatable:: &
! grad_shield_locbuf,grad_shield_sidebuf
! allocate(ishield_listbuf(nres))
! allocate(shield_listbuf(maxcontsshi,nres))
! endif
-
+! print *,"wstrain check", wstrain
! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
! & " nfgtasks",nfgtasks
if (nfgtasks.gt.1) then
! print *,"Processor",myrank," BROADCAST iorder"
! FG master sets up the WEIGHTS_ array which will be broadcast to the
! FG slaves as WEIGHTS array.
- ! weights_(1)=wsc
+ weights_(1)=wsc
weights_(2)=wscp
weights_(3)=welec
weights_(4)=wcorr
weights_(41)=wcatcat
weights_(42)=wcatprot
weights_(46)=wscbase
- weights_(47)=wscpho
- weights_(48)=wpeppho
+ weights_(47)=wpepbase
+ weights_(48)=wscpho
+ weights_(49)=wpeppho
+ weights_(50)=wcatnucl
+ weights_(56)=wcat_tran
+ weights_(58)=wlip_prot
+ weights_(52)=wmartini
! wcatcat= weights(41)
! wcatprot=weights(42)
wcatcat= weights(41)
wcatprot=weights(42)
wscbase=weights(46)
- wscpho=weights(47)
- wpeppho=weights(48)
+ wpepbase=weights(47)
+ wscpho=weights(48)
+ wpeppho=weights(49)
+ wcatnucl=weights(50)
+ wmartini=weights(52)
+ wcat_tran=weights(56)
+ wlip_prot=weights(58)
+! welpsb=weights(28)*fact(1)
+!
+! wcorr_nucl= weights(37)*fact(1)
+! wcorr3_nucl=weights(38)*fact(2)
+! wtor_nucl= weights(35)*fact(1)
+! wtor_d_nucl=weights(36)*fact(2)
+
endif
time_Bcast=time_Bcast+MPI_Wtime()-time00
time_Bcastw=time_Bcastw+MPI_Wtime()-time00
! call chainbuild_cart
endif
+! print *,"itime_mat",itime_mat,imatupdate
+ if (nfgtasks.gt.1) then
+ call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR)
+ endif
+ if (nres_molec(1).gt.0) then
+ if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list
+! write (iout,*) "after make_SCp_inter_list"
+ if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
+! write (iout,*) "after make_SCSC_inter_list"
+ if (nres_molec(4).gt.0) then
+ if (mod(itime_mat,imatupdate).eq.0) call make_lip_pep_list
+ endif
+ if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list
+ if (nres_molec(5).gt.0) then
+ if (mod(itime_mat,imatupdate).eq.0) then
+! print *,'Processor',myrank,' calling etotal ipot=',ipot
+ call make_cat_pep_list
+! call make_cat_cat_list
+ endif
+ endif
+ endif
+ if (nres_molec(5).gt.0) then
+ if (mod(itime_mat,imatupdate2).eq.0) then
+! print *, "before cat cat"
+! print *,'Processor',myrank,' calling etotal ipot=',ipot
+! call make_cat_pep_list
+ call make_cat_cat_list
+ endif
+ endif
+! write (iout,*) "after make_pp_inter_list"
+
! print *,'Processor',myrank,' calling etotal ipot=',ipot
! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
#else
! Compute the side-chain and electrostatic interaction energy
! print *, "Before EVDW"
! goto (101,102,103,104,105,106) ipot
+ if (nres_molec(1).gt.0) then
select case(ipot)
! Lennard-Jones potential.
! 101 call elj(evdw)
.or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
.or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
#endif
- write(iout,*),"just befor eelec call"
+! print *,"just befor eelec call"
call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-! write (iout,*) "ELEC calc"
+! print *, "ELEC calc"
else
ees=0.0d0
evdw1=0.0d0
call escp_soft_sphere(evdw2,evdw2_14)
endif
! write(iout,*) "in etotal before ebond",ipot
-
+! print *,"after escp"
!
! Calculate the bond-stretching energy
!
! Calculate the disulfide-bridge and other energy and the contributions
! from other distance constraints.
! print *,'Calling EHPB'
- call edis(ehpb)
+! call edis(ehpb)
!elwrite(iout,*) "in etotal afer edis",ipot
! print *,'EHPB exitted succesfully.'
!
! Calculate the virtual-bond-angle energy.
! write(iout,*) "in etotal afer edis",ipot
- if (wang.gt.0.0d0) then
- call ebend(ebe,ethetacnstr)
+! if (wang.gt.0.0d0) then
+! call ebend(ebe,ethetacnstr)
+! else
+! ebe=0
+! ethetacnstr=0
+! endif
+ if (wang.gt.0d0) then
+ if (tor_mode.eq.0) then
+ call ebend(ebe)
+ else
+!C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call ebend_kcc(ebe)
+ endif
else
- ebe=0
- ethetacnstr=0
+ ebe=0.0d0
endif
+ ethetacnstr=0.0d0
+! write(iout,*) with_theta_constr,"with_theta_constr"
+ if (with_theta_constr) call etheta_constr(ethetacnstr)
+
! write(iout,*) "in etotal afer ebe",ipot
! print *,"Processor",myrank," computed UB"
! Calculate the SC local energy.
!
call esc(escloc)
-!elwrite(iout,*) "in etotal afer esc",ipot
+! print *, "in etotal afer esc",wtor
! print *,"Processor",myrank," computed USC"
!
! Calculate the virtual-bond torsional energy.
!
!d print *,'nterm=',nterm
- if (wtor.gt.0) then
- call etor(etors,edihcnstr)
+! if (wtor.gt.0) then
+! call etor(etors,edihcnstr)
+! else
+! etors=0
+! edihcnstr=0
+! endif
+ if (wtor.gt.0.0d0) then
+! print *,"WTOR",wtor,tor_mode
+ if (tor_mode.eq.0) then
+ call etor(etors)
+ else
+!C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call etor_kcc(etors)
+ endif
else
- etors=0
- edihcnstr=0
+ etors=0.0d0
endif
+ edihcnstr=0.0d0
+ if (ndih_constr.gt.0) call etor_constr(edihcnstr)
+!c print *,"Processor",myrank," computed Utor"
+
+! print *, "constr_homol",constr_homology
! print *,"Processor",myrank," computed Utor"
-
+ if (constr_homology.ge.1) then
+ call e_modeller(ehomology_constr)
+! print *,'iset=',iset,'me=',me,ehomology_constr,
+! & 'Processor',fg_rank,' CG group',kolor,
+! & ' absolute rank',MyRank
+! print *,"tu"
+ else
+ ehomology_constr=0.0d0
+ endif
+
!
! 6/23/01 Calculate double-torsional energy
!
-!elwrite(iout,*) "in etotal",ipot
+! print *, "before etor_d",wtor_d
if (wtor_d.gt.0) then
call etor_d(etors_d)
else
!
! If performing constraint dynamics, call the constraint energy
! after the equilibration time
- if(usampl.and.totT.gt.eq_time) then
-!elwrite(iout,*) "afeter multibody hb"
+ if((usampl).and.(totT.gt.eq_time)) then
+ write(iout,*) "usampl",usampl
call EconstrQ
!elwrite(iout,*) "afeter multibody hb"
call Econstr_back
else
eliptran=0.0d0
endif
+ else
+ eliptran=0.0d0
+ evdw=0.0d0
+#ifdef SCP14
+ evdw2=0.0d0
+ evdw2_14=0.0d0
+#else
+ evdw2=0.0d0
+#endif
+#ifdef SPLITELE
+ ees=0.0d0
+ evdw1=0.0d0
+#else
+ ees=0.0d0
+ evdw1=0.0d0
+#endif
+ ecorr=0.0d0
+ ecorr5=0.0d0
+ ecorr6=0.0d0
+ eel_loc=0.0d0
+ eello_turn3=0.0d0
+ eello_turn4=0.0d0
+ eturn6=0.0d0
+ ebe=0.0d0
+ escloc=0.0d0
+ etors=0.0d0
+ etors_d=0.0d0
+ ehpb=0.0d0
+ edihcnstr=0.0d0
+ estr=0.0d0
+ Uconst=0.0d0
+ esccor=0.0d0
+ ehomology_constr=0.0d0
+ ethetacnstr=0.0d0
+ endif !nres_molec(1)
+! write(iout,*) "TU JEST PRZED EHPB"
+! call edis(ehpb)
if (fg_rank.eq.0) then
if (AFMlog.gt.0) then
call AFMforce(Eafmforce)
else if (selfguide.gt.0) then
call AFMvel(Eafmforce)
+ else
+ Eafmforce=0.0d0
endif
endif
+! print *,"before tubemode",tubemode
if (tubemode.eq.1) then
call calctube(etube)
else if (tubemode.eq.2) then
else
etube=0.0d0
endif
+! print *, "TU JEST PRZED EHPB"
+ call edis(ehpb)
+
!--------------------------------------------------------
-! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
+! print *, "NRES_MOLEC(2),",nres_molec(2)
! print *,"before",ees,evdw1,ecorr
! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
if (nres_molec(2).gt.0) then
call epsb(evdwpsb,eelpsb)
call esb(esbloc)
call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
+ call ecat_nucl(ecation_nucl)
else
etors_nucl=0.0d0
estr_nucl=0.0d0
ecorr3_nucl=0.0d0
+ ecorr_nucl=0.0d0
ebe_nucl=0.0d0
evdwsb=0.0d0
eelsb=0.0d0
eelpsb=0.0d0
evdwpp=0.0d0
eespp=0.0d0
+ etors_d_nucl=0.0d0
+ ecation_nucl=0.0d0
endif
! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
- if (nfgtasks.gt.1) then
- if (fg_rank.eq.0) then
- call ecatcat(ecationcation)
- endif
+! print *,"before ecatcat",wcatcat
+ if (nres_molec(5).gt.0) then
+ if (g_ilist_catsctran.gt.0) then
+ call ecat_prot_transition(ecat_prottran)
+ else
+ ecat_prottran=0.0d0
+ endif
+ if (g_ilist_catscang.gt.0) then
+ call ecat_prot_ang(ecation_protang)
+ else
+ ecation_protang=0.0d0
+ endif
+! if (nfgtasks.gt.1) then
+! if (fg_rank.eq.0) then
+ if (nres_molec(5).gt.1) call ecatcat(ecationcation)
+! endif
+! else
+! if (nres_molec(5).gt.1) call ecatcat(ecationcation)
+! endif
+ if (oldion.gt.0) then
+ if (g_ilist_catpnorm.gt.0) call ecat_prot(ecation_prot)
+ else
+ if (g_ilist_catpnorm.gt.0) call ecats_prot_amber(ecation_prot)
+ endif
else
- call ecatcat(ecationcation)
+ ecationcation=0.0d0
+ ecation_prot=0.0d0
+ ecation_protang=0.0d0
+ ecat_prottran=0.0d0
endif
- call ecat_prot(ecation_prot)
- if (nres_molec(2).gt.0) then
+ if (g_ilist_catscnorm.eq.0) ecation_prot=0.0d0
+ if ((nres_molec(2).gt.0).and.(nres_molec(1).gt.0)) then
call eprot_sc_base(escbase)
call epep_sc_base(epepbase)
call eprot_sc_phosphate(escpho)
escpho=0.0
epeppho=0.0
endif
+! MARTINI FORCE FIELD ENERGY TERMS
+ if (nres_molec(4).gt.0) then
+ if (nfgtasks.gt.1) then
+ if (fg_rank.eq.0) then
+ call lipid_bond(elipbond)
+ call lipid_angle(elipang)
+ endif
+ else
+ call lipid_bond(elipbond)
+ call lipid_angle(elipang)
+ endif
+ call lipid_LJ(eliplj)
+ call lipid_elec(elipelec)
+ if (nres_molec(1).gt.0) then
+ call elip_prot(elipidprot)
+ else
+ elipidprot=0.0d0
+ endif
+ else
+ elipbond=0.0d0
+ elipang=0.0d0
+ eliplj=0.0d0
+ elipelec=0.0d0
+ endif
! call ecatcat(ecationcation)
-! print *,"after ebend", ebe_nucl
+! print *,"after ebend", wtor_nucl
#ifdef TIMING
time_enecalc=time_enecalc+MPI_Wtime()-time00
#endif
! Here are the energies showed per procesor if the are more processors
! per molecule then we sum it up in sum_energy subroutine
! print *," Processor",myrank," calls SUM_ENERGY"
- energia(41)=ecation_prot
- energia(42)=ecationcation
+ energia(42)=ecation_prot
+ energia(41)=ecationcation
energia(46)=escbase
energia(47)=epepbase
energia(48)=escpho
energia(49)=epeppho
+! energia(50)=ecations_prot_amber
+ energia(50)=ecation_nucl
+ energia(51)=ehomology_constr
+! energia(51)=homology
+ energia(52)=elipbond
+ energia(53)=elipang
+ energia(54)=eliplj
+ energia(55)=elipelec
+ energia(56)=ecat_prottran
+ energia(57)=ecation_protang
+ energia(58)=elipidprot
+! write(iout,*) elipelec,"elipelec"
+! write(iout,*) elipang,"elipang"
+! write(iout,*) eliplj,"eliplj"
call sum_energy(energia,.true.)
if (dyn_ss) call dyn_set_nss
! print *," Processor",myrank," left SUM_ENERGY"
end subroutine etotal
!-----------------------------------------------------------------------------
subroutine sum_energy(energia,reduce)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifndef ISNAN
external proc_proc
eliptran,etube, Eafmforce,ethetacnstr
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
- ecorr3_nucl
- real(kind=8) :: ecation_prot,ecationcation
+ ecorr3_nucl,ehomology_constr
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl,ecat_prottran,ecation_protang
real(kind=8) :: escbase,epepbase,escpho,epeppho
integer :: i
+ real(kind=8) :: elipbond,elipang,eliplj,elipelec,elipidprot
#ifdef MPI
integer :: ierr
real(kind=8) :: time00
etors_d_nucl=energia(36)
ecorr_nucl=energia(37)
ecorr3_nucl=energia(38)
- ecation_prot=energia(41)
- ecationcation=energia(42)
+ ecation_prot=energia(42)
+ ecationcation=energia(41)
escbase=energia(46)
epepbase=energia(47)
escpho=energia(48)
epeppho=energia(49)
+ ecation_nucl=energia(50)
+ ehomology_constr=energia(51)
+ elipbond=energia(52)
+ elipang=energia(53)
+ eliplj=energia(54)
+ elipelec=energia(55)
+ ecat_prottran=energia(56)
+ ecation_protang=energia(57)
+ elipidprot=energia(58)
+! ecations_prot_amber=energia(50)
+
! energia(41)=ecation_prot
! energia(42)=ecationcation
+wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
+wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
+wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
- +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
+ +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl&
+ +(elipbond+elipang+eliplj+elipelec)*wmartini&
+ +wcat_tran*ecat_prottran+ecation_protang&
+ +wlip_prot*elipidprot&
+#ifdef WHAM_RUN
+ +0.0d0
+#else
+ +ehomology_constr
+#endif
#else
etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
+wang*ebe+wtor*etors+wscloc*escloc &
+wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
+wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
+wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
- +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
+ +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl&
+ +(elipbond+elipang+eliplj+elipelec)*wmartini&
+ +wcat_tran*ecat_prottran+ecation_protang&
+ +wlip_prot*elipidprot&
+#ifdef WHAM_RUN
+ +0.0d0
+#else
+ +ehomology_constr
+#endif
#endif
energia(0)=etot
! detecting NaNQ
end subroutine sum_energy
!-----------------------------------------------------------------------------
subroutine rescale_weights(t_bath)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
#ifdef MPI
include 'mpif.h'
#endif
wtor=weights(13)*fact(1)
wtor_d=weights(14)*fact(2)
wsccor=weights(21)*fact(1)
-
+ welpsb=weights(28)*fact(1)
+ wcorr_nucl= weights(37)*fact(1)
+ wcorr3_nucl=weights(38)*fact(2)
+ wtor_nucl= weights(35)*fact(1)
+ wtor_d_nucl=weights(36)*fact(2)
+ wpepbase=weights(47)*fact(1)
return
end subroutine rescale_weights
!-----------------------------------------------------------------------------
subroutine enerprint(energia)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.FFIELD'
etube,ethetacnstr,Eafmforce
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
- ecorr3_nucl
- real(kind=8) :: ecation_prot,ecationcation
+ ecorr3_nucl,ehomology_constr
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl,ecat_prottran,ecation_protang
real(kind=8) :: escbase,epepbase,escpho,epeppho
-
+ real(kind=8) :: elipbond,elipang,eliplj,elipelec,elipidprot
etot=energia(0)
evdw=energia(1)
evdw2=energia(2)
etors_d_nucl=energia(36)
ecorr_nucl=energia(37)
ecorr3_nucl=energia(38)
- ecation_prot=energia(41)
- ecationcation=energia(42)
+ ecation_prot=energia(42)
+ ecationcation=energia(41)
escbase=energia(46)
epepbase=energia(47)
escpho=energia(48)
epeppho=energia(49)
+ ecation_nucl=energia(50)
+ elipbond=energia(52)
+ elipang=energia(53)
+ eliplj=energia(54)
+ elipelec=energia(55)
+ ecat_prottran=energia(56)
+ ecation_protang=energia(57)
+ ehomology_constr=energia(51)
+ elipidprot=energia(58)
+! ecations_prot_amber=energia(50)
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
estr,wbond,ebe,wang,&
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, &
+ ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,&
+ ecat_prottran,wcat_tran,ecation_protang,wcat_ang,&
+ ecationcation,wcatcat, &
escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
- etot
+ ecation_nucl,wcatnucl,ehomology_constr,&
+ elipbond,elipang,eliplj,elipelec,elipidprot,wlip_prot,etot
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'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)'/ &
+ 'ECATPTRAN=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot tran)'/ &
+ 'ECATPANG=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot angle)'/ &
'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)'/&
+ 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
+ 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/&
+ 'ELIPBOND=',1pE16.6,'(matrini bond energy)'/&
+ 'ELIPANG=',1pE16.6,'(matrini angle energy)'/&
+ 'ELIPLJ=',1pE16.6,'(matrini Lennard-Jones energy)'/&
+ 'ELIPELEC=',1pE16.6,'(matrini electrostatic energy)'/&
+ 'ELIPPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(lipid prot)'/ &
'ETOT= ',1pE16.6,' (total)')
#else
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
ecorr,wcorr,&
ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
- ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
- etube,wtube, &
+ ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforce, &
+ etube,wtube, ehomology_constr,&
estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
- evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
- evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
+ evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
+ evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
- etot
+ ecation_nucl,wcatnucl,ehomology_constr,elipidprot,wlip_prot,etot
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
+ 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
+ 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/&
+ 'ELIPBOND=',1pE16.6,'(matrini bond energy)'/&
+ 'ELIPANG=',1pE16.6,'(matrini angle energy)'/&
+ 'ELIPLJ=',1pE16.6,'(matrini Lennard-Jones energy)'/&
+ 'ELIPELEC=',1pE16.6,'(matrini electrostatic energy)'/&
+ 'ELIPPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(lipid prot)'/ &
'ETOT= ',1pE16.6,' (total)')
#endif
return
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the LJ potential of interaction.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
real(kind=8),parameter :: accur=1.0d-10
! include 'COMMON.GEO'
integer :: num_conti
!el local variables
integer :: i,itypi,iint,j,itypi1,itypj,k
- real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
+ real(kind=8) :: rij,rcut,fcont,fprimcont,rrij,sslipi,ssgradlipi,&
+ aa,bb,sslipj,ssgradlipj
real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
! Change 12/1/95
num_conti=0
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
! Change 12/1/95 to calculate four-body interactions
rij=xj*xj+yj*yj+zj*zj
rrij=1.0D0/rij
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the LJK potential of interaction.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
logical :: scheck
!el local variables
integer :: i,iint,j,itypi,itypi1,k,itypj
- real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
+ real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij, &
+ sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
!
use comm_srutu
use calc_data
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi
+ real(kind=8) :: rrij,xi,yi,zi, sslipi,ssgradlipi, sslipj, &
+ ssgradlipj, aa, bb
real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! assuming the Gay-Berne potential of interaction.
!
use calc_data
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
! include 'COMMON.SBRIDGE'
logical :: lprn
!el local variables
- integer :: iint,itypi,itypi1,itypj,subchap
+ integer :: iint,itypi,itypi1,itypj,subchap,icont,countss
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,&
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
lprn=.false.
+ countss=0
! if (icall.eq.0) lprn=.false.
!el ind=0
dCAVdOM2=0.0d0
dCAVdOM1=0.0d0
dGCLdOM1=0.0d0
dPOLdOM1=0.0d0
-
-
- do i=iatsc_s,iatsc_e
+! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
+ if (nres_molec(1).eq.0) return
+ do icont=g_listscsc_start,g_listscsc_end
+ i=newcontlisti(icont)
+ j=newcontlistj(icont)
+! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
+! do i=iatsc_s,iatsc_e
!C print *,"I am in EVDW",i
itypi=iabs(itype(i,1))
! if (i.ne.47) cycle
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-! print *, sslipi,ssgradlipi
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
!
! Calculate SC interaction energy.
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+! do iint=1,nint_gr(i)
+! do j=istart(i,iint),iend(i,iint)
IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- call dyn_ssbond_ene(i,j,evdwij)
+ countss=countss+1
+ call dyn_ssbond_ene(i,j,evdwij,countss)
evdw=evdw+evdwij
if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
'evdw',i,j,evdwij,' ss'
! if (energy_dec) write (iout,*) &
! 'evdw',i,j,evdwij,' ss'
- do k=j+1,iend(i,iint)
+ do k=j+1,nres
!C search over all next residues
if (dyn_ss_mask(k)) then
!C check if they are cysteins
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
-! print *,"tu",xi,yi,zi,xj,yj,zj
-! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
-! this fragment set correct epsilon for lipid phase
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-!------------------------------------------------
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! write (iout,*) "KWA2", itypi,itypj
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(rrij)
- sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
- sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
! print *,sss_ele_cut,sss_ele_grad,&
! 1.0d0/(rij),r_cut_ele,rlamb_ele
if (sss_ele_cut.le.0.0) cycle
endif
if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
- 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
+ 'evdw',i,j,evdwij,1.0D0/rij,1.0D0/rij_shift,dabs(aa/bb)**(1.0D0/6.0D0)!,"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
fac=rij*fac
! print *,'before fac',fac,rij,evdwij
fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
- /sigma(itypi,itypj)*rij
+ *rij
! print *,'grad part scale',fac, &
! evdwij*sss_ele_grad/sss_ele_cut &
! /sigma(itypi,itypj)*rij
! Calculate angular part of the gradient.
call sc_grad
ENDIF ! dyn_ss
- enddo ! j
- enddo ! iint
+! enddo ! j
+! enddo ! iint
enddo ! i
! print *,"ZALAMKA", evdw
! write (iout,*) "Number of loop steps in EGB:",ind
!
use comm_srutu
use calc_data
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
+ real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2, &
+ sigm,sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the LJ potential of interaction.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
real(kind=8),parameter :: accur=1.0d-10
! include 'COMMON.GEO'
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
!
! Calculate SC interaction energy.
!
do j=istart(i,iint),iend(i,iint)
itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ xj=boxshift(c(1,nres+j)-xi,boxxsize)
+ yj=boxshift(c(2,nres+j)-yi,boxysize)
+ zj=boxshift(c(3,nres+j)-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
r0ij=r0(itypi,itypj)
!
! Soft-sphere potential of p-p interaction
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
! include 'COMMON.IOUNITS'
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
num_conti=0
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
xj=c(1,j)+0.5D0*dxj-xmedi
yj=c(2,j)+0.5D0*dyj-ymedi
zj=c(3,j)+0.5D0*dzj-zmedi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
if (rij.lt.r0ijsq) then
evdw1ij=0.25d0*(rij-r0ijsq)**2
end subroutine eelec_soft_sphere
!-----------------------------------------------------------------------------
subroutine vec_and_deriv
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
end subroutine vec_and_deriv
!-----------------------------------------------------------------------------
subroutine check_vecgrad
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.GEO'
end subroutine check_vecgrad
!-----------------------------------------------------------------------------
subroutine set_matrices
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
! include 'COMMON.VECTORS'
! include 'COMMON.FFIELD'
real(kind=8) :: auxvec(2),auxmat(2,2)
- integer :: i,iti1,iti,k,l
- real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
+ integer :: i,iti1,iti,k,l,ii,innt,inct
+ real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2,cost1,sint1,&
+ sint1sq,sint1cub,sint1cost1,b1k,b2k,aux
! print *,"in set matrices"
!
! Compute the virtual-bond-torsional-angle dependent quantities needed
! to calculate the el-loc multibody terms of various order.
!
!AL el mu=0.0d0
+
+#ifdef PARMAT
+ do i=ivec_start+2,ivec_end+2
+#else
+ do i=3,nres+1
+#endif
+#ifdef FIVEDIAG
+ ii=ireschain(i-2)
+!c write (iout,*) "i",i,i-2," ii",ii
+ if (ii.eq.0) cycle
+ innt=chain_border(1,ii)
+ inct=chain_border(2,ii)
+!c write (iout,*) "i",i,i-2," ii",ii," innt",innt," inct",inct
+!c if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ if (i.gt. innt+2 .and. i.lt.inct+2) then
+ if (itype(i-2,1).eq.0) then
+ iti = nloctyp
+ else
+ iti = itype2loc(itype(i-2,1))
+ endif
+ else
+ iti=nloctyp
+ endif
+!c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
+ if (i.gt. innt+1 .and. i.lt.inct+1) then
+! iti1 = itype2loc(itype(i-1))
+ if (itype(i-1,1).eq.0) then
+ iti1 = nloctyp
+ else
+ iti1 = itype2loc(itype(i-1,1))
+ endif
+ else
+ iti1=nloctyp
+ endif
+#else
+ if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ if (itype(i-2,1).eq.0) then
+ iti = nloctyp
+ else
+ iti = itype2loc(itype(i-2,1))
+ endif
+ else
+ iti=nloctyp
+ endif
+!c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
+ if (i.gt. nnt+1 .and. i.lt.nct+1) then
+ iti1 = itype2loc(itype(i-1,1))
+ else
+ iti1=nloctyp
+ endif
+#endif
+! print *,i,itype(i-2,1),iti
+#ifdef NEWCORR
+ cost1=dcos(theta(i-1))
+ sint1=dsin(theta(i-1))
+ sint1sq=sint1*sint1
+ sint1cub=sint1sq*sint1
+ sint1cost1=2*sint1*cost1
+! print *,"cost1",cost1,theta(i-1)
+!c write (iout,*) "bnew1",i,iti
+!c write (iout,*) (bnew1(k,1,iti),k=1,3)
+!c write (iout,*) (bnew1(k,2,iti),k=1,3)
+!c write (iout,*) "bnew2",i,iti
+!c write (iout,*) (bnew2(k,1,iti),k=1,3)
+!c write (iout,*) (bnew2(k,2,iti),k=1,3)
+ k=1
+! print *,bnew1(1,k,iti),"bnew1"
+ do k=1,2
+ b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
+! print *,b1k
+! write(*,*) shape(b1)
+! if(.not.allocated(b1)) print *, "WTF?"
+ b1(k,i-2)=sint1*b1k
+!
+! print *,b1(k,i-2)
+
+ gtb1(k,i-2)=cost1*b1k-sint1sq*&
+ (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
+! print *,gtb1(k,i-2)
+
+ b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
+ b2(k,i-2)=sint1*b2k
+! print *,b2(k,i-2)
+
+ gtb2(k,i-2)=cost1*b2k-sint1sq*&
+ (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
+! print *,gtb2(k,i-2)
+
+ enddo
+! print *,b1k,b2k
+ do k=1,2
+ aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
+ cc(1,k,i-2)=sint1sq*aux
+ gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*&
+ (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
+ aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
+ dd(1,k,i-2)=sint1sq*aux
+ gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*&
+ (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
+ enddo
+! print *,"after cc"
+ cc(2,1,i-2)=cc(1,2,i-2)
+ cc(2,2,i-2)=-cc(1,1,i-2)
+ gtcc(2,1,i-2)=gtcc(1,2,i-2)
+ gtcc(2,2,i-2)=-gtcc(1,1,i-2)
+ dd(2,1,i-2)=dd(1,2,i-2)
+ dd(2,2,i-2)=-dd(1,1,i-2)
+ gtdd(2,1,i-2)=gtdd(1,2,i-2)
+ gtdd(2,2,i-2)=-gtdd(1,1,i-2)
+! print *,"after dd"
+
+ do k=1,2
+ do l=1,2
+ aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
+ EE(l,k,i-2)=sint1sq*aux
+ gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
+ enddo
+ enddo
+ EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
+ EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
+ EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
+ EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
+ gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
+ gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
+ gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
+! print *,"after ee"
+
+!c b1tilde(1,i-2)=b1(1,i-2)
+!c b1tilde(2,i-2)=-b1(2,i-2)
+!c b2tilde(1,i-2)=b2(1,i-2)
+!c b2tilde(2,i-2)=-b2(2,i-2)
+#ifdef DEBUG
+ write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
+ write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
+ write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
+ write (iout,*) 'theta=', theta(i-1)
+#endif
+#else
+ if (i.gt. innt+2 .and. i.lt.inct+2) then
+! write(iout,*) "i,",molnum(i),nloctyp
+! print *, "i,",molnum(i),i,itype(i-2,1)
+ if (molnum(i).eq.1) then
+ if (itype(i-2,1).eq.ntyp1) then
+ iti=nloctyp
+ else
+ iti = itype2loc(itype(i-2,1))
+ endif
+ else
+ iti=nloctyp
+ endif
+ else
+ iti=nloctyp
+ endif
+!c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
+!c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
+ if (i.gt. nnt+1 .and. i.lt.nct+1) then
+ iti1 = itype2loc(itype(i-1,1))
+ else
+ iti1=nloctyp
+ endif
+! print *,i,iti
+ b1(1,i-2)=b(3,iti)
+ b1(2,i-2)=b(5,iti)
+ b2(1,i-2)=b(2,iti)
+ b2(2,i-2)=b(4,iti)
+ do k=1,2
+ do l=1,2
+ CC(k,l,i-2)=ccold(k,l,iti)
+ DD(k,l,i-2)=ddold(k,l,iti)
+ EE(k,l,i-2)=eeold(k,l,iti)
+ enddo
+ enddo
+#endif
+ b1tilde(1,i-2)= b1(1,i-2)
+ b1tilde(2,i-2)=-b1(2,i-2)
+ b2tilde(1,i-2)= b2(1,i-2)
+ b2tilde(2,i-2)=-b2(2,i-2)
+!c
+ Ctilde(1,1,i-2)= CC(1,1,i-2)
+ Ctilde(1,2,i-2)= CC(1,2,i-2)
+ Ctilde(2,1,i-2)=-CC(2,1,i-2)
+ Ctilde(2,2,i-2)=-CC(2,2,i-2)
+!c
+ Dtilde(1,1,i-2)= DD(1,1,i-2)
+ Dtilde(1,2,i-2)= DD(1,2,i-2)
+ Dtilde(2,1,i-2)=-DD(2,1,i-2)
+ Dtilde(2,2,i-2)=-DD(2,2,i-2)
+ enddo
#ifdef PARMAT
do i=ivec_start+2,ivec_end+2
#else
do i=3,nres+1
#endif
+
! print *,i,"i"
- if (i .lt. nres+1) then
+ if (i .lt. nres+1 .and. (itype(i-1,1).lt.ntyp1).and.(itype(i-1,1).ne.0)) then
+! if (i .lt. nres+1) then
sin1=dsin(phi(i))
cos1=dcos(phi(i))
sintab(i-2)=sin1
Ug2(2,1,i-2)=0.0d0
Ug2(2,2,i-2)=0.0d0
endif
- if (i .gt. 3 .and. i .lt. nres+1) then
+ if (i .gt. 3) then ! .and. i .lt. nres+1) then
obrot_der(1,i-2)=-sin1
obrot_der(2,i-2)= cos1
Ugder(1,1,i-2)= sin1
if (itype(i-2,1).eq.0) then
iti=ntortyp+1
else
- iti = itortyp(itype(i-2,1))
+ iti = itype2loc(itype(i-2,1))
endif
else
- iti=ntortyp+1
+ iti=nloctyp
endif
! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
if (i.gt. nnt+1 .and. i.lt.nct+1) then
if (itype(i-1,1).eq.0) then
- iti1=ntortyp+1
+ iti1=nloctyp
else
- iti1 = itortyp(itype(i-1,1))
+ iti1 = itype2loc(itype(i-1,1))
endif
else
- iti1=ntortyp+1
+ iti1=nloctyp
endif
! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
!d write (iout,*) '*******i',i,' iti1',iti
-!d write (iout,*) 'b1',b1(:,iti)
-!d write (iout,*) 'b2',b2(:,iti)
+! write (iout,*) 'b1',b1(:,iti)
+! write (iout,*) 'b2',b2(:,i-2)
!d write (iout,*) 'Ug',Ug(:,:,i-2)
! if (i .gt. iatel_s+2) then
if (i .gt. nnt+2) then
- call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
- call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
+ call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
+#ifdef NEWCORR
+ call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
+!c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
+#endif
+
+ call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
+ call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
then
- call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
- call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
+ call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
+ call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
+ call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
+ call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
+ call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
endif
else
do k=1,2
enddo
enddo
endif
- call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
- call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
+ call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
+ call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
do k=1,2
muder(k,i-2)=Ub2der(k,i-2)
enddo
! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
if (i.gt. nnt+1 .and. i.lt.nct+1) then
if (itype(i-1,1).eq.0) then
- iti1=ntortyp+1
+ iti1=nloctyp
elseif (itype(i-1,1).le.ntyp) then
- iti1 = itortyp(itype(i-1,1))
+ iti1 = itype2loc(itype(i-1,1))
else
- iti1=ntortyp+1
+ iti1=nloctyp
endif
else
- iti1=ntortyp+1
+ iti1=nloctyp
endif
do k=1,2
- mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
+ mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
enddo
-! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
-! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
-! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
+ if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
+ if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,i-1)
+ if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
!d write (iout,*) 'mu1',mu1(:,i-2)
!d write (iout,*) 'mu2',mu2(:,i-2)
if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
then
- call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
- call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
+ call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
+ call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
+ call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
+ call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
+ call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
! Vectors and matrices dependent on a single virtual-bond dihedral.
- call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
+ call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
+ call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
+ call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
! the orientation of the CA-CA virtual bonds.
!
use comm_locel
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
#ifdef MPI
include 'mpif.h'
#endif
0.0d0,1.0d0,0.0d0,&
0.0d0,0.0d0,1.0d0/),shape(unmat))
!el local variables
- integer :: i,k,j
+ integer :: i,k,j,icont
real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
real(kind=8) :: fac,t_eelecij,fracinbuf
eel_loc=0.0d0
eello_turn3=0.0d0
eello_turn4=0.0d0
+ if (nres_molec(1).eq.0) return
!
if (icheckgrad.eq.1) then
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=0
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-! print *,i,sslipi,ssgradlipi
call eelecij(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
num_cont_hb(i)=num_conti
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=num_cont_hb(i)
call eelecij(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
- call eturn4(i,eello_turn4)
+ call eturn4(i,eello_turn4)
! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
num_cont_hb(i)=num_conti
enddo ! i
! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
!
! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
- do i=iatel_s,iatel_e
+! do i=iatel_s,iatel_e
+! JPRDLC
+ do icont=g_listpp_start,g_listpp_end
+ i=newcontlistppi(icont)
+ j=newcontlistppj(icont)
if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
+! do j=ielstart(i),ielend(i)
! write (iout,*) i,j,itype(i,1),itype(j,1)
if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
- enddo ! j
+! enddo ! j
num_cont_hb(i)=num_conti
enddo ! i
! write (iout,*) "Number of loop steps in EELEC:",ind
subroutine eelecij(i,j,ees,evdw1,eel_loc)
use comm_locel
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
real(kind=8),dimension(2,2) :: acipa !el,a_temp
!el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
real(kind=8),dimension(4) :: muij
+ real(kind=8) :: geel_loc_ij,geel_loc_ji
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
dist_temp, dist_init,rlocshield,fracinbuf
integer xshift,yshift,zshift,ilist,iresshield
!el local variables
integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
+ real(kind=8) :: faclipij2, faclipij
real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
xj=c(1,j)+0.5D0*dxj
yj=c(2,j)+0.5D0*dyj
zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
-!C print *,i,j
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
! sss_ele_grad=0.0d0
! print *,sss_ele_cut,sss_ele_grad,&
! (rij),r_cut_ele,rlamb_ele
-! if (sss_ele_cut.le.0.0) go to 128
+ if (sss_ele_cut.le.0.0) go to 128
rmij=1.0D0/rij
r3ij=rrmij*rmij
!grad enddo
!grad enddo
! 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj &
+ ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- ggg(2)=facvdw*yj &
+ ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- ggg(3)=facvdw*zj &
+ ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
do k=1,3
do l=1,2
kkk=kkk+1
muij(kkk)=mu(k,i)*mu(l,j)
+#ifdef NEWCORR
+ gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
+!c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
+ gmuij2(kkk)=gUb2(k,i)*mu(l,j)
+ gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
+!c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
+ gmuji2(kkk)=mu(k,i)*gUb2(l,j)
+#endif
+
enddo
enddo
!d write (iout,*) 'EELEC: i',i,' j',j
enddo
endif
+#ifdef NEWCORR
+ geel_loc_ij=(a22*gmuij1(1)&
+ +a23*gmuij1(2)&
+ +a32*gmuij1(3)&
+ +a33*gmuij1(4))&
+ *fac_shield(i)*fac_shield(j)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+!c write(iout,*) "derivative over thatai"
+!c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
+!c & a33*gmuij1(4)
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)+&
+ geel_loc_ij*wel_loc
+!c write(iout,*) "derivative over thatai-1"
+!c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
+!c & a33*gmuij2(4)
+ geel_loc_ij=&
+ a22*gmuij2(1)&
+ +a23*gmuij2(2)&
+ +a32*gmuij2(3)&
+ +a33*gmuij2(4)
+ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+&
+ geel_loc_ij*wel_loc&
+ *fac_shield(i)*fac_shield(j)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+!c Derivative over j residue
+ geel_loc_ji=a22*gmuji1(1)&
+ +a23*gmuji1(2)&
+ +a32*gmuji1(3)&
+ +a33*gmuji1(4)
+!c write(iout,*) "derivative over thataj"
+!c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
+!c & a33*gmuji1(4)
+
+ gloc(nphi+j,icg)=gloc(nphi+j,icg)+&
+ geel_loc_ji*wel_loc&
+ *fac_shield(i)*fac_shield(j)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+ geel_loc_ji=&
+ +a22*gmuji2(1)&
+ +a23*gmuji2(2)&
+ +a32*gmuji2(3)&
+ +a33*gmuji2(4)
+!c write(iout,*) "derivative over thataj-1"
+!c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
+!c & a33*gmuji2(4)
+ gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+&
+ geel_loc_ji*wel_loc&
+ *fac_shield(i)*fac_shield(j)&
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+#endif
! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
! eel_loc_ij=0.0
ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
*sss_ele_cut &
*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
*sss_ele_cut &
*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
! Diagnostics. Comment out or remove after debugging!
! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
gacontp_hb1(k,num_conti,i)= & !ghalfp+
(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+ ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
- *sss_ele_cut*fac_shield(i)*fac_shield(j)
+ *sss_ele_cut*fac_shield(i)*fac_shield(j) ! &
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
gacontp_hb2(k,num_conti,i)= & !ghalfp+
(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+ ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
- *sss_ele_cut*fac_shield(i)*fac_shield(j)
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)! &
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
gacontp_hb3(k,num_conti,i)=gggp(k) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
gacontm_hb1(k,num_conti,i)= & !ghalfm+
(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+ ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
gacontm_hb2(k,num_conti,i)= & !ghalfm+
(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+ ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
gacontm_hb3(k,num_conti,i)=gggm(k) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
enddo
! Diagnostics. Comment out or remove after debugging!
! Third- and fourth-order contributions from turns
use comm_locel
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.GEO'
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
- e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
+ e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,gpizda1,&
+ gpizda2,auxgmat1,auxgmatt1,auxgmat2,auxgmatt2
+
real(kind=8),dimension(2) :: auxvec,auxvec1
!el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
!el num_conti,j1,j2
!el local variables
integer :: i,j,l,k,ilist,iresshield
- real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
-
+ real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield,xj,yj
+ xj=0.0d0
+ yj=0.0d0
j=i+2
! write (iout,*) "eturn3",i,j,j1,j2
zj=(c(3,j)+c(3,j+1))/2.0d0
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.lt.0)) write (*,*) "CHUJ"
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
a_temp(1,1)=a22
a_temp(1,2)=a23
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!d call checkint_turn3(i,a_temp,eello_turn3_num)
call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
+ call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
+ call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
call transpose2(auxmat(1,1),auxmat1(1,1))
+ call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
+ call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+ call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
+ call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
+
if (shield_mode.eq.0) then
fac_shield(i)=1.0d0
fac_shield(j)=1.0d0
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
+!C#ifdef NEWCORR
+!C Derivatives in theta
+ gloc(nphi+i,icg)=gloc(nphi+i,icg) &
+ +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+ gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)&
+ +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+!C#endif
+
+
+
if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
(shield_mode.gt.0)) then
!C print *,i,j
! Third- and fourth-order contributions from turns
use comm_locel
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.GEO'
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
- e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
- real(kind=8),dimension(2) :: auxvec,auxvec1
+ e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,&
+ gte1t,gte2t,gte3t,&
+ gte1a,gtae3,gtae3e2, ae3gte2,&
+ gtEpizda1,gtEpizda2,gtEpizda3
+
+ real(kind=8),dimension(2) :: auxvec,auxvec1,auxgEvec1,auxgEvec2,&
+ auxgEvec3,auxgvec
+
!el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
!el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
!el local variables
integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
- rlocshield
-
+ rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3,xj,yj
+ xj=0.0d0
+ yj=0.0d0
j=i+3
! if (j.ne.20) return
! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
!d call checkint_turn4(i,a_temp,eello_turn4_num)
! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
zj=(c(3,j)+c(3,j+1))/2.0d0
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+
a_temp(1,1)=a22
a_temp(1,2)=a23
a_temp(2,1)=a32
a_temp(2,2)=a33
- iti1=itortyp(itype(i+1,1))
- iti2=itortyp(itype(i+2,1))
- iti3=itortyp(itype(i+3,1))
+ iti1=i+1
+ iti2=i+2
+ iti3=i+3
! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
call transpose2(EUg(1,1,i+1),e1t(1,1))
call transpose2(Eug(1,1,i+2),e2t(1,1))
call transpose2(Eug(1,1,i+3),e3t(1,1))
+!C Ematrix derivative in theta
+ call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
+ call transpose2(gtEug(1,1,i+2),gte2t(1,1))
+ call transpose2(gtEug(1,1,i+3),gte3t(1,1))
+
call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+ call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
+ call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
+!c auxalary matrix of E i+1
+ call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
s1=scalar2(b1(1,iti2),auxvec(1))
+!c derivative of theta i+2 with constant i+3
+ gs23=scalar2(gtb1(1,i+2),auxvec(1))
+!c derivative of theta i+2 with constant i+2
+ gs32=scalar2(b1(1,i+2),auxgvec(1))
+!c derivative of E matix in theta of i+1
+ gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
+
call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+ call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
+!c auxilary matrix auxgvec of Ub2 with constant E matirx
+ call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
+!c auxilary matrix auxgEvec1 of E matix with Ub2 constant
+ call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
+ s2=scalar2(b1(1,i+1),auxvec(1))
+!c derivative of theta i+1 with constant i+3
+ gs13=scalar2(gtb1(1,i+1),auxvec(1))
+!c derivative of theta i+2 with constant i+1
+ gs21=scalar2(b1(1,i+1),auxgvec(1))
+!c derivative of theta i+3 with constant i+1
+ gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
+
call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+ call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
+!c ae3gte2 is derivative over i+2
+ call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
+
call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+ call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
+!c i+2
+ call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
+!c i+3
+ call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
+
s3=0.5d0*(pizda(1,1)+pizda(2,2))
+ gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
+ gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
+ gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
if (shield_mode.eq.0) then
fac_shield(i)=1.0
fac_shield(j)=1.0
! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1)
enddo
endif
+#ifdef NEWCORR
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)&
+ -(gs13+gsE13+gsEE1)*wturn4&
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+ gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)&
+ -(gs23+gs21+gsEE2)*wturn4&
+ *fac_shield(i)*fac_shield(j)&
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+ gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)&
+ -(gs32+gsE31+gsEE3)*wturn4&
+ *fac_shield(i)*fac_shield(j)&
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
+!c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
+!c & gs2
+#endif
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
'eturn4',i,j,-(s1+s2+s3)
!d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
call transpose2(EUgder(1,1,i+1),e1tder(1,1))
call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
+ s1=scalar2(b1(1,i+1),auxvec(1))
call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
s3=0.5d0*(pizda(1,1)+pizda(2,2))
gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
! peptide-group centers and side chains and its gradient in virtual-bond and
! side-chain vectors.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
+ call to_box(xi,yi,zi)
do iint=1,nscp_gr(i)
xj=c(1,j)-xi
yj=c(2,j)-yi
zj=c(3,j)-zi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
r0ij=r0_scp
r0ijsq=r0ij*r0ij
! peptide-group centers and side chains and its gradient in virtual-bond and
! side-chain vectors.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
!el local variables
- integer :: i,iint,j,k,iteli,itypj,subchap
+ integer :: i,iint,j,k,iteli,itypj,subchap,iconta
real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
e1,e2,evdwij,rij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
evdw2_14=0.0d0
!d print '(a)','Enter ESCP'
!d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
+! do i=iatscp_s,iatscp_e
+ if (nres_molec(1).eq.0) return
+ do iconta=g_listscp_start,g_listscp_end
+! print *,"icont",iconta,g_listscp_start,g_listscp_end
+ i=newcontlistscpi(iconta)
+ j=newcontlistscpj(iconta)
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)
+ call to_box(xi,yi,zi)
+! print *,itel(i),i,j
+! do iint=1,nscp_gr(i)
- do j=iscpstart(i,iint),iscpend(i,iint)
+! do j=iscpstart(i,iint),iscpend(i,iint)
itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
! Uncomment following three lines for SC-p interactions
xj=c(1,j)
yj=c(2,j)
zj=c(3,j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(1.0d0/rrij)
gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
enddo
- enddo
+! enddo
- enddo ! iint
+! enddo ! iint
enddo ! i
do i=1,nct
do j=1,3
!
! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.SBRIDGE'
! include 'COMMON.CHAIN'
! include 'COMMON.VAR'
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
- real(kind=8),dimension(3) :: ggg
+ real(kind=8),dimension(3) :: ggg,vec
!el local variables
- integer :: i,j,ii,jj,iii,jjj,k
- real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
+ integer :: i,j,ii,jj,iii,jjj,k,mnumii,mnumjj
+ real(kind=8) :: fac,eij,rdis,ehpb,dd,waga,xi,yi,zi,zj,yj,xj
ehpb=0.0D0
-!d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
-!d write(iout,*)'link_start=',link_start,' link_end=',link_end
+! write(iout,*)'edis: nhpb=',nhpb!,' fbr=',fbr
+! write(iout,*)'link_start=',link_start,' link_end=',link_end
if (link_end.eq.0) return
do i=link_start,link_end
! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
! CA-CA distance used in regularization of structure.
+
ii=ihpb(i)
jj=jhpb(i)
! iii and jjj point to the residues for which the distance is assigned.
iii=ii
jjj=jj
endif
+ do j=1,3
+ vec(j)=c(j,jj)-c(j,ii)
+ enddo
+ mnumii=molnum(iii)
+ mnumjj=molnum(jjj)
+ if (energy_dec) write(iout,*) i,ii,jj,mnumii,mnumjj,itype(jjj,mnumjj),itype(iii,mnumii)
+ if ((itype(iii,mnumii).gt.ntyp_molec(mnumii)).or.(itype(jjj,mnumjj).gt.ntyp_molec(mnumjj))) cycle
+
! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
! & dhpb(i),dhpb1(i),forcon(i)
! 24/11/03 AL: SS bridges handled separately because of introducing a specific
iabs(itype(jjj,1)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
-!d write (iout,*) "eij",eij
+! write (iout,*) "eij",eij,iii,jjj
endif
else if (ii.gt.nres .and. jj.gt.nres) then
!c Restraints from contact prediction
enddo
else
dd=dist(ii,jj)
+
if (constr_dist.eq.11) then
ehpb=ehpb+fordepth(i)**4.0d0 &
*rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
!c write (iout,*) "alph nmr",
!c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
else
+ xi=c(1,ii)
+ yi=c(2,ii)
+ zi=c(3,ii)
+ call to_box(xi,yi,zi)
+ xj=c(1,jj)
+ yj=c(2,jj)
+ zj=c(3,jj)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ vec(1)=xj
+ vec(2)=yj
+ vec(3)=zj
+ dd=sqrt(xj*xj+yj*yj+zj*zj)
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
+ if (energy_dec) write (iout,'(a6,2i5,5f10.3)') "edis",ii,jj, &
+ ehpb,dd,dhpb(i),waga,rdis
+
!c write (iout,*) "alpha reg",dd,waga*rdis*rdis
!C
!C Evaluate gradient.
endif
do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
+ ggg(j)=fac*vec(j)
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
!
! A. Liwo and U. Kozlowska, 11/24/03
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.SBRIDGE'
! include 'COMMON.CHAIN'
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
itypj=iabs(itype(j,1))
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
+akct*deltad*deltat12 &
+v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
-! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
-! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
-! & " deltat12",deltat12," eij",eij
+! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, &
+! " akct",akct," deltad",deltad," deltat",deltat1,deltat2, &
+! " deltat12",deltat12," eij",eij
ed=2*akcm*deltad+akct*deltat12
pom1=akct*deltad
pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
!
! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.LOCAL'
! include 'COMMON.GEO'
! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
do i=ibondp_start,ibondp_end
+#ifdef FIVEDIAG
+ if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) cycle
+ diff = vbld(i)-vbldp0
+#else
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)
else
diff = vbld(i)-vbldp0
endif
+#endif
if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
"estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
estr=estr+diff*diff
! angles gamma and its derivatives in consecutive thetas and gammas.
!
use comm_calcthet
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.LOCAL'
! include 'COMMON.GEO'
subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
use comm_calcthet
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.LOCAL'
! include 'COMMON.IOUNITS'
end subroutine theteng
#else
!-----------------------------------------------------------------------------
- subroutine ebend(etheta,ethetacnstr)
+ subroutine ebend(etheta)
!
! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
! angles gamma and its derivatives in consecutive thetas and gammas.
! ab initio-derived potentials from
! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.LOCAL'
! include 'COMMON.GEO'
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
! ALPHA and OMEGA.
!
use comm_sccalc
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.LOCAL'
subroutine enesc(x,escloci,dersc,ddersc,mixed)
use comm_sccalc
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.LOCAL'
subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
use comm_sccalc
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.LOCAL'
! added by Urszula Kozlowska. 07/11/2007
!
use comm_sccalc
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.LOCAL'
real(kind=8),dimension(65) :: 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
- real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
+ real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t,gradene
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
!el local variables
- integer :: i,j,k !el,it,nlobit
+ integer :: i,j,k,iti !el,it,nlobit
real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
!el real(kind=8) :: time11,time12,time112,theti
!el common /sccalc/ time11,time12,time112,theti,it,nlobit
delta=0.02d0*pi
escloc=0.0D0
do i=loc_start,loc_end
+ gscloc(:,i)=0.0d0
+ gsclocx(:,i)=0.0d0
+! th_gsclocm1(:,i-1)=0.0d0
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))
sinfac2=0.5d0/(1.0d0-costtab(i+1))
sinfac=dsqrt(sinfac2)
it=iabs(itype(i,1))
+ iti=it
+ if (iti.eq.ntyp1 .or. iti.eq.10) cycle
+!c AL 3/30/2022 handle the cases of an isolated-residue chain
+ if (i.eq.nnt .and. itype(i+1,1).eq.ntyp1) cycle
+ if (i.eq.nct .and. itype(i-1,1).eq.ntyp1) cycle
+! costtab(i+1) =dcos(theta(i+1))
if (it.eq.10) goto 1
+#ifdef SC_END
+ if (i.eq.nct .or. itype(i+1,1).eq.ntyp1) then
+!c AL 3/30/2022 handle a sidechain of a loose C-end
+ cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
+ sumene=arotam_end(0,1,iti)+&
+ tschebyshev(1,nterm_scend(1,iti),arotam_end(1,1,iti),cossc1)
+ escloc=escloc+sumene
+ gradene=gradtschebyshev(0,nterm_scend(1,iti)-1,&
+ arotam_end(1,1,iti),cossc1)
+ gscloc(:,i-1)=gscloc(:,i-1)+&
+ vbld_inv(i)*(dC_norm(:,i+nres)-dC_norm(:,i-1)&
+ *cossc1)*gradene
+ gsclocx(:,i)=gsclocx(:,i)+vbld_inv(i+nres)*&
+ (dC_norm(:,i-1)-dC_norm(:,i+nres)*cossc1)*gradene
+#ifdef ENERGY_DEC
+ if (energy_dec) write (2,'(2hC ,a3,i6,2(a,f10.5))')&
+ restyp(iti,1),i," angle",rad2deg*dacos(cossc1)," escloc",sumene
+#endif
+ else if (i.eq.nnt .or. itype(i-1,1).eq.ntyp1) then
+!c AL 3/30/2022 handle a sidechain of a loose N-end
+ cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
+ sumene=arotam_end(0,2,iti)+&
+ tschebyshev(1,nterm_scend(2,iti),arotam_end(1,2,iti),cossc)
+ escloc=escloc+sumene
+ gradene=gradtschebyshev(0,nterm_scend(2,iti)-1,&
+ arotam_end(1,2,iti),cossc)
+ gscloc(:,i)=gscloc(:,i)+&
+ vbld_inv(i+1)*(dC_norm(:,i+nres)-dC_norm(:,i)&
+ *cossc)*gradene
+ gsclocx(:,i)=gsclocx(:,i)+vbld_inv(i+nres)*&
+ (dC_norm(:,i)-dC_norm(:,i+nres)*cossc)*gradene
+#ifdef ENERGY_DEC
+ if (energy_dec) write (2,'(2hN ,a3,i6,2(a,f10.5))')
+ & restyp(iti),i," angle",rad2deg*dacos(cossc)," escloc",sumene
+#endif
+ else
+#endif
!
! Compute the axes of tghe local cartesian coordinates system; store in
! x_prime, y_prime and z_prime
! & dscp1,dscp2,sumene
! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
+ if (energy_dec) write (2,*) "i",i," itype",itype(i,1)," it",it, &
+ " escloc",sumene,escloc,it,itype(i,1)
! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
! & ,zz,xx,yy
!#define DEBUG
! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
! to check gradient call subroutine check_grad
-
+#ifdef SC_END
+ endif
+#endif
1 continue
enddo
return
end subroutine gcont
!-----------------------------------------------------------------------------
subroutine splinthet(theti,delta,ss,ssder)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
#ifdef CRYST_TOR
!-----------------------------------------------------------------------------
subroutine etor(etors,edihcnstr)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
etors_d=0.0d0
return
end subroutine etor_d
+!-----------------------------------------------------------------------------
+!c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
+ subroutine e_modeller(ehomology_constr)
+ real(kind=8) :: ehomology_constr
+ ehomology_constr=0.0d0
+ write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
+ return
+ end subroutine e_modeller
+C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
#else
!-----------------------------------------------------------------------------
- subroutine etor(etors,edihcnstr)
-! implicit real*8 (a-h,o-z)
+ subroutine etor(etors)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
-! do i=1,ndih_constr
+ return
+ end subroutine etor
+!C The rigorous attempt to derive energy function
+!-------------------------------------------------------------------------------------------
+ subroutine etor_kcc(etors)
+ double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
+ real(kind=8) :: etors,glocig,glocit1,glocit2,sinthet1,&
+ sinthet2,costhet1,costhet2,sint1t2,sint1t2n,phii,sinphi,cosphi,&
+ sint1t2n1,sumvalc,gradvalct1,gradvalct2,sumvals,gradvalst1,&
+ gradvalst2,etori
+ logical lprn
+ integer :: i,j,itori,itori1,nval,k,l
+! lprn=.true.
+ if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
+ etors=0.0D0
+ do i=iphi_start,iphi_end
+!C ANY TWO ARE DUMMY ATOMS in row CYCLE
+!c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
+!c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
+!c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
+ if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
+ .or. itype(i,1).eq.ntyp1 .or. itype(i-3,1).eq.ntyp1) cycle
+ itori=itortyp(itype(i-2,1))
+ itori1=itortyp(itype(i-1,1))
+ phii=phi(i)
+ glocig=0.0D0
+ glocit1=0.0d0
+ glocit2=0.0d0
+!C to avoid multiple devision by 2
+!c theti22=0.5d0*theta(i)
+!C theta 12 is the theta_1 /2
+!C theta 22 is theta_2 /2
+!c theti12=0.5d0*theta(i-1)
+!C and appropriate sinus function
+ sinthet1=dsin(theta(i-1))
+ sinthet2=dsin(theta(i))
+ costhet1=dcos(theta(i-1))
+ costhet2=dcos(theta(i))
+!C to speed up lets store its mutliplication
+ sint1t2=sinthet2*sinthet1
+ sint1t2n=1.0d0
+!C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
+!C +d_n*sin(n*gamma)) *
+!C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
+!C we have two sum 1) Non-Chebyshev which is with n and gamma
+ nval=nterm_kcc_Tb(itori,itori1)
+ c1(0)=0.0d0
+ c2(0)=0.0d0
+ c1(1)=1.0d0
+ c2(1)=1.0d0
+ do j=2,nval
+ c1(j)=c1(j-1)*costhet1
+ c2(j)=c2(j-1)*costhet2
+ enddo
+ etori=0.0d0
+
+ do j=1,nterm_kcc(itori,itori1)
+ cosphi=dcos(j*phii)
+ sinphi=dsin(j*phii)
+ sint1t2n1=sint1t2n
+ sint1t2n=sint1t2n*sint1t2
+ sumvalc=0.0d0
+ gradvalct1=0.0d0
+ gradvalct2=0.0d0
+ do k=1,nval
+ do l=1,nval
+ sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
+ gradvalct1=gradvalct1+ &
+ (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
+ gradvalct2=gradvalct2+ &
+ (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
+ enddo
+ enddo
+ gradvalct1=-gradvalct1*sinthet1
+ gradvalct2=-gradvalct2*sinthet2
+ sumvals=0.0d0
+ gradvalst1=0.0d0
+ gradvalst2=0.0d0
+ do k=1,nval
+ do l=1,nval
+ sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
+ gradvalst1=gradvalst1+ &
+ (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
+ gradvalst2=gradvalst2+ &
+ (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
+ enddo
+ enddo
+ gradvalst1=-gradvalst1*sinthet1
+ gradvalst2=-gradvalst2*sinthet2
+ if (lprn) write (iout,*)j,"sumvalc",sumvalc," sumvals",sumvals
+ etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
+!C glocig is the gradient local i site in gamma
+ glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
+!C now gradient over theta_1
+ glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)&
+ +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
+ glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)&
+ +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
+ enddo ! j
+ etors=etors+etori
+ gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
+!C derivative over theta1
+ gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
+!C now derivative over theta2
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
+ if (lprn) then
+ write (iout,*) i-2,i-1,itype(i-2,1),itype(i-1,1),itori,itori1,&
+ theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
+ write (iout,*) "c1",(c1(k),k=0,nval), &
+ " c2",(c2(k),k=0,nval)
+ endif
+ enddo
+ return
+ end subroutine etor_kcc
+!------------------------------------------------------------------------------
+
+ subroutine etor_constr(edihcnstr)
+ real(kind=8) :: etors,edihcnstr
+ logical :: lprn
+!el local variables
+ integer :: i,j,iblock,itori,itori1
+ real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
+ vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom,&
+ gaudih_i,gauder_i,s,cos_i,dexpcos_i
+
+ if (raw_psipred) then
+ do i=idihconstr_start,idihconstr_end
+ itori=idih_constr(i)
+ phii=phi(itori)
+ gaudih_i=vpsipred(1,i)
+ gauder_i=0.0d0
+ do j=1,2
+ s = sdihed(j,i)
+ cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
+ dexpcos_i=dexp(-cos_i*cos_i)
+ gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
+ gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) &
+ *cos_i*dexpcos_i/s**2
+ enddo
+ edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
+ gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
+ if (energy_dec) &
+ write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') &
+ i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),&
+ phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),&
+ phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,&
+ -wdihc*dlog(gaudih_i)
+ enddo
+ else
+
do i=idihconstr_start,idihconstr_end
itori=idih_constr(i)
phii=phi(itori)
else
difi=0.0
endif
-!d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
-!d & rad2deg*phi0(i), rad2deg*drange(i),
-!d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
enddo
-!d write (iout,*) 'edihcnstr',edihcnstr
+
+ endif
+
return
- end subroutine etor
+
+ end subroutine etor_constr
!-----------------------------------------------------------------------------
subroutine etor_d(etors_d)
! 6/23/01 Compute double torsional energy
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
return
end subroutine etor_d
#endif
-!-----------------------------------------------------------------------------
- subroutine eback_sc_corr(esccor)
-! 7/21/2007 Correlations between the backbone-local and side-chain-local
-! conformational states; temporarily implemented as differences
-! between UNRES torsional potentials (dependent on three types of
-! residues) and the torsional potentials dependent on all 20 types
-! of residues computed from AM1 energy surfaces of terminally-blocked
-! amino-acid residues.
-! implicit real*8 (a-h,o-z)
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+ subroutine e_modeller(ehomology_constr)
+! implicit none
! include 'DIMENSIONS'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
-! include 'COMMON.TORSION'
-! include 'COMMON.SCCOR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.DERIV'
-! include 'COMMON.CHAIN'
-! include 'COMMON.NAMES'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.CONTROL'
- real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
- cosphi,sinphi
- logical :: lprn
- integer :: i,interty,j,isccori,isccori1,intertyp
-! Set lprn=.true. for debugging
- lprn=.false.
-! lprn=.true.
-! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
- esccor=0.0D0
- do i=itau_start,itau_end
- if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
- esccor_ii=0.0D0
- isccori=isccortyp(itype(i-2,1))
- isccori1=isccortyp(itype(i-1,1))
+ use MD_data, only: iset
+ real(kind=8) :: ehomology_constr
+ integer nnn,i,ii,j,k,ijk,jik,ki,kk,nexl,irec,l
+ integer katy, odleglosci, test7
+ real(kind=8) :: odleg, odleg2, odleg3, kat, kat2, kat3
+ real(kind=8) :: Eval,Erot,min_odl
+ real(kind=8),dimension(constr_homology) :: distance,distancek,godl,dih_diff,gdih, &
+ gtheta,dscdiff, &
+ uscdiffk,guscdiff2,guscdiff3,&
+ theta_diff
+
+
+!
+! FP - 30/10/2014 Temporary specifications for homology restraints
+!
+ real(kind=8) :: utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,&
+ sgtheta
+ real(kind=8), dimension (nres) :: guscdiff,usc_diff
+ real(kind=8) :: sum_godl,sgodl,grad_odl3,ggodl,sum_gdih,&
+ sum_guscdiff,sum_sgdih,sgdih,grad_dih3,usc_diff_i,dxx,dyy,dzz,&
+ betai,sum_sgodl,dij,max_template
+! real(kind=8) :: dist,pinorm
+!
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.CHAIN'
+! include 'COMMON.GEO'
+! include 'COMMON.DERIV'
+! include 'COMMON.LOCAL'
+! include 'COMMON.INTERACT'
+! include 'COMMON.VAR'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.MD'
+! include 'COMMON.CONTROL'
+! include 'COMMON.HOMOLOGY'
+! include 'COMMON.QRESTR'
+!
+! From subroutine Econstr_back
+!
+! include 'COMMON.NAMES'
+! include 'COMMON.TIME1'
+!
-! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
- phii=phi(i)
- do intertyp=1,3 !intertyp
- esccor_ii=0.0D0
-!c Added 09 May 2012 (Adasko)
-!c Intertyp means interaction type of backbone mainchain correlation:
-! 1 = SC...Ca...Ca...Ca
-! 2 = Ca...Ca...Ca...SC
-! 3 = SC...Ca...Ca...SCi
- gloci=0.0D0
- if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
- (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
- (itype(i-1,1).eq.ntyp1))) &
- .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
- .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
- .or.(itype(i,1).eq.ntyp1))) &
- .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
- (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
- (itype(i-3,1).eq.ntyp1)))) cycle
- if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
- if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
- cycle
- do j=1,nterm_sccor(isccori,isccori1)
- v1ij=v1sccor(j,intertyp,isccori,isccori1)
- v2ij=v2sccor(j,intertyp,isccori,isccori1)
- cosphi=dcos(j*tauangle(intertyp,i))
- sinphi=dsin(j*tauangle(intertyp,i))
- if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
- esccor=esccor+v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
- 'esccor',i,intertyp,esccor_ii
-! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
- gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
- if (lprn) &
- write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
- restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
- (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
- (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
- gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
- enddo !intertyp
+
+ do i=1,max_template
+ distancek(i)=9999999.9
enddo
- return
- end subroutine eback_sc_corr
-!-----------------------------------------------------------------------------
- subroutine multibody(ecorr)
-! This subroutine calculates multi-body contributions to energy following
-! the idea of Skolnick et al. If side chains I and J make a contact and
-! at the same time side chains I+1 and J+1 make a contact, an extra
-! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
- real(kind=8),dimension(3) :: gx,gx1
- logical :: lprn
- real(kind=8) :: ecorr
- integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
-! Set lprn=.true. for debugging
- lprn=.false.
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(i2,20(1x,i2,f10.5))') &
- i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
- enddo
- endif
- ecorr=0.0D0
+ odleg=0.0d0
-! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
-! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
- do i=nnt,nct-2
+! Pseudo-energy and gradient from homology restraints (MODELLER-like
+! function)
+! AL 5/2/14 - Introduce list of restraints
+! write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs start -------"
+#endif
+ do ii = link_start_homo,link_end_homo
+ i = ires_homo(ii)
+ j = jres_homo(ii)
+ dij=dist(i,j)
+! write (iout,*) "dij(",i,j,") =",dij
+ nexl=0
+ do k=1,constr_homology
+! write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
+ if(.not.l_homo(k,ii)) then
+ nexl=nexl+1
+ cycle
+ endif
+ distance(k)=odl(k,ii)-dij
+! write (iout,*) "distance(",k,") =",distance(k)
+!
+! For Gaussian-type Urestr
+!
+ distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
+! write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
+! write (iout,*) "distancek(",k,") =",distancek(k)
+! distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
+!
+! For Lorentzian-type Urestr
+!
+ if (waga_dist.lt.0.0d0) then
+ sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
+ distancek(k)=distance(k)**2/(sigma_odlir(k,ii)* &
+ (distance(k)**2+sigma_odlir(k,ii)**2))
+ endif
+ enddo
- DO ISHIFT = 3,4
+! min_odl=minval(distancek)
+ if (nexl.gt.0) then
+ min_odl=0.0d0
+ else
+ do kk=1,constr_homology
+ if(l_homo(kk,ii)) then
+ min_odl=distancek(kk)
+ exit
+ endif
+ enddo
+ do kk=1,constr_homology
+ if (l_homo(kk,ii) .and. distancek(kk).lt.min_odl) &
+ min_odl=distancek(kk)
+ enddo
+ endif
- i1=i+ishift
- num_conti=num_cont(i)
- num_conti1=num_cont(i1)
- do jj=1,num_conti
- j=jcont(jj,i)
- do kk=1,num_conti1
- j1=jcont(kk,i1)
- if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
-!d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-!d & ' ishift=',ishift
-! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
-! The system gains extra energy.
- ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
- endif ! j1==j+-ishift
- enddo ! kk
- enddo ! jj
+! write (iout,* )"min_odl",min_odl
+#ifdef DEBUG
+ write (iout,*) "ij dij",i,j,dij
+ write (iout,*) "distance",(distance(k),k=1,constr_homology)
+ write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
+ write (iout,* )"min_odl",min_odl
+#endif
+#ifdef OLDRESTR
+ odleg2=0.0d0
+#else
+ if (waga_dist.ge.0.0d0) then
+ odleg2=nexl
+ else
+ odleg2=0.0d0
+ endif
+#endif
+ do k=1,constr_homology
+! Nie wiem po co to liczycie jeszcze raz!
+! odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
+! & (2*(sigma_odl(i,j,k))**2))
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ godl(k)=dexp(-distancek(k)+min_odl)
+ odleg2=odleg2+godl(k)
+!
+! For Lorentzian-type Urestr
+!
+ else
+ odleg2=odleg2+distancek(k)
+ endif
- ENDDO ! ISHIFT
+!cc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
+!cc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
+!cc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
+!cc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
- enddo ! i
- return
- end subroutine multibody
-!-----------------------------------------------------------------------------
- real(kind=8) function esccorr(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
- real(kind=8),dimension(3) :: gx,gx1
- logical :: lprn
- integer :: i,j,k,l,jj,kk,m,ll
- real(kind=8) :: eij,ekl
- lprn=.false.
- eij=facont(jj,i)
- ekl=facont(kk,k)
-!d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
-! Calculate the multi-body contribution to energy.
-! Calculate multi-body contributions to the gradient.
-!d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
-!d & k,l,(gacont(m,kk,k),m=1,3)
- do m=1,3
- gx(m) =ekl*gacont(m,jj,i)
- gx1(m)=eij*gacont(m,kk,k)
- gradxorr(m,i)=gradxorr(m,i)-gx(m)
- gradxorr(m,j)=gradxorr(m,j)+gx(m)
- gradxorr(m,k)=gradxorr(m,k)-gx1(m)
- gradxorr(m,l)=gradxorr(m,l)+gx1(m)
+ enddo
+! write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+! write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
+ write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
+#endif
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
+!
+! For Lorentzian-type Urestr
+!
+ else
+ odleg=odleg+odleg2/constr_homology
+ endif
+!
+! write (iout,*) "odleg",odleg ! sum of -ln-s
+! Gradient
+!
+! For Gaussian-type Urestr
+!
+ if (waga_dist.ge.0.0d0) sum_godl=odleg2
+ sum_sgodl=0.0d0
+ do k=1,constr_homology
+! godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+! & *waga_dist)+min_odl
+! sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
+!
+ if(.not.l_homo(k,ii)) cycle
+ if (waga_dist.ge.0.0d0) then
+! For Gaussian-type Urestr
+!
+ sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
+!
+! For Lorentzian-type Urestr
+!
+ else
+ sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+ &
+ sigma_odlir(k,ii)**2)**2)
+ endif
+ sum_sgodl=sum_sgodl+sgodl
+
+! sgodl2=sgodl2+sgodl
+! write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
+! write(iout,*) "constr_homology=",constr_homology
+! write(iout,*) i, j, k, "TEST K"
+ enddo
+! print *, "ok",iset
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ grad_odl3=waga_homology(iset)*waga_dist &
+ *sum_sgodl/(sum_godl*dij)
+! print *, "ok"
+!
+! For Lorentzian-type Urestr
+!
+ else
+! Original grad expr modified by analogy w Gaussian-type Urestr grad
+! grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
+ grad_odl3=-waga_homology(iset)*waga_dist* &
+ sum_sgodl/(constr_homology*dij)
+! print *, "ok2"
+ endif
+!
+! grad_odl3=sum_sgodl/(sum_godl*dij)
+
+
+! write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
+! write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
+! & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
+
+!cc write(iout,*) godl, sgodl, grad_odl3
+
+! grad_odl=grad_odl+grad_odl3
+
+ do jik=1,3
+ ggodl=grad_odl3*(c(jik,i)-c(jik,j))
+!cc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
+!cc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
+!cc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+ ghpbc(jik,i)=ghpbc(jik,i)+ggodl
+ ghpbc(jik,j)=ghpbc(jik,j)-ggodl
+!cc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
+!cc & ghpbc(jik,i+1), ghpbc(jik,j+1)
+! if (i.eq.25.and.j.eq.27) then
+! write(iout,*) "jik",jik,"i",i,"j",j
+! write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
+! write(iout,*) "grad_odl3",grad_odl3
+! write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
+! write(iout,*) "ggodl",ggodl
+! write(iout,*) "ghpbc(",jik,i,")",
+! & ghpbc(jik,i),"ghpbc(",jik,j,")",
+! & ghpbc(jik,j)
+! endif
+ enddo
+!cc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
+!cc & dLOG(odleg2),"-odleg=", -odleg
+
+ enddo ! ii-loop for dist
+#ifdef DEBUG
+ write(iout,*) "------- dist restrs end -------"
+! if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
+! & waga_d.eq.1.0d0) call sum_gradient
+#endif
+! Pseudo-energy and gradient from dihedral-angle restraints from
+! homology templates
+! write (iout,*) "End of distance loop"
+! call flush(iout)
+ kat=0.0d0
+! write (iout,*) idihconstr_start_homo,idihconstr_end_homo
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs start -------"
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
enddo
- do m=i,j-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
- enddo
+#endif
+ do i=idihconstr_start_homo,idihconstr_end_homo
+ kat2=0.0d0
+! betai=beta(i,i+1,i+2,i+3)
+ betai = phi(i)
+! write (iout,*) "betai =",betai
+ do k=1,constr_homology
+ dih_diff(k)=pinorm(dih(k,i)-betai)
+!d write (iout,'(a8,2i4,2f15.8)') "dih_diff",i,k,dih_diff(k)
+!d & ,sigma_dih(k,i)
+! if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
+! & -(6.28318-dih_diff(i,k))
+! if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
+! & 6.28318+dih_diff(i,k)
+#ifdef OLD_DIHED
+ kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+#else
+ kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+#endif
+! kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
+ gdih(k)=dexp(kat3)
+ kat2=kat2+gdih(k)
+! write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
+! write(*,*)""
+ enddo
+! write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
+! write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "i",i," betai",betai," kat2",kat2
+ write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
+#endif
+ if (kat2.le.1.0d-14) cycle
+ kat=kat-dLOG(kat2/constr_homology)
+! write (iout,*) "kat",kat ! sum of -ln-s
+
+!cc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
+!cc & dLOG(kat2), "-kat=", -kat
+
+! ----------------------------------------------------------------------
+! Gradient
+! ----------------------------------------------------------------------
+
+ sum_gdih=kat2
+ sum_sgdih=0.0d0
+ do k=1,constr_homology
+#ifdef OLD_DIHED
+ sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
+#else
+ sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd
+#endif
+! sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
+ sum_sgdih=sum_sgdih+sgdih
+ enddo
+! grad_dih3=sum_sgdih/sum_gdih
+ grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
+! print *, "ok3"
+
+! write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
+!cc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
+!cc & gloc(nphi+i-3,icg)
+ gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
+! if (i.eq.25) then
+! write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
+! endif
+!cc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
+!cc & gloc(nphi+i-3,icg)
+
+ enddo ! i-loop for dih
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs end -------"
+#endif
+
+! Pseudo-energy and gradient for theta angle restraints from
+! homology templates
+! FP 01/15 - inserted from econstr_local_test.F, loop structure
+! adapted
+
+!
+! For constr_homology reference structures (FP)
+!
+! Uconst_back_tot=0.0d0
+ Eval=0.0d0
+ Erot=0.0d0
+! Econstr_back legacy
+ do i=1,nres
+! do i=ithet_start,ithet_end
+ dutheta(i)=0.0d0
enddo
- do m=k,l-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
+! do i=loc_start,loc_end
+ do i=-1,nres
+ do j=1,3
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
enddo
- enddo
- esccorr=-eij*ekl
- return
- end function esccorr
-!-----------------------------------------------------------------------------
- subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
-! This subroutine calculates multi-body contributions to hydrogen-bonding
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-#ifdef MPI
- include "mpif.h"
-! integer :: maxconts !max_cont=maxconts =nres/4
- integer,parameter :: max_dim=26
- integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
-!el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
-!el common /przechowalnia/ zapas
- integer :: status(MPI_STATUS_SIZE)
- integer,dimension((nres/4)*2) :: req !maxconts*2
- integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
+ enddo
+!
+! do iref=1,nref
+! write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
+! write (iout,*) "waga_theta",waga_theta
+ if (waga_theta.gt.0.0d0) then
+#ifdef DEBUG
+ write (iout,*) "usampl",usampl
+ write(iout,*) "------- theta restrs start -------"
+! do i=ithet_start,ithet_end
+! write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
+! enddo
#endif
-! include 'COMMON.SETUP'
-! include 'COMMON.FFIELD'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.CONTROL'
-! include 'COMMON.LOCAL'
- real(kind=8),dimension(3) :: gx,gx1
- real(kind=8) :: time00,ecorr,ecorr5,ecorr6
- logical :: lprn,ldone
-!el local variables
- integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
- jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
+! write (iout,*) "maxres",maxres,"nres",nres
-! Set lprn=.true. for debugging
- lprn=.false.
-#ifdef MPI
-! maxconts=nres/4
- if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
- n_corr=0
- n_corr1=0
- if (nfgtasks.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values before RECEIVE:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
- j=1,num_cont_hb(i))
+ do i=ithet_start,ithet_end
+!
+! do i=1,nfrag_back
+! ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
+!
+! Deviation of theta angles wrt constr_homology ref structures
+!
+ utheta_i=0.0d0 ! argument of Gaussian for single k
+ gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+! do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
+! over residues in a fragment
+! write (iout,*) "theta(",i,")=",theta(i)
+ do k=1,constr_homology
+!
+! dtheta_i=theta(j)-thetaref(j,iref)
+! dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
+ theta_diff(k)=thetatpl(k,i)-theta(i)
+!d write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k)
+!d & ,sigma_theta(k,i)
+
+!
+ utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
+! utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
+ gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
+ gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk)
+! Gradient for single Gaussian restraint in subr Econstr_back
+! dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
+!
+ enddo
+! write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
+! write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
+
+!
+! Gradient for multiple Gaussian restraint
+ sum_gtheta=gutheta_i
+ sum_sgtheta=0.0d0
+ do k=1,constr_homology
+! New generalized expr for multiple Gaussian from Econstr_back
+ sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
+!
+! sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
+ sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
enddo
+! Final value of gradient using same var as in Econstr_back
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg) &
+ +sum_sgtheta/sum_gtheta*waga_theta &
+ *waga_homology(iset)
+! print *, "ok4"
+
+! dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
+! & *waga_homology(iset)
+! dutheta(i)=sum_sgtheta/sum_gtheta
+!
+! Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
+ Eval=Eval-dLOG(gutheta_i/constr_homology)
+! write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
+! write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
+! Uconst_back=Uconst_back+utheta(i)
+ enddo ! (i-loop for theta)
+#ifdef DEBUG
+ write(iout,*) "------- theta restrs end -------"
+#endif
endif
- call flush(iout)
- do i=1,ntask_cont_from
- ncont_recv(i)=0
- enddo
- do i=1,ntask_cont_to
- ncont_sent(i)=0
- enddo
-! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
-! & ntask_cont_to
-! Make the list of contacts to send to send to other procesors
-! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
-! call flush(iout)
- do i=iturn3_start,iturn3_end
-! write (iout,*) "make contact list turn3",i," num_cont",
-! & num_cont_hb(i)
- call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
- enddo
- do i=iturn4_start,iturn4_end
-! write (iout,*) "make contact list turn4",i," num_cont",
-! & num_cont_hb(i)
- call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
+!
+! Deviation of local SC geometry
+!
+! Separation of two i-loops (instructed by AL - 11/3/2014)
+!
+! write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
+! write (iout,*) "waga_d",waga_d
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs start -------"
+ write (iout,*) "Initial duscdiff,duscdiffx"
+ do i=loc_start,loc_end
+ write (iout,*) i,(duscdiff(jik,i),jik=1,3), &
+ (duscdiffx(jik,i),jik=1,3)
enddo
- do ii=1,nat_sent
- i=iat_sent(ii)
-! write (iout,*) "make contact list longrange",i,ii," num_cont",
-! & num_cont_hb(i)
- do j=1,num_cont_hb(i)
- do k=1,4
- jjc=jcont_hb(j,i)
- iproc=iint_sent_local(k,jjc,ii)
-! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.gt.0) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=i
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,i)
- zapas(4,nn,iproc)=ees0p(j,i)
- zapas(5,nn,iproc)=ees0m(j,i)
- zapas(6,nn,iproc)=gacont_hbr(1,j,i)
- zapas(7,nn,iproc)=gacont_hbr(2,j,i)
- zapas(8,nn,iproc)=gacont_hbr(3,j,i)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
- endif
- enddo
+#endif
+ do i=loc_start,loc_end
+ usc_diff_i=0.0d0 ! argument of Gaussian for single k
+ guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+! do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
+! write(iout,*) "xxtab, yytab, zztab"
+! write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
+ do k=1,constr_homology
+!
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+! Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+! write(iout,*) "dxx, dyy, dzz"
+!d write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i)
+!
+ usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
+! usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
+! uscdiffk(k)=usc_diff(i)
+ guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
+! write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i),
+! & " guscdiff2",guscdiff2(k)
+ guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk)
+! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
+! & xxref(j),yyref(j),zzref(j)
enddo
- enddo
- if (lprn) then
- write (iout,*) &
- "Numbers of contacts to be sent to other processors",&
- (ncont_sent(i),i=1,ntask_cont_to)
- write (iout,*) "Contacts sent"
- do ii=1,ntask_cont_to
- nn=ncont_sent(ii)
- iproc=itask_cont_to(ii)
- write (iout,*) nn," contacts to processor",iproc,&
- " of CONT_TO_COMM group"
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
+!
+! Gradient
+!
+! Generalized expression for multiple Gaussian acc to that for a single
+! Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
+!
+! Original implementation
+! sum_guscdiff=guscdiff(i)
+!
+! sum_sguscdiff=0.0d0
+! do k=1,constr_homology
+! sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
+! sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
+! sum_sguscdiff=sum_sguscdiff+sguscdiff
+! enddo
+!
+! Implementation of new expressions for gradient (Jan. 2015)
+!
+! grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
+ do k=1,constr_homology
+!
+! New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
+! before. Now the drivatives should be correct
+!
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+! Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+ sum_guscdiff=guscdiff2(k)* &!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
+ sigma_d(k,i) ! for the grad wrt r'
+! sum_sguscdiff=sum_sguscdiff+sum_guscdiff
+
+!
+! New implementation
+ sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
+ do jik=1,3
+ duscdiff(jik,i-1)=duscdiff(jik,i-1)+ &
+ sum_guscdiff*(dXX_C1tab(jik,i)*dxx+ &
+ dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
+ duscdiff(jik,i)=duscdiff(jik,i)+ &
+ sum_guscdiff*(dXX_Ctab(jik,i)*dxx+ &
+ dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
+ duscdiffx(jik,i)=duscdiffx(jik,i)+ &
+ sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+ &
+ dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
+! print *, "ok5"
+!
+#ifdef DEBUG
+! write(iout,*) "jik",jik,"i",i
+ write(iout,*) "dxx, dyy, dzz"
+ write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
+ write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
+ write(iout,*) "sum_sguscdiff",sum_guscdiff,waga_homology(iset),waga_d
+ write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
+ write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
+ write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
+ write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
+ write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
+ write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
+ write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
+ write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
+ write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
+ write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
+ write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
+ write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
+! endif
+#endif
+ enddo
enddo
+! print *, "ok6"
+!
+! uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
+! usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
+!
+! write (iout,*) i," uscdiff",uscdiff(i)
+!
+! Put together deviations from local geometry
+
+! Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
+! & wfrag_back(3,i,iset)*uscdiff(i)
+ Erot=Erot-dLOG(guscdiff(i)/constr_homology)
+! write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
+! write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
+! Uconst_back=Uconst_back+usc_diff(i)
+!
+! Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
+!
+! New implment: multiplied by sum_sguscdiff
+!
+
+ enddo ! (i-loop for dscdiff)
+
+! endif
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs end -------"
+ write (iout,*) "------ After SC loop in e_modeller ------"
+ do i=loc_start,loc_end
+ write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
+ write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
+ enddo
+ if (waga_theta.eq.1.0d0) then
+ write (iout,*) "in e_modeller after SC restr end: dutheta"
+ do i=ithet_start,ithet_end
+ write (iout,*) i,dutheta(i)
enddo
- call flush(iout)
endif
- CorrelType=477
- CorrelID=fg_rank+1
- CorrelType1=478
- CorrelID1=nfgtasks+fg_rank+1
- ireq=0
-! Receive the numbers of needed contacts from other processors
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- ireq=ireq+1
- call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
- FG_COMM,req(ireq),IERR)
- enddo
-! write (iout,*) "IRECV ended"
-! call flush(iout)
-! Send the number of contacts needed by other processors
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- ireq=ireq+1
- call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
- FG_COMM,req(ireq),IERR)
- enddo
-! write (iout,*) "ISEND ended"
-! write (iout,*) "number of requests (nn)",ireq
- call flush(iout)
- if (ireq.gt.0) &
- call MPI_Waitall(ireq,req,status_array,ierr)
-! write (iout,*)
-! & "Numbers of contacts to be received from other processors",
-! & (ncont_recv(i),i=1,ntask_cont_from)
-! call flush(iout)
-! Receive contacts
- ireq=0
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- nn=ncont_recv(ii)
-! write (iout,*) "Receiving",nn," contacts from processor",iproc,
-! & " of CONT_TO_COMM group"
- call flush(iout)
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
- MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-! write (iout,*) "ireq,req",ireq,req(ireq)
- endif
- enddo
-! Send the contacts to processors that need them
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- nn=ncont_sent(ii)
-! write (iout,*) nn," contacts to processor",iproc,
-! & " of CONT_TO_COMM group"
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
- iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-! write (iout,*) "ireq,req",ireq,req(ireq)
-! do i=1,nn
-! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
-! enddo
- endif
- enddo
-! write (iout,*) "number of requests (contacts)",ireq
-! write (iout,*) "req",(req(i),i=1,4)
-! call flush(iout)
- if (ireq.gt.0) &
- call MPI_Waitall(ireq,req,status_array,ierr)
- do iii=1,ntask_cont_from
- iproc=itask_cont_from(iii)
- nn=ncont_recv(iii)
- if (lprn) then
- write (iout,*) "Received",nn," contacts from processor",iproc,&
- " of CONT_FROM_COMM group"
- call flush(iout)
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
- enddo
- call flush(iout)
- endif
- do i=1,nn
- ii=zapas_recv(1,i,iii)
-! Flag the received contacts to prevent double-counting
- jj=-zapas_recv(2,i,iii)
-! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
-! call flush(iout)
- nnn=num_cont_hb(ii)+1
- num_cont_hb(ii)=nnn
- jcont_hb(nnn,ii)=jj
- facont_hb(nnn,ii)=zapas_recv(3,i,iii)
- ees0p(nnn,ii)=zapas_recv(4,i,iii)
- ees0m(nnn,ii)=zapas_recv(5,i,iii)
- gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
- gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
- gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
- gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
- gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
- gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
- gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
- gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
- gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
- gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
- gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
- gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
- gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
- gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
- gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
- gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
- gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
- gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
- gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
- gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
- gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
- enddo
+ if (waga_d.eq.1.0d0) then
+ write (iout,*) "e_modeller after SC loop: duscdiff/x"
+ do i=1,nres
+ write (iout,*) i,(duscdiff(j,i),j=1,3)
+ write (iout,*) i,(duscdiffx(j,i),j=1,3)
enddo
- call flush(iout)
- if (lprn) then
- write (iout,'(a)') 'Contact function values after receive:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
- j=1,num_cont_hb(i))
- enddo
- call flush(iout)
endif
- 30 continue
#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
- j=1,num_cont_hb(i))
- enddo
+
+! Total energy from homology restraints
+#ifdef DEBUG
+ write (iout,*) "odleg",odleg," kat",kat
+#endif
+!
+! Addition of energy of theta angle and SC local geom over constr_homologs ref strs
+!
+! ehomology_constr=odleg+kat
+!
+! For Lorentzian-type Urestr
+!
+
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ ehomology_constr=(waga_dist*odleg+waga_angle*kat+ &
+ waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+! write (iout,*) "ehomology_constr=",ehomology_constr
+! print *, "ok7"
+ else
+!
+! For Lorentzian-type Urestr
+!
+ ehomology_constr=(-waga_dist*odleg+waga_angle*kat+ &
+ waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+! write (iout,*) "ehomology_constr=",ehomology_constr
+ print *, "ok8"
endif
- ecorr=0.0D0
+#ifdef DEBUG
+ write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat, &
+ "Eval",waga_theta,eval, &
+ "Erot",waga_d,Erot
+ write (iout,*) "ehomology_constr",ehomology_constr
+#endif
+ return
+!
+! FP 01/15 end
+!
+ 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
+ 747 format(a12,i4,i4,i4,f8.3,f8.3)
+ 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
+ 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
+ 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, &
+ f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
+ end subroutine e_modeller
-! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
-! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
-! Remove the loop below after debugging !!!
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
+!----------------------------------------------------------------------------
+ subroutine ebend_kcc(etheta)
+ logical lprn
+ double precision thybt1(maxang_kcc),etheta
+ integer :: i,iti,j,ihelp
+ real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1
+!C Set lprn=.true. for debugging
+ lprn=energy_dec
+!c lprn=.true.
+!C print *,"wchodze kcc"
+ if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
+ etheta=0.0D0
+ do i=ithet_start,ithet_end
+!c print *,i,itype(i-1),itype(i),itype(i-2)
+ if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 &
+ .or.itype(i,1).eq.ntyp1) cycle
+ iti=iabs(itortyp(itype(i-1,1)))
+ sinthet=dsin(theta(i))
+ costhet=dcos(theta(i))
+ do j=1,nbend_kcc_Tb(iti)
+ thybt1(j)=v1bend_chyb(j,iti)
+ enddo
+ sumth1thyb=v1bend_chyb(0,iti)+ &
+ tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
+ if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,&
+ sumth1thyb
+ ihelp=nbend_kcc_Tb(iti)-1
+ gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
+ etheta=etheta+sumth1thyb
+!C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
enddo
-! Calculate the local-electrostatic correlation terms
- do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- jp=iabs(j)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
- jp1=iabs(j1)
-! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
-! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
- if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
- .or. j.lt.0 .and. j1.gt.0) .and. &
- (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
-! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
-! The system gains extra energy.
- ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
-! Contacts I-J and I-(J+1) occur simultaneously.
-! The system loses extra energy.
-! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
-! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-! & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
-! Contacts I-J and (I+1)-J occur simultaneously.
-! The system loses extra energy.
-! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
- enddo ! i
return
- end subroutine multibody_hb
-!-----------------------------------------------------------------------------
- subroutine add_hb_contact(ii,jj,itask)
-! implicit real*8 (a-h,o-z)
-! include "DIMENSIONS"
-! include "COMMON.IOUNITS"
-! include "COMMON.CONTACTS"
-! integer,parameter :: maxconts=nres/4
- integer,parameter :: max_dim=26
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
-! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
-! common /przechowalnia/ zapas
- integer :: i,j,ii,jj,iproc,nn,jjc
- integer,dimension(4) :: itask
-! write (iout,*) "itask",itask
- do i=1,2
- iproc=itask(i)
- if (iproc.gt.0) then
- do j=1,num_cont_hb(ii)
- jjc=jcont_hb(j,ii)
-! write (iout,*) "i",ii," j",jj," jjc",jjc
- if (jjc.eq.jj) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=ii
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,ii)
- zapas(4,nn,iproc)=ees0p(j,ii)
- zapas(5,nn,iproc)=ees0m(j,ii)
- zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
- zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
- zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
- exit
- endif
- enddo
+ end subroutine ebend_kcc
+!c------------
+!c-------------------------------------------------------------------------------------
+ subroutine etheta_constr(ethetacnstr)
+ real (kind=8) :: ethetacnstr,thetiii,difi
+ integer :: i,itheta
+ ethetacnstr=0.0d0
+!C print *,ithetaconstr_start,ithetaconstr_end,"TU"
+ do i=ithetaconstr_start,ithetaconstr_end
+ itheta=itheta_constr(i)
+ thetiii=theta(itheta)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
+ +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
+ +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+ 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
return
- end subroutine add_hb_contact
+ end subroutine etheta_constr
+
!-----------------------------------------------------------------------------
- subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
-! This subroutine calculates multi-body contributions to hydrogen-bonding
-! implicit real*8 (a-h,o-z)
+ subroutine eback_sc_corr(esccor)
+! 7/21/2007 Correlations between the backbone-local and side-chain-local
+! conformational states; temporarily implemented as differences
+! between UNRES torsional potentials (dependent on three types of
+! residues) and the torsional potentials dependent on all 20 types
+! of residues computed from AM1 energy surfaces of terminally-blocked
+! amino-acid residues.
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.TORSION'
+! include 'COMMON.SCCOR'
+! include 'COMMON.INTERACT'
+! include 'COMMON.DERIV'
+! include 'COMMON.CHAIN'
+! include 'COMMON.NAMES'
! include 'COMMON.IOUNITS'
- integer,parameter :: max_dim=70
-#ifdef MPI
- include "mpif.h"
-! integer :: maxconts !max_cont=maxconts=nres/4
- integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
-! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
-! common /przechowalnia/ zapas
- integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
- status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
- ierr,iii,nnn
-#endif
-! include 'COMMON.SETUP'
! include 'COMMON.FFIELD'
+! include 'COMMON.CONTROL'
+ real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
+ cosphi,sinphi
+ logical :: lprn
+ integer :: i,interty,j,isccori,isccori1,intertyp
+! Set lprn=.true. for debugging
+ lprn=.false.
+! lprn=.true.
+! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
+ esccor=0.0D0
+ do i=itau_start,itau_end
+ if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
+ esccor_ii=0.0D0
+ isccori=isccortyp(itype(i-2,1))
+ isccori1=isccortyp(itype(i-1,1))
+
+! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
+ phii=phi(i)
+ do intertyp=1,3 !intertyp
+ esccor_ii=0.0D0
+!c Added 09 May 2012 (Adasko)
+!c Intertyp means interaction type of backbone mainchain correlation:
+! 1 = SC...Ca...Ca...Ca
+! 2 = Ca...Ca...Ca...SC
+! 3 = SC...Ca...Ca...SCi
+ gloci=0.0D0
+ if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
+ (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
+ (itype(i-1,1).eq.ntyp1))) &
+ .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
+ .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
+ .or.(itype(i,1).eq.ntyp1))) &
+ .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
+ (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
+ (itype(i-3,1).eq.ntyp1)))) cycle
+ if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
+ if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
+ cycle
+ do j=1,nterm_sccor(isccori,isccori1)
+ v1ij=v1sccor(j,intertyp,isccori,isccori1)
+ v2ij=v2sccor(j,intertyp,isccori,isccori1)
+ cosphi=dcos(j*tauangle(intertyp,i))
+ sinphi=dsin(j*tauangle(intertyp,i))
+ if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
+ esccor=esccor+v1ij*cosphi+v2ij*sinphi
+ gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
+ enddo
+ if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
+ 'esccor',i,intertyp,esccor_ii
+! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
+ gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
+ if (lprn) &
+ write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
+ restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
+ (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
+ (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
+ gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
+ enddo !intertyp
+ enddo
+
+ return
+ end subroutine eback_sc_corr
+!-----------------------------------------------------------------------------
+ subroutine multibody(ecorr)
+! This subroutine calculates multi-body contributions to energy following
+! the idea of Skolnick et al. If side chains I and J make a contact and
+! at the same time side chains I+1 and J+1 make a contact, an extra
+! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
! include 'COMMON.DERIV'
-! include 'COMMON.LOCAL'
! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: gx,gx1
- integer,dimension(nres) :: num_cont_hb_old
- logical :: lprn,ldone
-!EL double precision eello4,eello5,eelo6,eello_turn6
-!EL external eello4,eello5,eello6,eello_turn6
-!el local variables
- integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
- j1,jp1,i1,num_conti1
- real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
- real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
-
+ logical :: lprn
+ real(kind=8) :: ecorr
+ integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
! Set lprn=.true. for debugging
lprn=.false.
- eturn6=0.0d0
-#ifdef MPI
-! maxconts=nres/4
- if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
- do i=1,nres
- num_cont_hb_old(i)=num_cont_hb(i)
- enddo
- n_corr=0
- n_corr1=0
- if (nfgtasks.le.1) goto 30
+
+ if (lprn) then
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt,nct-2
+ write (iout,'(i2,20(1x,i2,f10.5))') &
+ i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
+ enddo
+ endif
+ ecorr=0.0D0
+
+! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
+! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
+ do i=nnt,nct
+ do j=1,3
+ gradcorr(j,i)=0.0D0
+ gradxorr(j,i)=0.0D0
+ enddo
+ enddo
+ do i=nnt,nct-2
+
+ DO ISHIFT = 3,4
+
+ i1=i+ishift
+ num_conti=num_cont(i)
+ num_conti1=num_cont(i1)
+ do jj=1,num_conti
+ j=jcont(jj,i)
+ do kk=1,num_conti1
+ j1=jcont(kk,i1)
+ if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
+!d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+!d & ' ishift=',ishift
+! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
+! The system gains extra energy.
+ ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
+ endif ! j1==j+-ishift
+ enddo ! kk
+ enddo ! jj
+
+ ENDDO ! ISHIFT
+
+ enddo ! i
+ return
+ end subroutine multibody
+!-----------------------------------------------------------------------------
+ real(kind=8) function esccorr(i,j,k,l,jj,kk)
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+ real(kind=8),dimension(3) :: gx,gx1
+ logical :: lprn
+ integer :: i,j,k,l,jj,kk,m,ll
+ real(kind=8) :: eij,ekl
+ lprn=.false.
+ eij=facont(jj,i)
+ ekl=facont(kk,k)
+!d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
+! Calculate the multi-body contribution to energy.
+! Calculate multi-body contributions to the gradient.
+!d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
+!d & k,l,(gacont(m,kk,k),m=1,3)
+ do m=1,3
+ gx(m) =ekl*gacont(m,jj,i)
+ gx1(m)=eij*gacont(m,kk,k)
+ gradxorr(m,i)=gradxorr(m,i)-gx(m)
+ gradxorr(m,j)=gradxorr(m,j)+gx(m)
+ gradxorr(m,k)=gradxorr(m,k)-gx1(m)
+ gradxorr(m,l)=gradxorr(m,l)+gx1(m)
+ enddo
+ do m=i,j-1
+ do ll=1,3
+ gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
+ enddo
+ enddo
+ do m=k,l-1
+ do ll=1,3
+ gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
+ enddo
+ enddo
+ esccorr=-eij*ekl
+ return
+ end function esccorr
+!-----------------------------------------------------------------------------
+ subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
+! This subroutine calculates multi-body contributions to hydrogen-bonding
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+#ifdef MPI
+ include "mpif.h"
+! integer :: maxconts !max_cont=maxconts =nres/4
+ integer,parameter :: max_dim=26
+ integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+!el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
+!el common /przechowalnia/ zapas
+ integer :: status(MPI_STATUS_SIZE)
+ integer,dimension((nres/4)*2) :: req !maxconts*2
+ integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
+#endif
+! include 'COMMON.SETUP'
+! include 'COMMON.FFIELD'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.LOCAL'
+ real(kind=8),dimension(3) :: gx,gx1
+ real(kind=8) :: time00,ecorr,ecorr5,ecorr6
+ logical :: lprn,ldone
+!el local variables
+ integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
+ jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
+
+! Set lprn=.true. for debugging
+ lprn=.false.
+#ifdef MPI
+! maxconts=nres/4
+ if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
+ n_corr=0
+ n_corr1=0
+ if (nfgtasks.le.1) goto 30
if (lprn) then
write (iout,'(a)') 'Contact function values before RECEIVE:'
do i=nnt,nct-2
! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
! & ntask_cont_to
! Make the list of contacts to send to send to other procesors
+! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
+! call flush(iout)
do i=iturn3_start,iturn3_end
! write (iout,*) "make contact list turn3",i," num_cont",
! & num_cont_hb(i)
- call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
+ call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
enddo
do i=iturn4_start,iturn4_end
! write (iout,*) "make contact list turn4",i," num_cont",
! & num_cont_hb(i)
- call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
+ call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
enddo
do ii=1,nat_sent
i=iat_sent(ii)
jjc=jcont_hb(j,i)
iproc=iint_sent_local(k,jjc,ii)
! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.ne.0) then
+ if (iproc.gt.0) then
ncont_sent(iproc)=ncont_sent(iproc)+1
nn=ncont_sent(iproc)
zapas(1,nn,iproc)=i
zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,i)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
- enddo
- enddo
- enddo
- enddo
+ zapas(3,nn,iproc)=facont_hb(j,i)
+ zapas(4,nn,iproc)=ees0p(j,i)
+ zapas(5,nn,iproc)=ees0m(j,i)
+ zapas(6,nn,iproc)=gacont_hbr(1,j,i)
+ zapas(7,nn,iproc)=gacont_hbr(2,j,i)
+ zapas(8,nn,iproc)=gacont_hbr(3,j,i)
+ zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
+ zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
+ zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
+ zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
+ zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
+ zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
+ zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
+ zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
+ zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
+ zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
+ zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
+ zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
+ zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
+ zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
+ zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
+ zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
+ zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
+ zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
endif
enddo
enddo
write (iout,*) nn," contacts to processor",iproc,&
" of CONT_TO_COMM group"
do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
+ write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
enddo
enddo
call flush(iout)
" of CONT_FROM_COMM group"
call flush(iout)
do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
+ write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
enddo
call flush(iout)
endif
nnn=num_cont_hb(ii)+1
num_cont_hb(ii)=nnn
jcont_hb(nnn,ii)=jj
- d_cont(nnn,ii)=zapas_recv(3,i,iii)
- ind=3
- do kk=1,3
- ind=ind+1
- grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- enddo
- enddo
+ facont_hb(nnn,ii)=zapas_recv(3,i,iii)
+ ees0p(nnn,ii)=zapas_recv(4,i,iii)
+ ees0m(nnn,ii)=zapas_recv(5,i,iii)
+ gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
+ gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
+ gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
+ gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
+ gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
+ gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
+ gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
+ gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
+ gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
+ gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
+ gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
+ gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
+ gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
+ gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
+ gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
+ gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
+ gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
+ gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
+ gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
+ gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
+ gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
enddo
enddo
call flush(iout)
if (lprn) then
write (iout,'(a)') 'Contact function values after receive:'
do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,5f6.3))') &
- i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
- ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
+ write (iout,'(2i3,50(1x,i3,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
+ j=1,num_cont_hb(i))
enddo
call flush(iout)
endif
if (lprn) then
write (iout,'(a)') 'Contact function values:'
do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,5f6.3))') &
- i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
- ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
+ write (iout,'(2i3,50(1x,i3,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
+ j=1,num_cont_hb(i))
enddo
endif
ecorr=0.0D0
- ecorr5=0.0d0
- ecorr6=0.0d0
! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
gradxorr(j,i)=0.0D0
enddo
enddo
-! Calculate the dipole-dipole interaction energies
- if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
- do i=iatel_s,iatel_e+1
+! Calculate the local-electrostatic correlation terms
+ do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
+ i1=i+1
num_conti=num_cont_hb(i)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
-#ifdef MOMENT
- call dipole(i,j,jj)
-#endif
- enddo
- enddo
- endif
-! Calculate the local-electrostatic correlation terms
-! write (iout,*) "gradcorr5 in eello5 before loop"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
- do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
-! write (iout,*) "corr loop i",i
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
+ num_conti1=num_cont_hb(i+1)
do jj=1,num_conti
j=jcont_hb(jj,i)
jp=iabs(j)
do kk=1,num_conti1
j1=jcont_hb(kk,i1)
jp1=iabs(j1)
-! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-! & ' jj=',jj,' kk=',kk
-! if (j1.eq.j+1 .or. j1.eq.j-1) then
+! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
+! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
.or. j.lt.0 .and. j1.gt.0) .and. &
(jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
! The system gains extra energy.
+ ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
+ 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
n_corr=n_corr+1
- sqd1=dsqrt(d_cont(jj,i))
- sqd2=dsqrt(d_cont(kk,i1))
- sred_geom = sqd1*sqd2
- IF (sred_geom.lt.cutoff_corr) THEN
- call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
- ekont,fprimcont)
-!d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
-!d & ' jj=',jj,' kk=',kk
- fac_prim1=0.5d0*sqd2/sqd1*fprimcont
- fac_prim2=0.5d0*sqd1/sqd2*fprimcont
- do l=1,3
- g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
- g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
- enddo
- n_corr1=n_corr1+1
-!d write (iout,*) 'sred_geom=',sred_geom,
-!d & ' ekont=',ekont,' fprim=',fprimcont,
-!d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
-!d write (iout,*) "g_contij",g_contij
-!d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
-!d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
- call calc_eello(i,jp,i+1,jp1,jj,kk)
- if (wcorr4.gt.0.0d0) &
- ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
- if (energy_dec.and.wcorr4.gt.0.0d0) &
- write (iout,'(a6,4i5,0pf7.3)') &
- 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
-! write (iout,*) "gradcorr5 before eello5"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
- if (wcorr5.gt.0.0d0) &
- ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
-! write (iout,*) "gradcorr5 after eello5"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
- if (energy_dec.and.wcorr5.gt.0.0d0) &
- write (iout,'(a6,4i5,0pf7.3)') &
- 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
-!d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
-!d write(2,*)'ijkl',i,jp,i+1,jp1
- if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
- .or. wturn6.eq.0.0d0))then
-!d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
- ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
- 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
-!d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
-!d & 'ecorr6=',ecorr6
-!d write (iout,'(4e15.5)') sred_geom,
-!d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
-!d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
-!d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
- else if (wturn6.gt.0.0d0 &
- .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
-!d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
- eturn6=eturn6+eello_turn6(i,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
- 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
-!d write (2,*) 'multibody_eello:eturn6',eturn6
- endif
- ENDIF
-1111 continue
+ else if (j1.eq.j) then
+! Contacts I-J and I-(J+1) occur simultaneously.
+! The system loses extra energy.
+! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
endif
enddo ! kk
+ do kk=1,num_conti
+ j1=jcont_hb(kk,i)
+! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+! & ' jj=',jj,' kk=',kk
+ if (j1.eq.j+1) then
+! Contacts I-J and (I+1)-J occur simultaneously.
+! The system loses extra energy.
+! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
+ endif ! j1==j+1
+ enddo ! kk
enddo ! jj
enddo ! i
- do i=1,nres
- num_cont_hb(i)=num_cont_hb_old(i)
- enddo
-! write (iout,*) "gradcorr5 in eello5"
-! do iii=1,nres
-! write (iout,'(i5,3f10.5)')
-! & iii,(gradcorr5(jjj,iii),jjj=1,3)
-! enddo
return
- end subroutine multibody_eello
+ end subroutine multibody_hb
!-----------------------------------------------------------------------------
- subroutine add_hb_contact_eello(ii,jj,itask)
-! implicit real*8 (a-h,o-z)
+ subroutine add_hb_contact(ii,jj,itask)
+! implicit real(kind=8) (a-h,o-z)
! include "DIMENSIONS"
! include "COMMON.IOUNITS"
! include "COMMON.CONTACTS"
! integer,parameter :: maxconts=nres/4
- integer,parameter :: max_dim=70
- real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
-! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+ integer,parameter :: max_dim=26
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
! common /przechowalnia/ zapas
-
- integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
- integer,dimension(4) ::itask
+ integer :: i,j,ii,jj,iproc,nn,jjc
+ integer,dimension(4) :: itask
! write (iout,*) "itask",itask
do i=1,2
iproc=itask(i)
if (iproc.gt.0) then
do j=1,num_cont_hb(ii)
jjc=jcont_hb(j,ii)
-! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
+! write (iout,*) "i",ii," j",jj," jjc",jjc
if (jjc.eq.jj) then
ncont_sent(iproc)=ncont_sent(iproc)+1
nn=ncont_sent(iproc)
zapas(1,nn,iproc)=ii
zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,ii)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
- enddo
- enddo
- enddo
- enddo
+ zapas(3,nn,iproc)=facont_hb(j,ii)
+ zapas(4,nn,iproc)=ees0p(j,ii)
+ zapas(5,nn,iproc)=ees0m(j,ii)
+ zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
+ zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
+ zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
+ zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
+ zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
+ zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
+ zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
+ zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
+ zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
+ zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
+ zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
+ zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
+ zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
+ zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
+ zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
+ zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
+ zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
+ zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
+ zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
+ zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
+ zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
exit
endif
enddo
endif
enddo
return
- end subroutine add_hb_contact_eello
+ end subroutine add_hb_contact
!-----------------------------------------------------------------------------
- real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
-! implicit real*8 (a-h,o-z)
+ subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
+! This subroutine calculates multi-body contributions to hydrogen-bonding
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
+ integer,parameter :: max_dim=70
+#ifdef MPI
+ include "mpif.h"
+! integer :: maxconts !max_cont=maxconts=nres/4
+ integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
+! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+! common /przechowalnia/ zapas
+ integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
+ status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
+ ierr,iii,nnn
+#endif
+! include 'COMMON.SETUP'
+! include 'COMMON.FFIELD'
! include 'COMMON.DERIV'
+! include 'COMMON.LOCAL'
! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: gx,gx1
- logical :: lprn
+ integer,dimension(nres) :: num_cont_hb_old
+ logical :: lprn,ldone
+!EL double precision eello4,eello5,eelo6,eello_turn6
+!EL external eello4,eello5,eello6,eello_turn6
!el local variables
- integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
- real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
+ j1,jp1,i1,num_conti1
+ real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
+ real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
+! Set lprn=.true. for debugging
lprn=.false.
- eij=facont_hb(jj,i)
- ekl=facont_hb(kk,k)
- ees0pij=ees0p(jj,i)
- ees0pkl=ees0p(kk,k)
- ees0mij=ees0m(jj,i)
- ees0mkl=ees0m(kk,k)
- ekont=eij*ekl
- ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
-!d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
-! Following 4 lines for diagnostics.
-!d ees0pkl=0.0D0
-!d ees0pij=1.0D0
-!d ees0mkl=0.0D0
-!d ees0mij=1.0D0
-! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
-! & 'Contacts ',i,j,
-! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
-! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
-! & 'gradcorr_long'
-! Calculate the multi-body contribution to energy.
-! ecorr=ecorr+ekont*ees
-! Calculate multi-body contributions to the gradient.
- coeffpees0pij=coeffp*ees0pij
- coeffmees0mij=coeffm*ees0mij
- coeffpees0pkl=coeffp*ees0pkl
- coeffmees0mkl=coeffm*ees0mkl
- do ll=1,3
-!grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
- gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
- -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
-!grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
- gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
-! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
+ eturn6=0.0d0
+#ifdef MPI
+! maxconts=nres/4
+ if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
+ do i=1,nres
+ num_cont_hb_old(i)=num_cont_hb(i)
enddo
-! write (iout,*)
-!grad do m=i+1,j-1
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+
-!grad & ees*ekl*gacont_hbr(ll,jj,i)-
-!grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
-!grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
-!grad enddo
-!grad enddo
-!grad do m=k+1,l-1
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+
-!grad & ees*eij*gacont_hbr(ll,kk,k)-
-!grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
-!grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
-!grad enddo
-!grad enddo
-! write (iout,*) "ehbcorr",ekont*ees
- ehbcorr=ekont*ees
- if (shield_mode.gt.0) then
- j=ees0plist(jj,i)
- l=ees0plist(kk,k)
-!C print *,i,j,fac_shield(i),fac_shield(j),
-!C &fac_shield(k),fac_shield(l)
- if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
- (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
- do ilist=1,ishield_list(i)
- iresshield=shield_list(ilist,i)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(j)
- iresshield=shield_list(ilist,j)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
-
- do ilist=1,ishield_list(k)
- iresshield=shield_list(ilist,k)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
- do ilist=1,ishield_list(l)
- iresshield=shield_list(ilist,l)
- do m=1,3
- rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
- gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
- rlocshield &
- +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
- gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
- +rlocshield
- enddo
- enddo
- do m=1,3
- gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
- grad_shield(m,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
- grad_shield(m,j)*ehbcorr/fac_shield(j)
- gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
- grad_shield(m,i)*ehbcorr/fac_shield(i)
- gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
- grad_shield(m,j)*ehbcorr/fac_shield(j)
-
- gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
- grad_shield(m,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
- grad_shield(m,l)*ehbcorr/fac_shield(l)
- gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
- grad_shield(m,k)*ehbcorr/fac_shield(k)
- gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
- grad_shield(m,l)*ehbcorr/fac_shield(l)
-
- enddo
- endif
- endif
- return
- end function ehbcorr
-#ifdef MOMENT
-!-----------------------------------------------------------------------------
- subroutine dipole(i,j,jj)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.FFIELD'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
- real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
- integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
-
- allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
- allocate(dipderx(3,5,4,maxconts,nres))
-!
-
- iti1 = itortyp(itype(i+1,1))
- if (j.lt.nres-1) then
- itj1 = itortyp(itype(j+1,1))
- else
- itj1=ntortyp+1
+ n_corr=0
+ n_corr1=0
+ if (nfgtasks.le.1) goto 30
+ if (lprn) then
+ write (iout,'(a)') 'Contact function values before RECEIVE:'
+ do i=nnt,nct-2
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
+ j=1,num_cont_hb(i))
+ enddo
endif
- do iii=1,2
- dipi(iii,1)=Ub2(iii,i)
- dipderi(iii)=Ub2der(iii,i)
- dipi(iii,2)=b1(iii,iti1)
- dipj(iii,1)=Ub2(iii,j)
- dipderj(iii)=Ub2der(iii,j)
- dipj(iii,2)=b1(iii,itj1)
+ call flush(iout)
+ do i=1,ntask_cont_from
+ ncont_recv(i)=0
enddo
- kkk=0
- do iii=1,2
- call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
- do jjj=1,2
- kkk=kkk+1
- dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
+ do i=1,ntask_cont_to
+ ncont_sent(i)=0
enddo
- do kkk=1,5
- do lll=1,3
- mmm=0
- do iii=1,2
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
- auxvec(1))
- do jjj=1,2
- mmm=mmm+1
- dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
+! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
+! & ntask_cont_to
+! Make the list of contacts to send to send to other procesors
+ do i=iturn3_start,iturn3_end
+! write (iout,*) "make contact list turn3",i," num_cont",
+! & num_cont_hb(i)
+ call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
+ enddo
+ do i=iturn4_start,iturn4_end
+! write (iout,*) "make contact list turn4",i," num_cont",
+! & num_cont_hb(i)
+ call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
+ enddo
+ do ii=1,nat_sent
+ i=iat_sent(ii)
+! write (iout,*) "make contact list longrange",i,ii," num_cont",
+! & num_cont_hb(i)
+ do j=1,num_cont_hb(i)
+ do k=1,4
+ jjc=jcont_hb(j,i)
+ iproc=iint_sent_local(k,jjc,ii)
+! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
+ if (iproc.ne.0) then
+ ncont_sent(iproc)=ncont_sent(iproc)+1
+ nn=ncont_sent(iproc)
+ zapas(1,nn,iproc)=i
+ zapas(2,nn,iproc)=jjc
+ zapas(3,nn,iproc)=d_cont(j,i)
+ ind=3
+ do kk=1,3
+ ind=ind+1
+ zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
enddo
- enddo
+ do kk=1,2
+ do ll=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
+ enddo
+ enddo
+ do jj=1,5
+ do kk=1,3
+ do ll=1,2
+ do mm=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
+ enddo
+ enddo
+ enddo
+ enddo
+ endif
+ enddo
enddo
enddo
- call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
- call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
- do iii=1,2
- dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
+ if (lprn) then
+ write (iout,*) &
+ "Numbers of contacts to be sent to other processors",&
+ (ncont_sent(i),i=1,ntask_cont_to)
+ write (iout,*) "Contacts sent"
+ do ii=1,ntask_cont_to
+ nn=ncont_sent(ii)
+ iproc=itask_cont_to(ii)
+ write (iout,*) nn," contacts to processor",iproc,&
+ " of CONT_TO_COMM group"
+ do i=1,nn
+ write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
+ enddo
enddo
- call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
- do iii=1,2
- dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
+ call flush(iout)
+ endif
+ CorrelType=477
+ CorrelID=fg_rank+1
+ CorrelType1=478
+ CorrelID1=nfgtasks+fg_rank+1
+ ireq=0
+! Receive the numbers of needed contacts from other processors
+ do ii=1,ntask_cont_from
+ iproc=itask_cont_from(ii)
+ ireq=ireq+1
+ call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
+ FG_COMM,req(ireq),IERR)
enddo
- return
- end subroutine dipole
-#endif
-!-----------------------------------------------------------------------------
- subroutine calc_eello(i,j,k,l,jj,kk)
-!
-! This subroutine computes matrices and vectors needed to calculate
-! the fourth-, fifth-, and sixth-order local-electrostatic terms.
-!
- use comm_kut
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.FFIELD'
- real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
- real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
- integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
- itj1
-!el logical :: lprn
-!el common /kutas/ lprn
-!d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
-!d & ' jj=',jj,' kk=',kk
-!d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
-!d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
-!d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
- do iii=1,2
- do jjj=1,2
- aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
- aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
- enddo
+! write (iout,*) "IRECV ended"
+! call flush(iout)
+! Send the number of contacts needed by other processors
+ do ii=1,ntask_cont_to
+ iproc=itask_cont_to(ii)
+ ireq=ireq+1
+ call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
+ FG_COMM,req(ireq),IERR)
enddo
- call transpose2(aa1(1,1),aa1t(1,1))
- call transpose2(aa2(1,1),aa2t(1,1))
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
- aa1tder(1,1,lll,kkk))
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
- aa2tder(1,1,lll,kkk))
- enddo
- enddo
- if (l.eq.j+1) then
-! parallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i,1))
- else
- iti=ntortyp+1
+! write (iout,*) "ISEND ended"
+! write (iout,*) "number of requests (nn)",ireq
+ call flush(iout)
+ if (ireq.gt.0) &
+ call MPI_Waitall(ireq,req,status_array,ierr)
+! write (iout,*)
+! & "Numbers of contacts to be received from other processors",
+! & (ncont_recv(i),i=1,ntask_cont_from)
+! call flush(iout)
+! Receive contacts
+ ireq=0
+ do ii=1,ntask_cont_from
+ iproc=itask_cont_from(ii)
+ nn=ncont_recv(ii)
+! write (iout,*) "Receiving",nn," contacts from processor",iproc,
+! & " of CONT_TO_COMM group"
+ call flush(iout)
+ if (nn.gt.0) then
+ ireq=ireq+1
+ call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
+ MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+! write (iout,*) "ireq,req",ireq,req(ireq)
endif
- itk1=itortyp(itype(k+1,1))
- itj=itortyp(itype(j,1))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1,1))
- else
- itl1=ntortyp+1
+ enddo
+! Send the contacts to processors that need them
+ do ii=1,ntask_cont_to
+ iproc=itask_cont_to(ii)
+ nn=ncont_sent(ii)
+! write (iout,*) nn," contacts to processor",iproc,
+! & " of CONT_TO_COMM group"
+ if (nn.gt.0) then
+ ireq=ireq+1
+ call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
+ iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+! write (iout,*) "ireq,req",ireq,req(ireq)
+! do i=1,nn
+! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
+! enddo
+ endif
+ enddo
+! write (iout,*) "number of requests (contacts)",ireq
+! write (iout,*) "req",(req(i),i=1,4)
+! call flush(iout)
+ if (ireq.gt.0) &
+ call MPI_Waitall(ireq,req,status_array,ierr)
+ do iii=1,ntask_cont_from
+ iproc=itask_cont_from(iii)
+ nn=ncont_recv(iii)
+ if (lprn) then
+ write (iout,*) "Received",nn," contacts from processor",iproc,&
+ " of CONT_FROM_COMM group"
+ call flush(iout)
+ do i=1,nn
+ write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
+ enddo
+ call flush(iout)
endif
-! A1 kernel(j+1) A2T
-!d do iii=1,2
-!d write (iout,'(3f10.5,5x,3f10.5)')
-!d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
-!d enddo
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
- AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
- AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
- Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
- ADtEAderx(1,1,1,1,1,1))
- lprn=.false.
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
- DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
- ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-! End 6-th order cumulants
-!d lprn=.false.
-!d if (lprn) then
-!d write (2,*) 'In calc_eello6'
-!d do iii=1,2
-!d write (2,*) 'iii=',iii
-!d do kkk=1,5
-!d write (2,*) 'kkk=',kkk
-!d do jjj=1,2
-!d write (2,'(3(2f10.5),5x)')
-!d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
-!d enddo
-!d enddo
-!d enddo
-!d endif
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
- EAEAderx(1,1,lll,kkk,iii,1))
+ do i=1,nn
+ ii=zapas_recv(1,i,iii)
+! Flag the received contacts to prevent double-counting
+ jj=-zapas_recv(2,i,iii)
+! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
+! call flush(iout)
+ nnn=num_cont_hb(ii)+1
+ num_cont_hb(ii)=nnn
+ jcont_hb(nnn,ii)=jj
+ d_cont(nnn,ii)=zapas_recv(3,i,iii)
+ ind=3
+ do kk=1,3
+ ind=ind+1
+ grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
+ enddo
+ do kk=1,2
+ do ll=1,2
+ ind=ind+1
+ a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
enddo
enddo
- enddo
-! A1T kernel(i+1) A2
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
- AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
- AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
- Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
- ADtEAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
- DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
- ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-! End 6-th order cumulants
- call transpose2(EUgder(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- EAEAderx(1,1,lll,kkk,iii,2))
+ do jj=1,5
+ do kk=1,3
+ do ll=1,2
+ do mm=1,2
+ ind=ind+1
+ a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
+ enddo
+ enddo
enddo
enddo
enddo
-! AEAb1 and AEAb2
-! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-! They are needed only when the fifth- or the sixth-order cumulants are
-! indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
-! Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),&
- AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),&
- AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
- AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
- AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),&
- AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),&
- AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
- AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
- AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-! End vectors
- else
-! Antiparallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i,1))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1,1))
- itl=itortyp(itype(l,1))
- itj=itortyp(itype(j,1))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1,1))
- else
- itj1=ntortyp+1
- endif
-! A2 kernel(j-1)T A1T
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
- AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
- j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
- AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
- Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
- ADtEAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
- aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
- DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
- ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-! End 6-th order cumulants
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
- EAEAderx(1,1,lll,kkk,iii,1))
- enddo
- enddo
- enddo
-! A2T kernel(i+1)T A1
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
- AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-! Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
- j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
- AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
- Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
- ADtEAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
- a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
- DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
- ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-! End 6-th order cumulants
- call transpose2(EUgder(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
+ enddo
+ call flush(iout)
+ if (lprn) then
+ write (iout,'(a)') 'Contact function values after receive:'
+ do i=nnt,nct-2
+ write (iout,'(2i3,50(1x,i3,5f6.3))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
+ ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
enddo
-! AEAb1 and AEAb2
-! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-! They are needed only when the fifth- or the sixth-order cumulants are
-! indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
- (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
-! Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),&
- AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),&
- AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
- AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
- AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),&
- AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),&
- AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
- AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
- AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
+ call flush(iout)
+ endif
+ 30 continue
+#endif
+ if (lprn) then
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt,nct-2
+ write (iout,'(2i3,50(1x,i2,5f6.3))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
+ ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
enddo
- ENDIF
-! End vectors
endif
- return
- end subroutine calc_eello
-!-----------------------------------------------------------------------------
- subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
- use comm_kut
- implicit none
- integer :: nderg
- logical :: transp
- real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
- real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
- real(kind=8),dimension(2,2,3,5,2) :: AKAderx
- real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
- integer :: iii,kkk,lll
- integer :: jjj,mmm
-!el logical :: lprn
-!el common /kutas/ lprn
- call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
- do iii=1,nderg
- call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
- AKAderg(1,1,iii))
+ ecorr=0.0D0
+ ecorr5=0.0d0
+ ecorr6=0.0d0
+
+! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
+! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
+! Remove the loop below after debugging !!!
+ do i=nnt,nct
+ do j=1,3
+ gradcorr(j,i)=0.0D0
+ gradxorr(j,i)=0.0D0
+ enddo
enddo
-!d if (lprn) write (2,*) 'In kernel'
- do kkk=1,5
-!d if (lprn) write (2,*) 'kkk=',kkk
- do lll=1,3
- call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
- KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
-!d if (lprn) then
-!d write (2,*) 'lll=',lll
-!d write (2,*) 'iii=1'
-!d do jjj=1,2
-!d write (2,'(3(2f10.5),5x)')
-!d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
-!d enddo
-!d endif
- call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
- KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
-!d if (lprn) then
-!d write (2,*) 'lll=',lll
-!d write (2,*) 'iii=2'
-!d do jjj=1,2
-!d write (2,'(3(2f10.5),5x)')
-!d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
-!d enddo
-!d endif
+! Calculate the dipole-dipole interaction energies
+ if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
+ do i=iatel_s,iatel_e+1
+ num_conti=num_cont_hb(i)
+ do jj=1,num_conti
+ j=jcont_hb(jj,i)
+#ifdef MOMENT
+ call dipole(i,j,jj)
+#endif
enddo
enddo
- return
- end subroutine kernel
-!-----------------------------------------------------------------------------
- real(kind=8) function eello4(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- real(kind=8),dimension(2,2) :: pizda
- real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8) :: eel4,glongij,glongkl
- integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
-!d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
-!d eello4=0.0d0
-!d return
-!d endif
-!d print *,'eello4:',i,j,k,l,jj,kk
-!d write (2,*) 'i',i,' j',j,' k',k,' l',l
-!d call checkint4(i,j,k,l,jj,kk,eel4_num)
-!old eij=facont_hb(jj,i)
-!old ekl=facont_hb(kk,k)
-!old ekont=eij*ekl
- eel4=-EAEA(1,1,1)-EAEA(2,2,1)
-!d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
- gcorr_loc(k-1)=gcorr_loc(k-1) &
- -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
- if (l.eq.j+1) then
- gcorr_loc(l-1)=gcorr_loc(l-1) &
- -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- else
- gcorr_loc(j-1)=gcorr_loc(j-1) &
- -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
- -EAEAderx(2,2,lll,kkk,iii,1)
-!d derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d gcorr_loc(l-1)=0.0d0
-!d gcorr_loc(j-1)=0.0d0
-!d gcorr_loc(k-1)=0.0d0
-!d eel4=1.0d0
-!d write (iout,*)'Contacts have occurred for peptide groups',
-!d & i,j,' fcont:',eij,' eij',' and ',k,l,
-!d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-!grad ggg1(ll)=eel4*g_contij(ll,1)
-!grad ggg2(ll)=eel4*g_contij(ll,2)
- glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
- glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
-!grad ghalf=0.5d0*ggg1(ll)
- gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
- gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
- gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
-!grad ghalf=0.5d0*ggg2(ll)
- gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
- gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
- gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
+! Calculate the local-electrostatic correlation terms
+! write (iout,*) "gradcorr5 in eello5 before loop"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
+ do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
+! write (iout,*) "corr loop i",i
+ i1=i+1
+ num_conti=num_cont_hb(i)
+ num_conti1=num_cont_hb(i+1)
+ do jj=1,num_conti
+ j=jcont_hb(jj,i)
+ jp=iabs(j)
+ do kk=1,num_conti1
+ j1=jcont_hb(kk,i1)
+ jp1=iabs(j1)
+! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+! & ' jj=',jj,' kk=',kk
+! if (j1.eq.j+1 .or. j1.eq.j-1) then
+ if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
+ .or. j.lt.0 .and. j1.gt.0) .and. &
+ (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
+! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
+! The system gains extra energy.
+ n_corr=n_corr+1
+ sqd1=dsqrt(d_cont(jj,i))
+ sqd2=dsqrt(d_cont(kk,i1))
+ sred_geom = sqd1*sqd2
+ IF (sred_geom.lt.cutoff_corr) THEN
+ call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
+ ekont,fprimcont)
+!d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
+!d & ' jj=',jj,' kk=',kk
+ fac_prim1=0.5d0*sqd2/sqd1*fprimcont
+ fac_prim2=0.5d0*sqd1/sqd2*fprimcont
+ do l=1,3
+ g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
+ g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
+ enddo
+ n_corr1=n_corr1+1
+!d write (iout,*) 'sred_geom=',sred_geom,
+!d & ' ekont=',ekont,' fprim=',fprimcont,
+!d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
+!d write (iout,*) "g_contij",g_contij
+!d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
+!d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
+ call calc_eello(i,jp,i+1,jp1,jj,kk)
+ if (wcorr4.gt.0.0d0) &
+ ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
+ if (energy_dec.and.wcorr4.gt.0.0d0) &
+ write (iout,'(a6,4i5,0pf7.3)') &
+ 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
+! write (iout,*) "gradcorr5 before eello5"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
+ if (wcorr5.gt.0.0d0) &
+ ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
+! write (iout,*) "gradcorr5 after eello5"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
+ if (energy_dec.and.wcorr5.gt.0.0d0) &
+ write (iout,'(a6,4i5,0pf7.3)') &
+ 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
+!d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
+!d write(2,*)'ijkl',i,jp,i+1,jp1
+ if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
+ .or. wturn6.eq.0.0d0))then
+!d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
+ ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
+ if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
+ 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
+!d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
+!d & 'ecorr6=',ecorr6
+!d write (iout,'(4e15.5)') sred_geom,
+!d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
+!d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
+!d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
+ else if (wturn6.gt.0.0d0 &
+ .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
+!d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
+ eturn6=eturn6+eello_turn6(i,jj,kk)
+ if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
+ 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
+!d write (2,*) 'multibody_eello:eturn6',eturn6
+ endif
+ ENDIF
+1111 continue
+ endif
+ enddo ! kk
+ enddo ! jj
+ enddo ! i
+ do i=1,nres
+ num_cont_hb(i)=num_cont_hb_old(i)
enddo
-!grad do m=i+1,j-1
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
-!grad enddo
-!grad enddo
-!grad do m=k+1,l-1
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
-!grad enddo
-!grad enddo
-!grad do m=i+2,j2
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
-!grad enddo
-!grad enddo
-!grad do m=k+2,l2
-!grad do ll=1,3
-!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
-!grad enddo
-!grad enddo
-!d do iii=1,nres-3
-!d write (2,*) iii,gcorr_loc(iii)
-!d enddo
- eello4=ekont*eel4
-!d write (2,*) 'ekont',ekont
-!d write (iout,*) 'eello4',ekont*eel4
+! write (iout,*) "gradcorr5 in eello5"
+! do iii=1,nres
+! write (iout,'(i5,3f10.5)')
+! & iii,(gradcorr5(jjj,iii),jjj=1,3)
+! enddo
return
- end function eello4
+ end subroutine multibody_eello
!-----------------------------------------------------------------------------
- real(kind=8) function eello5(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
- real(kind=8),dimension(2) :: vv
- real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
- real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
- integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel chains C
-! C
-! o o o o C
-! /l\ / \ \ / \ / \ / C
-! / \ / \ \ / \ / \ / C
-! j| o |l1 | o | o| o | | o |o C
-! \ |/k\| |/ \| / |/ \| |/ \| C
-! \i/ \ / \ / / \ / \ C
-! o k1 o C
-! (I) (II) (III) (IV) C
-! C
-! eello5_1 eello5_2 eello5_3 eello5_4 C
-! C
-! Antiparallel chains C
-! C
-! o o o o C
-! /j\ / \ \ / \ / \ / C
-! / \ / \ \ / \ / \ / C
-! j1| o |l | o | o| o | | o |o C
-! \ |/k\| |/ \| / |/ \| |/ \| C
-! \i/ \ / \ / / \ / \ C
-! o k1 o C
-! (I) (II) (III) (IV) C
-! C
-! eello5_1 eello5_2 eello5_3 eello5_4 C
-! C
-! o denotes a local interaction, vertical lines an electrostatic interaction. C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
-!d eello5=0.0d0
-!d return
-!d endif
-!d write (iout,*)
-!d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
-!d & ' and',k,l
- itk=itortyp(itype(k,1))
- itl=itortyp(itype(l,1))
- itj=itortyp(itype(j,1))
- eello5_1=0.0d0
- eello5_2=0.0d0
- eello5_3=0.0d0
- eello5_4=0.0d0
-!d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
-!d & eel5_3_num,eel5_4_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d eij=facont_hb(jj,i)
-!d ekl=facont_hb(kk,k)
-!d ekont=eij*ekl
-!d write (iout,*)'Contacts have occurred for peptide groups',
-!d & i,j,' fcont:',eij,' eij',' and ',k,l
-!d goto 1111
-! Contribution from the graph I.
-!d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
-!d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i))
-! Explicit gradient in virtual-dihedral angles.
- if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
- +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- if (l.eq.j+1) then
- if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- else
- if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- endif
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,i))
+ subroutine add_hb_contact_eello(ii,jj,itask)
+! implicit real(kind=8) (a-h,o-z)
+! include "DIMENSIONS"
+! include "COMMON.IOUNITS"
+! include "COMMON.CONTACTS"
+! integer,parameter :: maxconts=nres/4
+ integer,parameter :: max_dim=70
+ real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
+! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
+! common /przechowalnia/ zapas
+
+ integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
+ integer,dimension(4) ::itask
+! write (iout,*) "itask",itask
+ do i=1,2
+ iproc=itask(i)
+ if (iproc.gt.0) then
+ do j=1,num_cont_hb(ii)
+ jjc=jcont_hb(j,ii)
+! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
+ if (jjc.eq.jj) then
+ ncont_sent(iproc)=ncont_sent(iproc)+1
+ nn=ncont_sent(iproc)
+ zapas(1,nn,iproc)=ii
+ zapas(2,nn,iproc)=jjc
+ zapas(3,nn,iproc)=d_cont(j,ii)
+ ind=3
+ do kk=1,3
+ ind=ind+1
+ zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
+ enddo
+ do kk=1,2
+ do ll=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
+ enddo
+ enddo
+ do jj=1,5
+ do kk=1,3
+ do ll=1,2
+ do mm=1,2
+ ind=ind+1
+ zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
+ enddo
+ enddo
+ enddo
+ enddo
+ exit
+ endif
enddo
- enddo
+ endif
enddo
-! goto 1112
-!1111 continue
-! Contribution from graph II
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- if (l.eq.j+1) then
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- else
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- endif
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,k))
- enddo
- enddo
+ return
+ end subroutine add_hb_contact_eello
+!-----------------------------------------------------------------------------
+ real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
+! implicit real(kind=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)
+!d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
+! Following 4 lines for diagnostics.
+!d ees0pkl=0.0D0
+!d ees0pij=1.0D0
+!d ees0mkl=0.0D0
+!d ees0mij=1.0D0
+! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
+! & 'Contacts ',i,j,
+! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
+! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
+! & 'gradcorr_long'
+! Calculate the multi-body contribution to energy.
+! ecorr=ecorr+ekont*ees
+! Calculate multi-body contributions to the gradient.
+ coeffpees0pij=coeffp*ees0pij
+ coeffmees0mij=coeffm*ees0mij
+ coeffpees0pkl=coeffp*ees0pkl
+ coeffmees0mkl=coeffm*ees0mkl
+ do ll=1,3
+!grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
+ gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
+ -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb1(ll,jj,i))
+ gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+!grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
+ gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
+ gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
+ gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
+! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
enddo
-!d goto 1112
-!d1111 continue
- if (l.eq.j+1) then
-!d goto 1110
-! Parallel orientation
-! Contribution from graph III
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
- call transpose2(EUgder(1,1,l),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,j))
- enddo
- enddo
- enddo
-!d goto 1112
-! Contribution from graph IV
-!d1110 continue
- call transpose2(EE(1,1,itl),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,l))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,l)))
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii) &
- +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,l))
- enddo
- enddo
- enddo
- else
-! Antiparallel orientation
-! Contribution from graph III
-! goto 1110
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1) &
- +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
- call transpose2(EUgder(1,1,j),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
- +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
- +0.5d0*scalar2(vv(1),Dtobr2(1,l))
- enddo
- enddo
- enddo
-!d goto 1112
-! Contribution from graph IV
-1110 continue
- call transpose2(EE(1,1,itj),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,j))
-! Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1) &
- -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1) &
- +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,j)))
-! Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
- +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
- -0.5d0*scalar2(vv(1),Ctobr(1,j))
- enddo
- enddo
- enddo
- endif
-1112 continue
- eel5=eello5_1+eello5_2+eello5_3+eello5_4
-!d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
-!d write (2,*) 'ijkl',i,j,k,l
-!d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
-!d & ' eello5_3',eello5_3,' eello5_4',eello5_4
-!d endif
-!d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
-!d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
-!d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
-!d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
-!d eij=1.0d0
-!d ekl=1.0d0
-!d ekont=1.0d0
-!d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
-! 2/11/08 AL Gradients over DC's connecting interacting sites will be
-! summed up outside the subrouine as for the other subroutines
-! handling long-range interactions. The old code is commented out
-! with "cgrad" to keep track of changes.
- do ll=1,3
-!grad ggg1(ll)=eel5*g_contij(ll,1)
-!grad ggg2(ll)=eel5*g_contij(ll,2)
- gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
-! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
-! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
-! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
-! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
-! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
-! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
-! & gradcorr5ij,
-! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
-!old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
-!grad ghalf=0.5d0*ggg1(ll)
-!d ghalf=0.0d0
- gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
- gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
- gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
- gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
- gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
-!old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
-!grad ghalf=0.5d0*ggg2(ll)
- ghalf=0.0d0
- gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
- gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
- gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
- gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
- gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
- enddo
-!d goto 1112
+! write (iout,*)
!grad do m=i+1,j-1
!grad do ll=1,3
-!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+
+!grad & ees*ekl*gacont_hbr(ll,jj,i)-
+!grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
+!grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
!grad enddo
!grad enddo
!grad do m=k+1,l-1
!grad do ll=1,3
-!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
-!grad enddo
-!grad enddo
-!1112 continue
-!grad do m=i+2,j2
-!grad do ll=1,3
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
-!grad enddo
-!grad enddo
-!grad do m=k+2,l2
-!grad do ll=1,3
-!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+
+!grad & ees*eij*gacont_hbr(ll,kk,k)-
+!grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
+!grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
!grad enddo
!grad enddo
-!d do iii=1,nres-3
-!d write (2,*) iii,g_corr5_loc(iii)
-!d enddo
- eello5=ekont*eel5
-!d write (2,*) 'ekont',ekont
-!d write (iout,*) 'eello5',ekont*eel5
- return
- end function eello5
-!-----------------------------------------------------------------------------
- real(kind=8) function eello6(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.FFIELD'
- real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
- eello6_6,eel6
- real(kind=8) :: gradcorr6ij,gradcorr6kl
- integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
-!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-!d eello6=0.0d0
-!d return
-!d endif
-!d write (iout,*)
-!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-!d & ' and',k,l
- eello6_1=0.0d0
- eello6_2=0.0d0
- eello6_3=0.0d0
- eello6_4=0.0d0
- eello6_5=0.0d0
- eello6_6=0.0d0
-!d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
-!d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d eij=facont_hb(jj,i)
-!d ekl=facont_hb(kk,k)
-!d ekont=eij*ekl
-!d eij=1.0d0
-!d ekl=1.0d0
-!d ekont=1.0d0
- if (l.eq.j+1) then
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(j,i,l,k,2,.false.)
- eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
- eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
- else
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(l,k,j,i,2,.true.)
- eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
- else
- eello6_5=0.0d0
- endif
- eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
+! 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
-! If turn contributions are considered, they will be handled separately.
- eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
-!d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
-!d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
-!d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
-!d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
-!d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
-!d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
-!d goto 1112
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
+ return
+ end function ehbcorr
+#ifdef MOMENT
+!-----------------------------------------------------------------------------
+ subroutine dipole(i,j,jj)
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.FFIELD'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
+ real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
+ integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
+
+ allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
+ allocate(dipderx(3,5,4,maxconts,nres))
+!
+
+ iti1 = itortyp(itype(i+1,1))
+ if (j.lt.nres-1) then
+ itj1 = itype2loc(itype(j+1,1))
else
- l1=l-1
- l2=l-2
+ itj1=nloctyp
endif
- do ll=1,3
-!grad ggg1(ll)=eel6*g_contij(ll,1)
-!grad ggg2(ll)=eel6*g_contij(ll,2)
-!old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
-!grad ghalf=0.5d0*ggg1(ll)
-!d ghalf=0.0d0
- gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
- gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
- gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
- gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
- gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
- gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
-!grad ghalf=0.5d0*ggg2(ll)
-!old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
-!d ghalf=0.0d0
- gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
- gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
- gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
- gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
- gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
+ do iii=1,2
+ dipi(iii,1)=Ub2(iii,i)
+ dipderi(iii)=Ub2der(iii,i)
+ dipi(iii,2)=b1(iii,iti1)
+ dipj(iii,1)=Ub2(iii,j)
+ dipderj(iii)=Ub2der(iii,j)
+ dipj(iii,2)=b1(iii,itj1)
+ enddo
+ kkk=0
+ do iii=1,2
+ call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
+ do jjj=1,2
+ kkk=kkk+1
+ dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
+ enddo
+ enddo
+ do kkk=1,5
+ do lll=1,3
+ mmm=0
+ do iii=1,2
+ call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
+ auxvec(1))
+ do jjj=1,2
+ mmm=mmm+1
+ dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
+ enddo
+ enddo
+ enddo
+ enddo
+ call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
+ call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
+ do iii=1,2
+ dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
+ enddo
+ call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
+ do iii=1,2
+ dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
enddo
-!d goto 1112
-!grad do m=i+1,j-1
-!grad do ll=1,3
-!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
-!grad enddo
-!grad enddo
-!grad do m=k+1,l-1
-!grad do ll=1,3
-!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
-!grad enddo
-!grad enddo
-!grad1112 continue
-!grad do m=i+2,j2
-!grad do ll=1,3
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
-!grad enddo
-!grad enddo
-!grad do m=k+2,l2
-!grad do ll=1,3
-!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
-!grad enddo
-!grad enddo
-!d do iii=1,nres-3
-!d write (2,*) iii,g_corr6_loc(iii)
-!d enddo
- eello6=ekont*eel6
-!d write (2,*) 'ekont',ekont
-!d write (iout,*) 'eello6',ekont*eel6
return
- end function eello6
+ end subroutine dipole
+#endif
!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
+ subroutine calc_eello(i,j,k,l,jj,kk)
+!
+! This subroutine computes matrices and vectors needed to calculate
+! the fourth-, fifth-, and sixth-order local-electrostatic terms.
+!
use comm_kut
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
! include 'COMMON.TORSION'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
- real(kind=8),dimension(2) :: vv,vv1
- real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
- logical :: swap
+! include 'COMMON.FFIELD'
+ real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
+ real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
+ integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
+ itj1
!el logical :: lprn
!el common /kutas/ lprn
- integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
- real(kind=8) :: s1,s2,s3,s4,s5
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel Antiparallel C
-! C
-! o o C
-! /l\ /j\ C
-! / \ / \ C
-! /| o | | o |\ C
-! \ j|/k\| / \ |/k\|l / C
-! \ / \ / \ / \ / C
-! o o o o C
-! i i C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- itk=itortyp(itype(k,1))
- s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
- eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
- if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
- -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
- -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
- +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
- +scalar2(vv(1),Dtobr2der(1,i)))
- call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
- if (l.eq.j+1) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1) &
- +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
- -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
- +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1) &
- +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
- -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
- +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- endif
- call transpose2(EUgCder(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
- +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
- +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
- +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
+!d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
+!d & ' jj=',jj,' kk=',kk
+!d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
+!d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
+!d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
do iii=1,2
- if (swap) then
- ind=3-iii
- else
- ind=iii
- endif
- do kkk=1,5
- do lll=1,3
- s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
- pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
- -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
- vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
- +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
- derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
- enddo
+ do jjj=1,2
+ aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
+ aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
enddo
enddo
- return
- end function eello6_graph1
-!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
- use comm_kut
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- logical :: swap
- real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
- real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
-!el logical :: lprn
-!el common /kutas/ lprn
- integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
- real(kind=8) :: s2,s3,s4
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel Antiparallel C
-! C
-! o o C
-! \ /l\ /j\ / C
-! \ / \ / \ / C
-! o| o | | o |o C
-! \ j|/k\| \ |/k\|l C
-! \ / \ \ / \ C
-! o o C
-! i i C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
-! AL 7/4/01 s1 would occur in the sixth-order moment,
-! but not in a cluster cumulant
-#ifdef MOMENT
- s1=dip(1,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph2=-(s1+s2+s3+s4)
-#else
- eello6_graph2=-(s2+s3+s4)
-#endif
-! eello6_graph2=-s3
-! Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- s1=dipderg(1,jj,i)*dip(1,kk,k)
-#endif
- s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
-! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
- endif
-! Derivatives in gamma(k-1)
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
-! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
-! Derivatives in gamma(j-1) or gamma(l-1)
- if (j.gt.1) then
-#ifdef MOMENT
- s1=dipderg(3,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
- call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
+ call transpose2(aa1(1,1),aa1t(1,1))
+ call transpose2(aa2(1,1),aa2t(1,1))
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
+ aa1tder(1,1,lll,kkk))
+ call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
+ aa2tder(1,1,lll,kkk))
+ enddo
+ enddo
+ if (l.eq.j+1) then
+! parallel orientation of the two CA-CA-CA frames.
+ if (i.gt.1) then
+ iti=itortyp(itype(i,1))
else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
+ iti=ntortyp+1
endif
-#endif
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
-! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
- endif
-! Derivatives in gamma(l-1) or gamma(j-1)
- if (l.gt.1) then
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(3,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
+ itk1=itortyp(itype(k+1,1))
+ itj=itortyp(itype(j,1))
+ if (l.lt.nres-1) then
+ itl1=itortyp(itype(l+1,1))
else
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
+ itl1=ntortyp+1
endif
-#endif
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
-! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
- endif
-! Cartesian derivatives.
- if (lprn) then
- write (2,*) 'In eello6_graph2'
- do iii=1,2
- write (2,*) 'iii=',iii
- do kkk=1,5
- write (2,*) 'kkk=',kkk
- do jjj=1,2
- write (2,'(3(2f10.5),5x)') &
- ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
- enddo
- enddo
- enddo
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
- else
- s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
- endif
-#endif
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
- auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
- auxvec(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
+! A1 kernel(j+1) A2T
+!d do iii=1,2
+!d write (iout,'(3f10.5,5x,3f10.5)')
+!d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
+!d enddo
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
+ AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0) THEN
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
+ AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
+ Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
+ ADtEAderx(1,1,1,1,1,1))
+ lprn=.false.
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
+ DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
+ ADtEA1derx(1,1,1,1,1,1))
+ ENDIF
+! End 6-th order cumulants
+!d lprn=.false.
+!d if (lprn) then
+!d write (2,*) 'In calc_eello6'
+!d do iii=1,2
+!d write (2,*) 'iii=',iii
+!d do kkk=1,5
+!d write (2,*) 'kkk=',kkk
+!d do jjj=1,2
+!d write (2,'(3(2f10.5),5x)')
+!d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
+!d enddo
+!d enddo
+!d enddo
+!d endif
+ call transpose2(EUgder(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
+ call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
+ EAEAderx(1,1,lll,kkk,iii,1))
+ enddo
enddo
enddo
- enddo
- return
- end function eello6_graph2
-!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- real(kind=8),dimension(2) :: vv,auxvec
- real(kind=8),dimension(2,2) :: pizda,auxmat
- logical :: swap
- integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
- real(kind=8) :: s1,s2,s3,s4
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel Antiparallel C
-! C
-! o o C
-! /l\ / \ /j\ C
-! / \ / \ / \ C
-! /| o |o o| o |\ C
-! j|/k\| / |/k\|l / C
-! / \ / / \ / C
-! / o / o C
-! i i C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!
-! 4/7/01 AL Component s1 was removed, because it pertains to the respective
-! energy moment and not to the cluster cumulant.
- iti=itortyp(itype(i,1))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1,1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k,1))
- itk1=itortyp(itype(k+1,1))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1,1))
- else
- itl1=ntortyp+1
- endif
-#ifdef MOMENT
- s1=dip(4,jj,i)*dip(4,kk,k)
-#endif
- call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-!d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
-!d & "sum",-(s2+s3+s4)
-#ifdef MOMENT
- eello6_graph3=-(s1+s2+s3+s4)
-#else
- eello6_graph3=-(s2+s3+s4)
-#endif
-! eello6_graph3=-s4
-! Derivatives in gamma(k-1)
- call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
-! Derivatives in gamma(l-1)
- call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
-! Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
- else
- s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
- auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
- auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
-! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
+! A1T kernel(i+1) A2
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
+ AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0) THEN
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
+ AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
+ Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
+ ADtEAderx(1,1,1,1,1,2))
+ call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
+ DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
+ ADtEA1derx(1,1,1,1,1,2))
+ ENDIF
+! End 6-th order cumulants
+ call transpose2(EUgder(1,1,l),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
+ call transpose2(EUg(1,1,l),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
+ EAEAderx(1,1,lll,kkk,iii,2))
+ enddo
enddo
enddo
- enddo
- return
- end function eello6_graph3
-!-----------------------------------------------------------------------------
- real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.FFIELD'
- real(kind=8),dimension(2) :: vv,auxvec,auxvec1
- real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
- logical :: swap
- integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
- iii,kkk,lll
- real(kind=8) :: s1,s2,s3,s4
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-! C
-! Parallel Antiparallel C
-! C
-! o o C
-! /l\ / \ /j\ C
-! / \ / \ / \ C
-! /| o |o o| o |\ C
-! \ j|/k\| \ |/k\|l C
-! \ / \ \ / \ C
-! o \ o \ C
-! i i C
-! C
-!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-!
-! 4/7/01 AL Component s1 was removed, because it pertains to the respective
-! energy moment and not to the cluster cumulant.
-!d write (2,*) 'eello_graph4: wturn6',wturn6
- iti=itortyp(itype(i,1))
- itj=itortyp(itype(j,1))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1,1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k,1))
- if (k.lt.nres-1) then
- itk1=itortyp(itype(k+1,1))
- else
- itk1=ntortyp+1
- endif
- itl=itortyp(itype(l,1))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1,1))
- else
- itl1=ntortyp+1
- endif
-!d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
-!d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
-!d & ' itl',itl,' itl1',itl1
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dip(3,kk,k)
- else
- s1=dip(2,jj,j)*dip(2,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
+! AEAb1 and AEAb2
+! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
+! They are needed only when the fifth- or the sixth-order cumulants are
+! indluded.
+ IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
+ call transpose2(AEA(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
+ call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
+ call transpose2(AEAderg(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
+ call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
+ call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
+ call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
+ call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
+ call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
+ call transpose2(AEA(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
+ call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
+ call transpose2(AEAderg(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
+ call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
+ call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
+ call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
+ call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
+ call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
+! Calculate the Cartesian derivatives of the vectors.
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),&
+ AEAb1derx(1,lll,kkk,iii,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),&
+ AEAb2derx(1,lll,kkk,iii,1,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
+ AEAb1derx(1,lll,kkk,iii,2,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
+ AEAb2derx(1,lll,kkk,iii,2,1))
+ call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj),&
+ AEAb1derx(1,lll,kkk,iii,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,j),&
+ AEAb2derx(1,lll,kkk,iii,1,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
+ AEAb1derx(1,lll,kkk,iii,2,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
+ AEAb2derx(1,lll,kkk,iii,2,2))
+ enddo
+ enddo
+ enddo
+ ENDIF
+! End vectors
else
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
-!d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph4=-(s1+s2+s3+s4)
-#else
- eello6_graph4=-(s2+s3+s4)
-#endif
-! Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dipderg(2,jj,i)*dip(3,kk,k)
- else
- s1=dipderg(4,jj,j)*dip(2,kk,l)
- endif
-#endif
- s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-!d write (2,*) 'turn6 derivatives'
-#ifdef MOMENT
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
-#endif
+! Antiparallel orientation of the two CA-CA-CA frames.
+ if (i.gt.1) then
+ iti=itortyp(itype(i,1))
else
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
+ iti=ntortyp+1
endif
- endif
-! Derivatives in gamma(k-1)
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderg(2,kk,k)
- else
- s1=dip(2,jj,j)*dipderg(4,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
-#endif
- else
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
- endif
-! Derivatives in gamma(j-1) or gamma(l-1)
- if (l.eq.j+1 .and. l.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
- else if (j.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
- gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
+ itk1=itortyp(itype(k+1,1))
+ itl=itortyp(itype(l,1))
+ itj=itortyp(itype(j,1))
+ if (j.lt.nres-1) then
+ itj1=itortyp(itype(j+1,1))
+ else
+ itj1=ntortyp+1
endif
- endif
-! Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- if (imat.eq.1) then
- s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
- else
- s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
- endif
- else
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
- else
- s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
- endif
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
- auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
- b1(1,itj1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
- else
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
- b1(1,itl1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
- endif
- call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
- pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (swap) then
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
- -(s1+s2+s4)
-#else
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
- -(s2+s4)
-#endif
- derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
- else
-#ifdef MOMENT
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
-#endif
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
- else
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (l.eq.j+1) then
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- endif
- endif
+! A2 kernel(j-1)T A1T
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
+ AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
+ j.eq.i+4 .and. l.eq.i+3)) THEN
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
+ AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
+ call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
+ Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
+ ADtEAderx(1,1,1,1,1,1))
+ call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
+ aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
+ DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
+ ADtEA1derx(1,1,1,1,1,1))
+ ENDIF
+! End 6-th order cumulants
+ call transpose2(EUgder(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
+ call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
+ EAEAderx(1,1,lll,kkk,iii,1))
+ enddo
+ enddo
+ enddo
+! A2T kernel(i+1)T A1
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
+ AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
+! Following matrices are needed only for 6-th order cumulants
+ IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
+ j.eq.i+4 .and. l.eq.i+3)) THEN
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
+ AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
+ Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
+ ADtEAderx(1,1,1,1,1,2))
+ call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
+ a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
+ DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
+ ADtEA1derx(1,1,1,1,1,2))
+ ENDIF
+! End 6-th order cumulants
+ call transpose2(EUgder(1,1,j),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
+ call transpose2(EUg(1,1,j),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
+ EAEAderx(1,1,lll,kkk,iii,2))
+ enddo
+ enddo
+ enddo
+! AEAb1 and AEAb2
+! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
+! They are needed only when the fifth- or the sixth-order cumulants are
+! indluded.
+ IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
+ (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
+ call transpose2(AEA(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
+ call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
+ call transpose2(AEAderg(1,1,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
+ call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
+ call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
+ call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
+ call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
+ call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
+ call transpose2(AEA(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
+ call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
+ call transpose2(AEAderg(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
+ call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
+ call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
+ call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
+ call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
+ call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
+! Calculate the Cartesian derivatives of the vectors.
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,iti),&
+ AEAb1derx(1,lll,kkk,iii,1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i),&
+ AEAb2derx(1,lll,kkk,iii,1,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
+ AEAb1derx(1,lll,kkk,iii,2,1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
+ AEAb2derx(1,lll,kkk,iii,2,1))
+ call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),b1(1,itl),&
+ AEAb1derx(1,lll,kkk,iii,1,2))
+ call matvec2(auxmat(1,1),Ub2(1,l),&
+ AEAb2derx(1,lll,kkk,iii,1,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
+ AEAb1derx(1,lll,kkk,iii,2,2))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
+ AEAb2derx(1,lll,kkk,iii,2,2))
+ enddo
enddo
enddo
+ ENDIF
+! End vectors
+ endif
+ return
+ end subroutine calc_eello
+!-----------------------------------------------------------------------------
+ subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
+ use comm_kut
+ implicit none
+ integer :: nderg
+ logical :: transp
+ real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
+ real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
+ real(kind=8),dimension(2,2,3,5,2) :: AKAderx
+ real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
+ integer :: iii,kkk,lll
+ integer :: jjj,mmm
+!el logical :: lprn
+!el common /kutas/ lprn
+ call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
+ do iii=1,nderg
+ call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
+ AKAderg(1,1,iii))
+ enddo
+!d if (lprn) write (2,*) 'In kernel'
+ do kkk=1,5
+!d if (lprn) write (2,*) 'kkk=',kkk
+ do lll=1,3
+ call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
+ KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
+!d if (lprn) then
+!d write (2,*) 'lll=',lll
+!d write (2,*) 'iii=1'
+!d do jjj=1,2
+!d write (2,'(3(2f10.5),5x)')
+!d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
+!d enddo
+!d endif
+ call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
+ KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
+!d if (lprn) then
+!d write (2,*) 'lll=',lll
+!d write (2,*) 'iii=2'
+!d do jjj=1,2
+!d write (2,'(3(2f10.5),5x)')
+!d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
+!d enddo
+!d endif
+ enddo
enddo
return
- end function eello6_graph4
+ end subroutine kernel
!-----------------------------------------------------------------------------
- real(kind=8) function eello_turn6(i,jj,kk)
-! implicit real*8 (a-h,o-z)
+ real(kind=8) function eello4(i,j,k,l,jj,kk)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
! include 'COMMON.TORSION'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
- real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
- real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
+ real(kind=8),dimension(2,2) :: pizda
real(kind=8),dimension(3) :: ggg1,ggg2
- real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
- real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
-! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
-! the respective energy moment and not to the cluster cumulant.
-!el local variables
- integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
- integer :: j1,j2,l1,l2,ll
- real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
- real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
- s1=0.0d0
- s8=0.0d0
- s13=0.0d0
-!
- eello_turn6=0.0d0
- j=i+4
- k=i+1
- l=i+3
- iti=itortyp(itype(i,1))
- itk=itortyp(itype(k,1))
- itk1=itortyp(itype(k+1,1))
- itl=itortyp(itype(l,1))
- itj=itortyp(itype(j,1))
-!d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
-!d write (2,*) 'i',i,' k',k,' j',j,' l',l
-!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-!d eello6=0.0d0
+ real(kind=8) :: eel4,glongij,glongkl
+ integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
+!d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
+!d eello4=0.0d0
!d return
!d endif
-!d write (iout,*)
-!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-!d & ' and',k,l
-!d call checkint_turn6(i,jj,kk,eel_turn6_num)
+!d print *,'eello4:',i,j,k,l,jj,kk
+!d write (2,*) 'i',i,' j',j,' k',k,' l',l
+!d call checkint4(i,j,k,l,jj,kk,eel4_num)
+!old eij=facont_hb(jj,i)
+!old ekl=facont_hb(kk,k)
+!old ekont=eij*ekl
+ eel4=-EAEA(1,1,1)-EAEA(2,2,1)
+!d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
+ gcorr_loc(k-1)=gcorr_loc(k-1) &
+ -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
+ if (l.eq.j+1) then
+ gcorr_loc(l-1)=gcorr_loc(l-1) &
+ -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
+ else
+ gcorr_loc(j-1)=gcorr_loc(j-1) &
+ -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
+ endif
do iii=1,2
do kkk=1,5
do lll=1,3
- derx_turn(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-!d eij=1.0d0
-!d ekl=1.0d0
-!d ekont=1.0d0
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
-!d eello6_5=0.0d0
-!d write (2,*) 'eello6_5',eello6_5
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
- ss1=scalar2(Ub2(1,i+2),b1(1,itl))
- s1 = (auxmat(1,1)+auxmat(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
- s2 = scalar2(b1(1,itk),vtemp1(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atemp(1,1))
- call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
- call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
- s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
- s12 = scalar2(Ub2(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
- call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
- call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
- ss13 = scalar2(b1(1,itk),vtemp4(1))
- s13 = (gtemp(1,1)+gtemp(2,2))*ss13
-#endif
-! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
-! s1=0.0d0
-! s2=0.0d0
-! s8=0.0d0
-! s12=0.0d0
-! s13=0.0d0
- eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
-! Derivatives in gamma(i+2)
- s1d =0.0d0
- s8d =0.0d0
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
- call transpose2(AEAderg(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
- gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
-! Derivatives in gamma(i+3)
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
-#endif
- call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
- s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
-#endif
- s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#endif
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
- -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
- -0.5d0*ekont*(s2d+s12d)
-#endif
-! Derivatives in gamma(i+4)
- call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#endif
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
-#else
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
-#endif
-! Derivatives in gamma(i+5)
-#ifdef MOMENT
- call transpose2(AEAderg(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
-#endif
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
- -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
- -0.5d0*ekont*(s2d+s12d)
-#endif
-! Cartesian derivatives
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
- vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))* &
- scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
- auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-! s1d=0.0d0
-! s2d=0.0d0
-! s8d=0.0d0
-! s12d=0.0d0
-! s13d=0.0d0
-#ifdef MOMENT
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
- - 0.5d0*(s1d+s2d)
-#else
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
- - 0.5d0*s2d
-#endif
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
- - 0.5d0*(s8d+s12d)
-#else
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
- - 0.5d0*s12d
-#endif
+ derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
+ -EAEAderx(2,2,lll,kkk,iii,1)
+!d derx(lll,kkk,iii)=0.0d0
enddo
enddo
enddo
-#ifdef MOMENT
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
- achuj_tempd(1,1))
- call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d=(gtempd(1,1)+gtempd(2,2))*ss13
- derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
- vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
- derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
- enddo
- enddo
-#endif
-!d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
-!d & 16*eel_turn6_num
-!d goto 1112
+!d gcorr_loc(l-1)=0.0d0
+!d gcorr_loc(j-1)=0.0d0
+!d gcorr_loc(k-1)=0.0d0
+!d eel4=1.0d0
+!d write (iout,*)'Contacts have occurred for peptide groups',
+!d & i,j,' fcont:',eij,' eij',' and ',k,l,
+!d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
if (j.lt.nres-1) then
j1=j+1
j2=j-1
l2=l-2
endif
do ll=1,3
-!grad ggg1(ll)=eel_turn6*g_contij(ll,1)
-!grad ggg2(ll)=eel_turn6*g_contij(ll,2)
+!grad ggg1(ll)=eel4*g_contij(ll,1)
+!grad ggg2(ll)=eel4*g_contij(ll,2)
+ glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
+ glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
!grad ghalf=0.5d0*ggg1(ll)
-!d ghalf=0.0d0
- gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
- gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
- gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
- +ekont*derx_turn(ll,2,1)
- gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
- gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
- +ekont*derx_turn(ll,4,1)
- gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
- gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
- gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
+ gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
+ gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
+ gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
+ gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
+ gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
+ gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
!grad ghalf=0.5d0*ggg2(ll)
-!d ghalf=0.0d0
- gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
- +ekont*derx_turn(ll,2,2)
- gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
- gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
- +ekont*derx_turn(ll,4,2)
- gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
- gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
- gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
+ gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
+ gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
+ gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
+ gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
+ gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
+ gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
enddo
-!d goto 1112
!grad do m=i+1,j-1
!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
!grad enddo
!grad enddo
!grad do m=k+1,l-1
!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
!grad enddo
!grad enddo
-!grad1112 continue
!grad do m=i+2,j2
!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
!grad enddo
!grad enddo
!grad do m=k+2,l2
!grad do ll=1,3
-!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
+!grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
!grad enddo
!grad enddo
!d do iii=1,nres-3
-!d write (2,*) iii,g_corr6_loc(iii)
+!d write (2,*) iii,gcorr_loc(iii)
!d enddo
- eello_turn6=ekont*eel_turn6
+ eello4=ekont*eel4
!d write (2,*) 'ekont',ekont
-!d write (2,*) 'eel_turn6',ekont*eel_turn6
- return
- end function eello_turn6
-!-----------------------------------------------------------------------------
- subroutine MATVEC2(A1,V1,V2)
-!DIR$ INLINEALWAYS MATVEC2
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
-#endif
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- real(kind=8),dimension(2) :: V1,V2
- real(kind=8),dimension(2,2) :: A1
- real(kind=8) :: vaux1,vaux2
-! DO 1 I=1,2
-! VI=0.0
-! DO 3 K=1,2
-! 3 VI=VI+A1(I,K)*V1(K)
-! Vaux(I)=VI
-! 1 CONTINUE
-
- vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
- vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
-
- v2(1)=vaux1
- v2(2)=vaux2
- end subroutine MATVEC2
-!-----------------------------------------------------------------------------
- subroutine MATMAT2(A1,A2,A3)
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
-#endif
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- real(kind=8),dimension(2,2) :: A1,A2,A3
- real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
-! DIMENSION AI3(2,2)
-! DO J=1,2
-! A3IJ=0.0
-! DO K=1,2
-! A3IJ=A3IJ+A1(I,K)*A2(K,J)
-! enddo
-! A3(I,J)=A3IJ
-! enddo
-! enddo
-
- ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
- ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
- ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
- ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
-
- A3(1,1)=AI3_11
- A3(2,1)=AI3_21
- A3(1,2)=AI3_12
- A3(2,2)=AI3_22
- end subroutine MATMAT2
-!-----------------------------------------------------------------------------
- real(kind=8) function scalar2(u,v)
-!DIR$ INLINEALWAYS scalar2
- implicit none
- real(kind=8),dimension(2) :: u,v
- real(kind=8) :: sc
- integer :: i
- scalar2=u(1)*v(1)+u(2)*v(2)
- return
- end function scalar2
-!-----------------------------------------------------------------------------
- subroutine transpose2(a,at)
-!DIR$ INLINEALWAYS transpose2
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::transpose2
-#endif
- implicit none
- real(kind=8),dimension(2,2) :: a,at
- at(1,1)=a(1,1)
- at(1,2)=a(2,1)
- at(2,1)=a(1,2)
- at(2,2)=a(2,2)
- return
- end subroutine transpose2
-!-----------------------------------------------------------------------------
- subroutine transpose(n,a,at)
- implicit none
- integer :: n,i,j
- real(kind=8),dimension(n,n) :: a,at
- do i=1,n
- do j=1,n
- at(j,i)=a(i,j)
- enddo
- enddo
- return
- end subroutine transpose
-!-----------------------------------------------------------------------------
- subroutine prodmat3(a1,a2,kk,transp,prod)
-!DIR$ INLINEALWAYS prodmat3
-#ifndef OSF
-!DEC$ ATTRIBUTES FORCEINLINE::prodmat3
-#endif
- implicit none
- integer :: i,j
- real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
- logical :: transp
-!rc double precision auxmat(2,2),prod_(2,2)
-
- if (transp) then
-!rc call transpose2(kk(1,1),auxmat(1,1))
-!rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
-!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
- +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
- +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
- +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
- +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
-
- else
-!rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
-!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
- +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
- +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
- +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
- +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
-
- endif
-! call transpose2(a2(1,1),a2t(1,1))
-
-!rc print *,transp
-!rc print *,((prod_(i,j),i=1,2),j=1,2)
-!rc print *,((prod(i,j),i=1,2),j=1,2)
-
+!d write (iout,*) 'eello4',ekont*eel4
return
- end subroutine prodmat3
-!-----------------------------------------------------------------------------
-! energy_p_new_barrier.F
+ end function eello4
!-----------------------------------------------------------------------------
- subroutine sum_gradient
-! implicit real*8 (a-h,o-z)
- use io_base, only: pdbout
+ real(kind=8) function eello5(i,j,k,l,jj,kk)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-!MS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include 'mpif.h'
-#endif
- real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
- gloc_scbuf !(3,maxres)
-
- real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
-!#endif
-!el local variables
- integer :: i,j,k,ierror,ierr
- real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
- gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
- gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
- gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
- gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
- gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
- gsccorr_max,gsccorrx_max,time00
-
-! include 'COMMON.SETUP'
! include 'COMMON.IOUNITS'
-! include 'COMMON.FFIELD'
+! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
! include 'COMMON.INTERACT'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CHAIN'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
! include 'COMMON.VAR'
-! include 'COMMON.CONTROL'
-! include 'COMMON.TIME1'
-! include 'COMMON.MAXGRAD'
-! include 'COMMON.SCCOR'
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
-#ifdef DEBUG
- write (iout,*) "sum_gradient gvdwc, gvdwx"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef MPI
- gradbufc=0.0d0
- gradbufx=0.0d0
- gradbufc_sum=0.0d0
- gloc_scbuf=0.0d0
- glocbuf=0.0d0
-! FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
- call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
-!
-! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
-! in virtual-bond-vector coordinates
-!
-#ifdef DEBUG
-! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
-! do i=1,nres-1
-! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
-! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
-! enddo
-! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
-! do i=1,nres-1
-! write (iout,'(i5,3f10.5,2x,f10.5)')
-! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
-! enddo
- write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
- (gvdwc_scpp(j,i),j=1,3)
- enddo
- write (iout,*) "gelc_long gvdwpp gel_loc_long"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
- (gelc_loc_long(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef SPLITELE
- do i=0,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+ &
- wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
- welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
- wcorr*gradcorr_long(j,i)+ &
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i)+ &
- wstrain*ghpbc(j,i) &
- +wliptran*gliptranc(j,i) &
- +gradafm(j,i) &
- +welec*gshieldc(j,i) &
- +wcorr*gshieldc_ec(j,i) &
- +wturn3*gshieldc_t3(j,i)&
- +wturn4*gshieldc_t4(j,i)&
- +wel_loc*gshieldc_ll(j,i)&
- +wtube*gg_tube(j,i) &
- +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
- wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
- wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
- wcorr_nucl*gradcorr_nucl(j,i)&
- +wcorr3_nucl*gradcorr3_nucl(j,i)+&
- wcatprot* gradpepcat(j,i)+ &
- wcatcat*gradcatcat(j,i)+ &
- wscbase*gvdwc_scbase(j,i)+ &
- wpepbase*gvdwc_pepbase(j,i)+&
- wscpho*gvdwc_scpho(j,i)+ &
- wpeppho*gvdwc_peppho(j,i)
-
-
-
-
-
- enddo
- enddo
-#else
- do i=0,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+ &
- wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
- welec*gelc_long(j,i)+ &
- wbond*gradb(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
- wcorr*gradcorr_long(j,i)+ &
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i)+ &
- wstrain*ghpbc(j,i) &
- +wliptran*gliptranc(j,i) &
- +gradafm(j,i) &
- +welec*gshieldc(j,i)&
- +wcorr*gshieldc_ec(j,i) &
- +wturn4*gshieldc_t4(j,i) &
- +wel_loc*gshieldc_ll(j,i)&
- +wtube*gg_tube(j,i) &
- +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
- wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
- wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
- wcorr_nucl*gradcorr_nucl(j,i) &
- +wcorr3_nucl*gradcorr3_nucl(j,i) +&
- wcatprot* gradpepcat(j,i)+ &
- wcatcat*gradcatcat(j,i)+ &
- wscbase*gvdwc_scbase(j,i) &
- wpepbase*gvdwc_pepbase(j,i)+&
- wscpho*gvdwc_scpho(j,i)+&
- wpeppho*gvdwc_peppho(j,i)
-
-
- enddo
- enddo
-#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-#ifdef DEBUG
- write (iout,*) "gradbufc before allreduce"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- do i=0,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
+! include 'COMMON.GEO'
+ real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
+ real(kind=8),dimension(2) :: vv
+ real(kind=8),dimension(3) :: ggg1,ggg2
+ real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
+ real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
+ integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel chains C
+! C
+! o o o o C
+! /l\ / \ \ / \ / \ / C
+! / \ / \ \ / \ / \ / C
+! j| o |l1 | o | o| o | | o |o C
+! \ |/k\| |/ \| / |/ \| |/ \| C
+! \i/ \ / \ / / \ / \ C
+! o k1 o C
+! (I) (II) (III) (IV) C
+! C
+! eello5_1 eello5_2 eello5_3 eello5_4 C
+! C
+! Antiparallel chains C
+! C
+! o o o o C
+! /j\ / \ \ / \ / \ / C
+! / \ / \ \ / \ / \ / C
+! j1| o |l | o | o| o | | o |o C
+! \ |/k\| |/ \| / |/ \| |/ \| C
+! \i/ \ / \ / / \ / \ C
+! o k1 o C
+! (I) (II) (III) (IV) C
+! C
+! eello5_1 eello5_2 eello5_3 eello5_4 C
+! C
+! o denotes a local interaction, vertical lines an electrostatic interaction. C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
+!d eello5=0.0d0
+!d return
+!d endif
+!d write (iout,*)
+!d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
+!d & ' and',k,l
+ itk=itortyp(itype(k,1))
+ itl=itortyp(itype(l,1))
+ itj=itortyp(itype(j,1))
+ eello5_1=0.0d0
+ eello5_2=0.0d0
+ eello5_3=0.0d0
+ eello5_4=0.0d0
+!d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
+!d & eel5_3_num,eel5_4_num)
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ derx(lll,kkk,iii)=0.0d0
+ enddo
enddo
enddo
-! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
-! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
-! time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
-! write (iout,*) "gradbufc_sum after allreduce"
-! do i=1,nres
-! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
-! enddo
-! call flush(iout)
-#endif
-#ifdef TIMING
-! time_allreduce=time_allreduce+MPI_Wtime()-time00
-#endif
- do i=0,nres
- do k=1,3
- gradbufc(k,i)=0.0d0
+!d eij=facont_hb(jj,i)
+!d ekl=facont_hb(kk,k)
+!d ekont=eij*ekl
+!d write (iout,*)'Contacts have occurred for peptide groups',
+!d & i,j,' fcont:',eij,' eij',' and ',k,l
+!d goto 1111
+! Contribution from the graph I.
+!d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
+!d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i))
+! Explicit gradient in virtual-dihedral angles.
+ if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
+ +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
+ call transpose2(EUgder(1,1,k),auxmat1(1,1))
+ call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+ call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ if (l.eq.j+1) then
+ if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+ else
+ if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+ endif
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,i))
+ enddo
enddo
enddo
-#ifdef DEBUG
- write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
- write (iout,*) (i," jgrad_start",jgrad_start(i),&
- " jgrad_end ",jgrad_end(i),&
- i=igrad_start,igrad_end)
-#endif
-!
-! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
-! do not parallelize this part.
-!
-! do i=igrad_start,igrad_end
-! do j=jgrad_start(i),jgrad_end(i)
-! do k=1,3
-! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
-! enddo
-! enddo
-! enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,-1,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
+! goto 1112
+!1111 continue
+! Contribution from graph II
+ call transpose2(EE(1,1,itk),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
+ call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ if (l.eq.j+1) then
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k)))
+ else
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k)))
+ endif
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,k))
+ enddo
enddo
enddo
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
+!d goto 1112
+!d1111 continue
+ if (l.eq.j+1) then
+!d goto 1110
+! Parallel orientation
+! Contribution from graph III
+ call transpose2(EUg(1,1,l),auxmat(1,1))
+ call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
+ call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
+ call transpose2(EUgder(1,1,l),auxmat1(1,1))
+ call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,j))
+ enddo
+ enddo
+ enddo
+!d goto 1112
+! Contribution from graph IV
+!d1110 continue
+ call transpose2(EE(1,1,itl),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,l))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,l)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ derx(lll,kkk,iii)=derx(lll,kkk,iii) &
+ +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,l))
+ enddo
+ enddo
+ enddo
else
-#endif
-!el#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gradbufc"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-!el#undef DEBUG
- do i=-1,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
- gradbufc(j,i)=0.0d0
+! Antiparallel orientation
+! Contribution from graph III
+! goto 1110
+ call transpose2(EUg(1,1,j),auxmat(1,1))
+ call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(l-1)=g_corr5_loc(l-1) &
+ +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
+ call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
+ call transpose2(EUgder(1,1,j),auxmat1(1,1))
+ call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
+ +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
+ +0.5d0*scalar2(vv(1),Dtobr2(1,l))
+ enddo
+ enddo
enddo
- enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,-1,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
+!d goto 1112
+! Contribution from graph IV
+1110 continue
+ call transpose2(EE(1,1,itj),auxmat(1,1))
+ call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,j))
+! Explicit gradient in virtual-dihedral angles.
+ g_corr5_loc(j-1)=g_corr5_loc(j-1) &
+ -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
+ call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ g_corr5_loc(k-1)=g_corr5_loc(k-1) &
+ +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,j)))
+! Cartesian gradient
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
+ +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
+ -0.5d0*scalar2(vv(1),Ctobr(1,j))
+ enddo
+ enddo
enddo
- enddo
-! do i=nnt,nres-1
-! do k=1,3
-! gradbufc(k,i)=0.0d0
-! enddo
-! do j=i+1,nres
-! do k=1,3
-! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
-! enddo
-! enddo
-! enddo
-!el#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-!el#undef DEBUG
-#ifdef MPI
endif
-#endif
- do k=1,3
- gradbufc(k,nres)=0.0d0
+1112 continue
+ eel5=eello5_1+eello5_2+eello5_3+eello5_4
+!d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
+!d write (2,*) 'ijkl',i,j,k,l
+!d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
+!d & ' eello5_3',eello5_3,' eello5_4',eello5_4
+!d endif
+!d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
+!d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
+!d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
+!d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
+ if (j.lt.nres-1) then
+ j1=j+1
+ j2=j-1
+ else
+ j1=j-1
+ j2=j-2
+ endif
+ if (l.lt.nres-1) then
+ l1=l+1
+ l2=l-1
+ else
+ l1=l-1
+ l2=l-2
+ endif
+!d eij=1.0d0
+!d ekl=1.0d0
+!d ekont=1.0d0
+!d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
+! 2/11/08 AL Gradients over DC's connecting interacting sites will be
+! summed up outside the subrouine as for the other subroutines
+! handling long-range interactions. The old code is commented out
+! with "cgrad" to keep track of changes.
+ do ll=1,3
+!grad ggg1(ll)=eel5*g_contij(ll,1)
+!grad ggg2(ll)=eel5*g_contij(ll,2)
+ gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
+ gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
+! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
+! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
+! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
+! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
+! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
+! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
+! & gradcorr5ij,
+! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
+!old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
+!grad ghalf=0.5d0*ggg1(ll)
+!d ghalf=0.0d0
+ gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
+ gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
+ gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
+ gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
+ gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
+ gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
+!old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
+!grad ghalf=0.5d0*ggg2(ll)
+ ghalf=0.0d0
+ gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
+ gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
+ gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
+ gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
+ gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
+ gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
enddo
-!el----------------
-!el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
-!el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
-!el-----------------
- do i=-1,nct
- do j=1,3
-#ifdef SPLITELE
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
- wel_loc*gel_loc(j,i)+ &
- 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
- welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
- wcorr*gradcorr_long(j,i)+ &
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i))+ &
- wbond*gradb(j,i)+ &
- wcorr*gradcorr(j,i)+ &
- wturn3*gcorr3_turn(j,i)+ &
- wturn4*gcorr4_turn(j,i)+ &
- wcorr5*gradcorr5(j,i)+ &
- wcorr6*gradcorr6(j,i)+ &
- wturn6*gcorr6_turn(j,i)+ &
- wsccor*gsccorc(j,i) &
- +wscloc*gscloc(j,i) &
- +wliptran*gliptranc(j,i) &
- +gradafm(j,i) &
- +welec*gshieldc(j,i) &
- +welec*gshieldc_loc(j,i) &
- +wcorr*gshieldc_ec(j,i) &
- +wcorr*gshieldc_loc_ec(j,i) &
- +wturn3*gshieldc_t3(j,i) &
- +wturn3*gshieldc_loc_t3(j,i) &
- +wturn4*gshieldc_t4(j,i) &
- +wturn4*gshieldc_loc_t4(j,i) &
- +wel_loc*gshieldc_ll(j,i) &
- +wel_loc*gshieldc_loc_ll(j,i) &
- +wtube*gg_tube(j,i) &
- +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
- +wvdwpsb*gvdwpsb1(j,i))&
- +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
-! if (i.eq.21) then
-! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
-! wturn4*gshieldc_t4(j,i), &
-! wturn4*gshieldc_loc_t4(j,i)
-! endif
-! if ((i.le.2).and.(i.ge.1))
-! print *,gradc(j,i,icg),&
-! gradbufc(j,i),welec*gelc(j,i), &
-! wel_loc*gel_loc(j,i), &
-! wscp*gvdwc_scpp(j,i), &
-! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
-! wel_loc*gel_loc_long(j,i), &
-! wcorr*gradcorr_long(j,i), &
-! wcorr5*gradcorr5_long(j,i), &
-! wcorr6*gradcorr6_long(j,i), &
-! wturn6*gcorr6_turn_long(j,i), &
-! wbond*gradb(j,i), &
-! wcorr*gradcorr(j,i), &
-! wturn3*gcorr3_turn(j,i), &
-! wturn4*gcorr4_turn(j,i), &
-! wcorr5*gradcorr5(j,i), &
-! wcorr6*gradcorr6(j,i), &
-! wturn6*gcorr6_turn(j,i), &
-! wsccor*gsccorc(j,i) &
-! ,wscloc*gscloc(j,i) &
-! ,wliptran*gliptranc(j,i) &
-! ,gradafm(j,i) &
-! ,welec*gshieldc(j,i) &
-! ,welec*gshieldc_loc(j,i) &
-! ,wcorr*gshieldc_ec(j,i) &
-! ,wcorr*gshieldc_loc_ec(j,i) &
-! ,wturn3*gshieldc_t3(j,i) &
-! ,wturn3*gshieldc_loc_t3(j,i) &
-! ,wturn4*gshieldc_t4(j,i) &
-! ,wturn4*gshieldc_loc_t4(j,i) &
-! ,wel_loc*gshieldc_ll(j,i) &
-! ,wel_loc*gshieldc_loc_ll(j,i) &
-! ,wtube*gg_tube(j,i) &
-! ,wbond_nucl*gradb_nucl(j,i) &
-! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
-! wvdwpsb*gvdwpsb1(j,i)&
-! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
-!
-
-#else
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
- wel_loc*gel_loc(j,i)+ &
- 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
- welec*gelc_long(j,i)+ &
- wel_loc*gel_loc_long(j,i)+ &
-!el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
- wcorr5*gradcorr5_long(j,i)+ &
- wcorr6*gradcorr6_long(j,i)+ &
- wturn6*gcorr6_turn_long(j,i))+ &
- wbond*gradb(j,i)+ &
- wcorr*gradcorr(j,i)+ &
- wturn3*gcorr3_turn(j,i)+ &
- wturn4*gcorr4_turn(j,i)+ &
- wcorr5*gradcorr5(j,i)+ &
- wcorr6*gradcorr6(j,i)+ &
- wturn6*gcorr6_turn(j,i)+ &
- wsccor*gsccorc(j,i) &
- +wscloc*gscloc(j,i) &
- +gradafm(j,i) &
- +wliptran*gliptranc(j,i) &
- +welec*gshieldc(j,i) &
- +welec*gshieldc_loc(j,) &
- +wcorr*gshieldc_ec(j,i) &
- +wcorr*gshieldc_loc_ec(j,i) &
- +wturn3*gshieldc_t3(j,i) &
- +wturn3*gshieldc_loc_t3(j,i) &
- +wturn4*gshieldc_t4(j,i) &
- +wturn4*gshieldc_loc_t4(j,i) &
- +wel_loc*gshieldc_ll(j,i) &
- +wel_loc*gshieldc_loc_ll(j,i) &
- +wtube*gg_tube(j,i) &
- +wbond_nucl*gradb_nucl(j,i) &
- +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
- +wvdwpsb*gvdwpsb1(j,i))&
- +wsbloc*gsbloc(j,i)
-
-
-
-
-#endif
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
- wbond*gradbx(j,i)+ &
- wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
- wsccor*gsccorx(j,i) &
- +wscloc*gsclocx(j,i) &
- +wliptran*gliptranx(j,i) &
- +welec*gshieldx(j,i) &
- +wcorr*gshieldx_ec(j,i) &
- +wturn3*gshieldx_t3(j,i) &
- +wturn4*gshieldx_t4(j,i) &
- +wel_loc*gshieldx_ll(j,i)&
- +wtube*gg_tube_sc(j,i) &
- +wbond_nucl*gradbx_nucl(j,i) &
- +wvdwsb*gvdwsbx(j,i) &
- +welsb*gelsbx(j,i) &
- +wcorr_nucl*gradxorr_nucl(j,i)&
- +wcorr3_nucl*gradxorr3_nucl(j,i) &
- +wsbloc*gsblocx(j,i) &
- +wcatprot* gradpepcatx(j,i)&
- +wscbase*gvdwx_scbase(j,i) &
- +wpepbase*gvdwx_pepbase(j,i)&
- +wscpho*gvdwx_scpho(j,i)
-! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
-
- 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
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
- +wcorr5*g_corr5_loc(i) &
- +wcorr6*g_corr6_loc(i) &
- +wturn4*gel_loc_turn4(i) &
- +wturn3*gel_loc_turn3(i) &
- +wturn6*gel_loc_turn6(i) &
- +wel_loc*gel_loc_loc(i)
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc after adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
-!#undef DEBUG
-#ifdef MPI
- if (nfgtasks.gt.1) then
- do j=1,3
- do i=0,nres
- gradbufc(j,i)=gradc(j,i,icg)
- gradbufx(j,i)=gradx(j,i,icg)
+!d goto 1112
+!grad do m=i+1,j-1
+!grad do ll=1,3
+!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
+!grad enddo
+!grad enddo
+!grad do m=k+1,l-1
+!grad do ll=1,3
+!old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
+!grad enddo
+!grad enddo
+!1112 continue
+!grad do m=i+2,j2
+!grad do ll=1,3
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
+!grad enddo
+!grad enddo
+!grad do m=k+2,l2
+!grad do ll=1,3
+!grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
+!grad enddo
+!grad enddo
+!d do iii=1,nres-3
+!d write (2,*) iii,g_corr5_loc(iii)
+!d enddo
+ eello5=ekont*eel5
+!d write (2,*) 'ekont',ekont
+!d write (iout,*) 'eello5',ekont*eel5
+ return
+ end function eello5
+!-----------------------------------------------------------------------------
+ real(kind=8) function eello6(i,j,k,l,jj,kk)
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.FFIELD'
+ real(kind=8),dimension(3) :: ggg1,ggg2
+ real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
+ eello6_6,eel6
+ real(kind=8) :: gradcorr6ij,gradcorr6kl
+ integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
+!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
+!d eello6=0.0d0
+!d return
+!d endif
+!d write (iout,*)
+!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
+!d & ' and',k,l
+ eello6_1=0.0d0
+ eello6_2=0.0d0
+ eello6_3=0.0d0
+ eello6_4=0.0d0
+ eello6_5=0.0d0
+ eello6_6=0.0d0
+!d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
+!d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ derx(lll,kkk,iii)=0.0d0
enddo
enddo
- do i=1,4*nres
- glocbuf(i)=gloc(i,icg)
- enddo
-!#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gloc_sc before reduce"
- do i=1,nres
- do j=1,1
- write (iout,*) i,j,gloc_sc(j,i,icg)
- enddo
enddo
-#endif
-!#undef DEBUG
- do i=1,nres
- do j=1,3
- gloc_scbuf(j,i)=gloc_sc(j,i,icg)
- enddo
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_g=time_barrier_g+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
- call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
- MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
-!#define DEBUG
-! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
-#ifdef DEBUG
- write (iout,*) "gloc_sc after reduce"
- do i=1,nres
- do j=1,1
- write (iout,*) i,j,gloc_sc(j,i,icg)
- enddo
- enddo
-#endif
-!#undef DEBUG
-#ifdef DEBUG
- write (iout,*) "gloc after reduce"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
- endif
-#endif
- if (gnorm_check) then
-!
-! Compute the maximum elements of the gradient
-!
- gvdwc_max=0.0d0
- gvdwc_scp_max=0.0d0
- gelc_max=0.0d0
- gvdwpp_max=0.0d0
- gradb_max=0.0d0
- ghpbc_max=0.0d0
- gradcorr_max=0.0d0
- gel_loc_max=0.0d0
- gcorr3_turn_max=0.0d0
- gcorr4_turn_max=0.0d0
- gradcorr5_max=0.0d0
- gradcorr6_max=0.0d0
- gcorr6_turn_max=0.0d0
- gsccorc_max=0.0d0
- gscloc_max=0.0d0
- gvdwx_max=0.0d0
- gradx_scp_max=0.0d0
- ghpbx_max=0.0d0
- gradxorr_max=0.0d0
- gsccorx_max=0.0d0
- gsclocx_max=0.0d0
- do i=1,nct
- gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
- if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
- gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
- if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
- gvdwc_scp_max=gvdwc_scp_norm
- gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
- if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
- gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
- if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
- gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
- if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
- ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
- if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
- gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
- if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
- gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
- if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
- gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
- gcorr3_turn(1,i)))
- if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
- gcorr3_turn_max=gcorr3_turn_norm
- gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
- gcorr4_turn(1,i)))
- if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
- gcorr4_turn_max=gcorr4_turn_norm
- gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
- if (gradcorr5_norm.gt.gradcorr5_max) &
- gradcorr5_max=gradcorr5_norm
- gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
- if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
- gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
- gcorr6_turn(1,i)))
- if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
- gcorr6_turn_max=gcorr6_turn_norm
- gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
- if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
- gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
- if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
- gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
- if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
- gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
- if (gradx_scp_norm.gt.gradx_scp_max) &
- gradx_scp_max=gradx_scp_norm
- ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
- if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
- gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
- if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
- gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
- if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
- gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
- if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
- enddo
- if (gradout) then
-#ifdef AIX
- open(istat,file=statname,position="append")
-#else
- open(istat,file=statname,access="append")
-#endif
- write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
- gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
- gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
- gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
- gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
- gsccorx_max,gsclocx_max
- close(istat)
- if (gvdwc_max.gt.1.0d4) then
- write (iout,*) "gvdwc gvdwx gradb gradbx"
- do i=nnt,nct
- write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
- gradb(j,i),gradbx(j,i),j=1,3)
- enddo
- call pdbout(0.0d0,'cipiszcze',iout)
- call flush(iout)
+!d eij=facont_hb(jj,i)
+!d ekl=facont_hb(kk,k)
+!d ekont=eij*ekl
+!d eij=1.0d0
+!d ekl=1.0d0
+!d ekont=1.0d0
+ if (l.eq.j+1) then
+ eello6_1=eello6_graph1(i,j,k,l,1,.false.)
+ eello6_2=eello6_graph1(j,i,l,k,2,.false.)
+ eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
+ eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
+ eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
+ eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
+ else
+ eello6_1=eello6_graph1(i,j,k,l,1,.false.)
+ eello6_2=eello6_graph1(l,k,j,i,2,.true.)
+ eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
+ eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
+ if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
+ eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
+ else
+ eello6_5=0.0d0
endif
+ eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
endif
+! If turn contributions are considered, they will be handled separately.
+ eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
+!d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
+!d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
+!d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
+!d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
+!d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
+!d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
+!d goto 1112
+ if (j.lt.nres-1) then
+ j1=j+1
+ j2=j-1
+ else
+ j1=j-1
+ j2=j-2
endif
-!#define DEBUG
-#ifdef DEBUG
- write (iout,*) "gradc gradx gloc"
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
- i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
- enddo
-#endif
-!#undef DEBUG
-#ifdef TIMING
- time_sumgradient=time_sumgradient+MPI_Wtime()-time01
-#endif
+ if (l.lt.nres-1) then
+ l1=l+1
+ l2=l-1
+ else
+ l1=l-1
+ l2=l-2
+ endif
+ do ll=1,3
+!grad ggg1(ll)=eel6*g_contij(ll,1)
+!grad ggg2(ll)=eel6*g_contij(ll,2)
+!old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
+!grad ghalf=0.5d0*ggg1(ll)
+!d ghalf=0.0d0
+ gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
+ gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
+ gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
+ gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
+ gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
+ gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
+ gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
+ gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
+!grad ghalf=0.5d0*ggg2(ll)
+!old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
+!d ghalf=0.0d0
+ gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
+ gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
+ gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
+ gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
+ gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
+ gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
+ enddo
+!d goto 1112
+!grad do m=i+1,j-1
+!grad do ll=1,3
+!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
+!grad enddo
+!grad enddo
+!grad do m=k+1,l-1
+!grad do ll=1,3
+!old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
+!grad enddo
+!grad enddo
+!grad1112 continue
+!grad do m=i+2,j2
+!grad do ll=1,3
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
+!grad enddo
+!grad enddo
+!grad do m=k+2,l2
+!grad do ll=1,3
+!grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
+!grad enddo
+!grad enddo
+!d do iii=1,nres-3
+!d write (2,*) iii,g_corr6_loc(iii)
+!d enddo
+ eello6=ekont*eel6
+!d write (2,*) 'ekont',ekont
+!d write (iout,*) 'eello6',ekont*eel6
return
- end subroutine sum_gradient
+ end function eello6
!-----------------------------------------------------------------------------
- subroutine sc_grad
-! implicit real*8 (a-h,o-z)
- use calc_data
+ real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
+ use comm_kut
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
-! include 'COMMON.CALC'
-! include 'COMMON.IOUNITS'
- real(kind=8), dimension(3) :: dcosom1,dcosom2
-! print *,"wchodze"
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
- +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
- +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
-
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
- -2.0D0*alf12*eps3der+sigder*sigsq_om12&
- +dCAVdOM12+ dGCLdOM12
-! diagnostics only
-! eom1=0.0d0
-! eom2=0.0d0
-! eom12=evdwij*eps1_om12
-! end diagnostics
-! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
-! " sigder",sigder
-! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
-!C print *,sss_ele_cut,'in sc_grad'
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- do k=1,3
- gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
-!C print *,'gg',k,gg(k)
- enddo
-! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
-! write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
- *sss_ele_cut
-
- gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
- *sss_ele_cut
-
-! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
-! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
-! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-!
-! Calculate the components of the gradient in DC and X
-!
-!grad do k=i,j-1
-!grad do l=1,3
-!grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-!grad enddo
-!grad enddo
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ real(kind=8),dimension(2) :: vv,vv1
+ real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
+ logical :: swap
+!el logical :: lprn
+!el common /kutas/ lprn
+ integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
+ real(kind=8) :: s1,s2,s3,s4,s5
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel Antiparallel C
+! C
+! o o C
+! /l\ /j\ C
+! / \ / \ C
+! /| o | | o |\ C
+! \ j|/k\| / \ |/k\|l / C
+! \ / \ / \ / \ / C
+! o o o o C
+! i i C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+ itk=itortyp(itype(k,1))
+ s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
+ s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
+ s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
+ call transpose2(EUgC(1,1,k),auxmat(1,1))
+ call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
+ vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
+ vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
+ s5=scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
+ eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
+ if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
+ -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
+ -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
+ +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
+ +scalar2(vv(1),Dtobr2der(1,i)))
+ call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
+ vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
+ if (l.eq.j+1) then
+ g_corr6_loc(l-1)=g_corr6_loc(l-1) &
+ +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
+ -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
+ +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
+ else
+ g_corr6_loc(j-1)=g_corr6_loc(j-1) &
+ +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
+ -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
+ +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
+ endif
+ call transpose2(EUgCder(1,1,k),auxmat(1,1))
+ call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
+ +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
+ +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
+ +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
+ do iii=1,2
+ if (swap) then
+ ind=3-iii
+ else
+ ind=iii
+ endif
+ do kkk=1,5
+ do lll=1,3
+ s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
+ s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
+ s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
+ call transpose2(EUgC(1,1,k),auxmat(1,1))
+ call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
+ pizda1(1,1))
+ vv1(1)=pizda1(1,1)-pizda1(2,2)
+ vv1(2)=pizda1(1,2)+pizda1(2,1)
+ s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
+ vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
+ -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
+ vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
+ +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
+ s5=scalar2(vv(1),Dtobr2(1,i))
+ derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
+ enddo
+ enddo
enddo
return
- end subroutine sc_grad
-#ifdef CRYST_THETA
+ end function eello6_graph1
!-----------------------------------------------------------------------------
- subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
-
- use comm_calcthet
-! implicit real*8 (a-h,o-z)
+ real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
+ use comm_kut
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.LOCAL'
! include 'COMMON.IOUNITS'
-!el real(kind=8) :: term1,term2,termm,diffak,ratak,&
-!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
-!el delthe0,sig0inv,sigtc,sigsqtc,delthec,
- real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
- real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
-!el integer :: it
-!el common /calcthet/ term1,term2,termm,diffak,ratak,&
-!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
-!el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
-!el local variables
-
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
-! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
- t3 = thetai-thet_pred_mean
- t6 = t3**2
- t9 = term1
- t12 = t3*sigcsq
- t14 = t12+t6*sigsqtc
- t16 = 1.0d0
- t21 = thetai-theta0i
- t23 = t21**2
- t26 = term2
- t27 = t21*t26
- t32 = termexp
- t40 = t32**2
- E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
- -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
- *(-t12*t9-ak*sig0inv*t27)
- return
- end subroutine mixder
-#endif
-!-----------------------------------------------------------------------------
-! cartder.F
-!-----------------------------------------------------------------------------
- subroutine cartder
-!-----------------------------------------------------------------------------
-! This subroutine calculates the derivatives of the consecutive virtual
-! bond vectors and the SC vectors in the virtual-bond angles theta and
-! virtual-torsional angles phi, as well as the derivatives of SC vectors
-! in the angles alpha and omega, describing the location of a side chain
-! in its local coordinate system.
-!
-! The derivatives are stored in the following arrays:
-!
-! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
-! The structure is as follows:
-!
-! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
-! dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4)
-! . . . . . . . . . . . . . . . . . .
-! dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4)
-! .
-! .
-! .
-! dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N)
-!
-! DXDV - the derivatives of the side-chain vectors in theta and phi.
-! The structure is same as above.
-!
-! DCDS - the derivatives of the side chain vectors in the local spherical
-! andgles alph and omega:
-!
-! dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2)
-! dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3)
-! .
-! .
-! .
-! dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1)
-!
-! Version of March '95, based on an early version of November '91.
-!
-!**********************************************************************
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.VAR'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
! include 'COMMON.INTERACT'
- real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
- real(kind=8),dimension(3,3) :: dp,temp
-!el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
- real(kind=8),dimension(3) :: xx,xx1
-!el local variables
- integer :: i,k,l,j,m,ind,ind1,jjj
- real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
- tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
- sint2,xp,yp,xxp,yyp,zzp,dj
-
-! common /przechowalnia/ fromto
- if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
-! get the position of the jth ijth fragment of the chain coordinate system
-! in the fromto array.
-! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
-!
-! maxdim=(nres-1)*(nres-2)/2
-! allocate(dcdv(6,maxdim),dxds(6,nres))
-! calculate the derivatives of transformation matrix elements in theta
-!
-
-!el call flush(iout) !el
- do i=1,nres-2
- rdt(1,1,i)=-rt(1,2,i)
- rdt(1,2,i)= rt(1,1,i)
- rdt(1,3,i)= 0.0d0
- rdt(2,1,i)=-rt(2,2,i)
- rdt(2,2,i)= rt(2,1,i)
- rdt(2,3,i)= 0.0d0
- rdt(3,1,i)=-rt(3,2,i)
- rdt(3,2,i)= rt(3,1,i)
- rdt(3,3,i)= 0.0d0
- enddo
-!
-! derivatives in phi
-!
- do i=2,nres-2
- drt(1,1,i)= 0.0d0
- drt(1,2,i)= 0.0d0
- drt(1,3,i)= 0.0d0
- drt(2,1,i)= rt(3,1,i)
- drt(2,2,i)= rt(3,2,i)
- drt(2,3,i)= rt(3,3,i)
- drt(3,1,i)=-rt(2,1,i)
- drt(3,2,i)=-rt(2,2,i)
- drt(3,3,i)=-rt(2,3,i)
- enddo
-!
-! generate the matrix products of type r(i)t(i)...r(j)t(j)
-!
- do i=2,nres-2
- ind=indmat(i,i+1)
- do k=1,3
- do l=1,3
- temp(k,l)=rt(k,l,i)
- enddo
- enddo
- do k=1,3
- do l=1,3
- fromto(k,l,ind)=temp(k,l)
- enddo
- enddo
- do j=i+1,nres-2
- ind=indmat(i,j+1)
- do k=1,3
- do l=1,3
- dpkl=0.0d0
- do m=1,3
- dpkl=dpkl+temp(k,m)*rt(m,l,j)
- enddo
- dp(k,l)=dpkl
- fromto(k,l,ind)=dpkl
- enddo
- enddo
- do k=1,3
- do l=1,3
- temp(k,l)=dp(k,l)
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ logical :: swap
+ real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
+ real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
+!el logical :: lprn
+!el common /kutas/ lprn
+ integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
+ real(kind=8) :: s2,s3,s4
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel Antiparallel C
+! C
+! o o C
+! \ /l\ /j\ / C
+! \ / \ / \ / C
+! o| o | | o |o C
+! \ j|/k\| \ |/k\|l C
+! \ / \ \ / \ C
+! o o C
+! i i C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
+! AL 7/4/01 s1 would occur in the sixth-order moment,
+! but not in a cluster cumulant
+#ifdef MOMENT
+ s1=dip(1,jj,i)*dip(1,kk,k)
+#endif
+ call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
+#ifdef MOMENT
+ eello6_graph2=-(s1+s2+s3+s4)
+#else
+ eello6_graph2=-(s2+s3+s4)
+#endif
+! eello6_graph2=-s3
+! Derivatives in gamma(i-1)
+ if (i.gt.1) then
+#ifdef MOMENT
+ s1=dipderg(1,jj,i)*dip(1,kk,k)
+#endif
+ s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
+ call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+ s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
+#ifdef MOMENT
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
+#else
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
+#endif
+! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
+ endif
+! Derivatives in gamma(k-1)
+#ifdef MOMENT
+ s1=dip(1,jj,i)*dipderg(1,kk,k)
+#endif
+ call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+ call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+ call transpose2(EUgder(1,1,k),auxmat1(1,1))
+ call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
+#else
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
+#endif
+! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
+! Derivatives in gamma(j-1) or gamma(l-1)
+ if (j.gt.1) then
+#ifdef MOMENT
+ s1=dipderg(3,jj,i)*dip(1,kk,k)
+#endif
+ call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
+ call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+ if (swap) then
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
+ else
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
+ endif
+#endif
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
+! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
+ endif
+! Derivatives in gamma(l-1) or gamma(j-1)
+ if (l.gt.1) then
+#ifdef MOMENT
+ s1=dip(1,jj,i)*dipderg(3,kk,k)
+#endif
+ call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+ call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+ call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+ if (swap) then
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
+ else
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
+ endif
+#endif
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
+! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
+ endif
+! Cartesian derivatives.
+ if (lprn) then
+ write (2,*) 'In eello6_graph2'
+ do iii=1,2
+ write (2,*) 'iii=',iii
+ do kkk=1,5
+ write (2,*) 'kkk=',kkk
+ do jjj=1,2
+ write (2,'(3(2f10.5),5x)') &
+ ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
enddo
enddo
enddo
- enddo
-!
-! Calculate derivatives.
-!
- ind1=0
- do i=1,nres-2
- ind1=ind1+1
-!
-! Derivatives of DC(i+1) in theta(i+2)
-!
- do j=1,3
- do k=1,2
- dpjk=0.0D0
- do l=1,3
- dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
- enddo
- dp(j,k)=dpjk
- prordt(j,k,i)=dp(j,k)
+ endif
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+#ifdef MOMENT
+ if (iii.eq.1) then
+ s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
+ else
+ s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
+ endif
+#endif
+ call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
+ auxvec(1))
+ s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
+ auxvec(1))
+ s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(1,2)+pizda(2,1)
+ s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
+#ifdef MOMENT
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
+#endif
+ if (swap) then
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+ else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ endif
enddo
- dp(j,3)=0.0D0
- dcdv(j,ind1)=vbld(i+1)*dp(j,1)
enddo
-!
-! Derivatives of SC(i+1) in theta(i+2)
-!
- xx1(1)=-0.5D0*xloc(2,i+1)
- xx1(2)= 0.5D0*xloc(1,i+1)
- do j=1,3
- xj=0.0D0
- do k=1,2
- xj=xj+r(j,k,i)*xx1(k)
- enddo
- xx(j)=xj
- enddo
- do j=1,3
- rj=0.0D0
- do k=1,3
- rj=rj+prod(j,k,i)*xx(k)
- enddo
- dxdv(j,ind1)=rj
- enddo
-!
-! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
-! than the other off-diagonal derivatives.
-!
- do j=1,3
- dxoiij=0.0D0
- do k=1,3
- dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
- enddo
- dxdv(j,ind1+1)=dxoiij
- enddo
-!d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
-!
-! Derivatives of DC(i+1) in phi(i+2)
-!
- do j=1,3
- do k=1,3
- dpjk=0.0
- do l=2,3
- dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
- enddo
- dp(j,k)=dpjk
- prodrt(j,k,i)=dp(j,k)
- enddo
- dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
- enddo
-!
-! Derivatives of SC(i+1) in phi(i+2)
-!
- xx(1)= 0.0D0
- xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
- xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
- do j=1,3
- rj=0.0D0
- do k=2,3
- rj=rj+prod(j,k,i)*xx(k)
- enddo
- dxdv(j+3,ind1)=-rj
- enddo
-!
-! Derivatives of SC(i+1) in phi(i+3).
-!
- do j=1,3
- dxoiij=0.0D0
- do k=1,3
- dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
- enddo
- dxdv(j+3,ind1+1)=dxoiij
- enddo
-!
-! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
-! theta(nres) and phi(i+3) thru phi(nres).
-!
- do j=i+1,nres-2
- ind1=ind1+1
- ind=indmat(i+1,j+1)
-!d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
- do k=1,3
- do l=1,3
- tempkl=0.0D0
- do m=1,2
- tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
- enddo
- temp(k,l)=tempkl
- enddo
- enddo
-!d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
-!d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
-!d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
-! Derivatives of virtual-bond vectors in theta
- do k=1,3
- dcdv(k,ind1)=vbld(i+1)*temp(k,1)
- enddo
-!d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
-! Derivatives of SC vectors in theta
- do k=1,3
- dxoijk=0.0D0
- do l=1,3
- dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
- enddo
- dxdv(k,ind1+1)=dxoijk
- enddo
-!
-!--- Calculate the derivatives in phi
-!
- do k=1,3
- do l=1,3
- tempkl=0.0D0
- do m=1,3
- tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
- enddo
- temp(k,l)=tempkl
- enddo
- enddo
- do k=1,3
- dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
- enddo
- do k=1,3
- dxoijk=0.0D0
- do l=1,3
- dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
- enddo
- dxdv(k+3,ind1+1)=dxoijk
- enddo
- enddo
- enddo
-!
-! Derivatives in alpha and omega:
-!
- do i=2,nres-1
-! dsci=dsc(itype(i,1))
- dsci=vbld(i+nres)
-#ifdef OSF
- alphi=alph(i)
- omegi=omeg(i)
- if(alphi.ne.alphi) alphi=100.0
- if(omegi.ne.omegi) omegi=-100.0
-#else
- alphi=alph(i)
- omegi=omeg(i)
-#endif
-!d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
- cosalphi=dcos(alphi)
- sinalphi=dsin(alphi)
- cosomegi=dcos(omegi)
- sinomegi=dsin(omegi)
- temp(1,1)=-dsci*sinalphi
- temp(2,1)= dsci*cosalphi*cosomegi
- temp(3,1)=-dsci*cosalphi*sinomegi
- temp(1,2)=0.0D0
- temp(2,2)=-dsci*sinalphi*sinomegi
- temp(3,2)=-dsci*sinalphi*cosomegi
- theta2=pi-0.5D0*theta(i+1)
- cost2=dcos(theta2)
- sint2=dsin(theta2)
- jjj=0
-!d print *,((temp(l,k),l=1,3),k=1,2)
- do j=1,2
- xp=temp(1,j)
- yp=temp(2,j)
- xxp= xp*cost2+yp*sint2
- yyp=-xp*sint2+yp*cost2
- zzp=temp(3,j)
- xx(1)=xxp
- xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
- xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
- do k=1,3
- dj=0.0D0
- do l=1,3
- dj=dj+prod(k,l,i-1)*xx(l)
- enddo
- dxds(jjj+k,i)=dj
- enddo
- jjj=jjj+3
- enddo
enddo
return
- end subroutine cartder
-!-----------------------------------------------------------------------------
-! checkder_p.F
+ end function eello6_graph2
!-----------------------------------------------------------------------------
- subroutine check_cartgrad
-! Check the gradient of Cartesian coordinates in internal coordinates.
-! implicit real*8 (a-h,o-z)
+ real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
! include 'COMMON.CHAIN'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
! include 'COMMON.DERIV'
- real(kind=8),dimension(6,nres) :: temp
- real(kind=8),dimension(3) :: xx,gg
- integer :: i,k,j,ii
- real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
-! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ real(kind=8),dimension(2) :: vv,auxvec
+ real(kind=8),dimension(2,2) :: pizda,auxmat
+ logical :: swap
+ integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
+ real(kind=8) :: s1,s2,s3,s4
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel Antiparallel C
+! C
+! o o C
+! /l\ / \ /j\ C
+! / \ / \ / \ C
+! /| o |o o| o |\ C
+! j|/k\| / |/k\|l / C
+! / \ / / \ / C
+! / o / o C
+! i i C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!
-! Check the gradient of the virtual-bond and SC vectors in the internal
-! coordinates.
-!
- aincr=1.0d-6
- aincr2=5.0d-7
- call cartder
- write (iout,'(a)') '**************** dx/dalpha'
- write (iout,'(a)')
- do i=2,nres-1
- alphi=alph(i)
- alph(i)=alph(i)+aincr
- do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
- do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
- i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- alph(i)=alphi
- call chainbuild
- enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/domega'
- write (iout,'(a)')
- do i=2,nres-1
- omegi=omeg(i)
- omeg(i)=omeg(i)+aincr
- do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
- do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
- (aincr*dabs(dxds(k+3,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
- i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- omeg(i)=omegi
- call chainbuild
- enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/dtheta'
- write (iout,'(a)')
- do i=3,nres
- theti=theta(i)
- theta(i)=theta(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-! print *,'i=',i-2,' j=',j-1,' ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
- (aincr*dabs(dxdv(k,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- write (iout,'(a)')
- theta(i)=theti
- call chainbuild
- enddo
- write (iout,'(a)') '***************** dx/dphi'
- write (iout,'(a)')
- do i=4,nres
- phi(i)=phi(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-! print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
- (aincr*dabs(dxdv(k+3,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- phi(i)=phi(i)-aincr
- call chainbuild
- enddo
- write (iout,'(a)') '****************** ddc/dtheta'
- do i=1,nres-2
- thet=theta(i+2)
- theta(i+2)=thet+aincr
- do j=i,nres
- do k=1,3
- temp(k,j)=dc(k,j)
- enddo
- enddo
- call chainbuild
- do j=i+1,nres-1
- ii = indmat(i,j)
-! print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
- (aincr*dabs(dcdv(k,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- enddo
- do j=1,nres
- do k=1,3
- dc(k,j)=temp(k,j)
- enddo
- enddo
- theta(i+2)=thet
- enddo
- write (iout,'(a)') '******************* ddc/dphi'
- do i=1,nres-3
- phii=phi(i+3)
- phi(i+3)=phii+aincr
- do j=1,nres
- do k=1,3
- temp(k,j)=dc(k,j)
- enddo
- enddo
- call chainbuild
- do j=i+2,nres-1
- ii = indmat(i+1,j)
-! print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
- (aincr*dabs(dcdv(k+3,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
- i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- enddo
- do j=1,nres
- do k=1,3
- dc(k,j)=temp(k,j)
+! 4/7/01 AL Component s1 was removed, because it pertains to the respective
+! energy moment and not to the cluster cumulant.
+ iti=itortyp(itype(i,1))
+ if (j.lt.nres-1) then
+ itj1=itortyp(itype(j+1,1))
+ else
+ itj1=ntortyp+1
+ endif
+ itk=itortyp(itype(k,1))
+ itk1=itortyp(itype(k+1,1))
+ if (l.lt.nres-1) then
+ itl1=itortyp(itype(l+1,1))
+ else
+ itl1=ntortyp+1
+ endif
+#ifdef MOMENT
+ s1=dip(4,jj,i)*dip(4,kk,k)
+#endif
+ call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
+ s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
+ call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
+ s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
+ call transpose2(EE(1,1,itk),auxmat(1,1))
+ call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+!d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
+!d & "sum",-(s2+s3+s4)
+#ifdef MOMENT
+ eello6_graph3=-(s1+s2+s3+s4)
+#else
+ eello6_graph3=-(s2+s3+s4)
+#endif
+! eello6_graph3=-s4
+! Derivatives in gamma(k-1)
+ call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
+ s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
+ s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
+! Derivatives in gamma(l-1)
+ call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
+ s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
+ call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
+! Cartesian derivatives.
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+#ifdef MOMENT
+ if (iii.eq.1) then
+ s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
+ else
+ s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
+ endif
+#endif
+ call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
+ auxvec(1))
+ s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
+ call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
+ auxvec(1))
+ s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
+ call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)+pizda(2,2)
+ vv(2)=pizda(2,1)-pizda(1,2)
+ s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+#ifdef MOMENT
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
+#endif
+ if (swap) then
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+ else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ endif
+! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
enddo
enddo
- phi(i+3)=phii
enddo
return
- end subroutine check_cartgrad
+ end function eello6_graph3
!-----------------------------------------------------------------------------
- subroutine check_ecart
-! Check the gradient of the energy in Cartesian coordinates.
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
-! include 'COMMON.CONTACTS'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- real(kind=8),dimension(6) :: ggg
- real(kind=8),dimension(3) :: cc,xx,ddc,ddx
- real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
- real(kind=8),dimension(6,nres) :: grad_s
- real(kind=8),dimension(0:n_ene) :: energia,energia1
- integer :: uiparm(1)
- real(kind=8) :: urparm(1)
-!EL external fdum
- integer :: nf,i,j,k
- real(kind=8) :: aincr,etot,etot1
- icg=1
- nf=0
- nfl=0
- call zerograd
- aincr=1.0D-5
- print '(a)','CG processor',me,' calling CHECK_CART.',aincr
- nf=0
- icall=0
- call geom_to_var(nvar,x)
- call etotal(energia)
- etot=energia(0)
-!el call enerprint(energia)
- call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gradc(j,i,icg)
- grad_s(j+3,i)=gradx(j,i,icg)
- enddo
- enddo
- call flush(iout)
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
- do i=1,nres
- do j=1,3
- xx(j)=c(j,i+nres)
- ddc(j)=dc(j,i)
- ddx(j)=dc(j,i+nres)
- enddo
- do j=1,3
- dc(j,i)=dc(j,i)+aincr
- do k=i+1,nres
- c(j,k)=c(j,k)+aincr
- c(j,k+nres)=c(j,k+nres)+aincr
- enddo
- call zerograd
- call etotal(energia1)
- etot1=energia1(0)
- ggg(j)=(etot1-etot)/aincr
- dc(j,i)=ddc(j)
- do k=i+1,nres
- c(j,k)=c(j,k)-aincr
- c(j,k+nres)=c(j,k+nres)-aincr
- enddo
- enddo
- do j=1,3
- c(j,i+nres)=c(j,i+nres)+aincr
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call zerograd
- call etotal(energia1)
- etot1=energia1(0)
- ggg(j+3)=(etot1-etot)/aincr
- c(j,i+nres)=xx(j)
- dc(j,i+nres)=ddx(j)
- enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
- enddo
- return
- end subroutine check_ecart
-#ifdef CARGRAD
-!-----------------------------------------------------------------------------
- subroutine check_ecartint
-! Check the gradient of the energy in Cartesian coordinates.
- use io_base, only: intout
-! implicit real*8 (a-h,o-z)
+ real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
+! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
+! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
-! include 'COMMON.MD'
-! include 'COMMON.LOCAL'
-! include 'COMMON.SPLITELE'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- real(kind=8),dimension(6) :: ggg,ggg1
- real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
- real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
- real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
- real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
- real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
- real(kind=8),dimension(0:n_ene) :: energia,energia1
- integer :: uiparm(1)
- real(kind=8) :: urparm(1)
-!EL external fdum
- integer :: i,j,k,nf
- real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
- etot21,etot22
- r_cut=2.0d0
- rlambd=0.3d0
- icg=1
- nf=0
- nfl=0
- call intout
-! call intcartderiv
-! call checkintcartgrad
- call zerograd
- aincr=1.0D-4
- write(iout,*) 'Calling CHECK_ECARTINT.'
- nf=0
- icall=0
- call geom_to_var(nvar,x)
- write (iout,*) "split_ene ",split_ene
- call flush(iout)
- if (.not.split_ene) then
- call zerograd
- call etotal(energia)
- etot=energia(0)
- call cartgrad
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
- enddo
- enddo
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+! include 'COMMON.FFIELD'
+ real(kind=8),dimension(2) :: vv,auxvec,auxvec1
+ real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
+ logical :: swap
+ integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
+ iii,kkk,lll
+ real(kind=8) :: s1,s2,s3,s4
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! C
+! Parallel Antiparallel C
+! C
+! o o C
+! /l\ / \ /j\ C
+! / \ / \ / \ C
+! /| o |o o| o |\ C
+! \ j|/k\| \ |/k\|l C
+! \ / \ \ / \ C
+! o \ o \ C
+! i i C
+! C
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!
+! 4/7/01 AL Component s1 was removed, because it pertains to the respective
+! energy moment and not to the cluster cumulant.
+!d write (2,*) 'eello_graph4: wturn6',wturn6
+ iti=itortyp(itype(i,1))
+ itj=itortyp(itype(j,1))
+ if (j.lt.nres-1) then
+ itj1=itortyp(itype(j+1,1))
else
-!- split gradient check
- call zerograd
- call etotal_long(energia)
-!el call enerprint(energia)
- call cartgrad
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
- enddo
- enddo
- call zerograd
- call etotal_short(energia)
- call enerprint(energia)
- call cartgrad
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s1(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s1(j,i)=gcart(j,i)
- grad_s1(j+3,i)=gxcart(j,i)
- enddo
- enddo
+ itj1=ntortyp+1
endif
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
-! do i=1,nres
- do i=nnt,nct
- do j=1,3
- if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
- if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
- ddc(j)=c(j,i)
- ddx(j)=c(j,i+nres)
- dcnorm_safe1(j)=dc_norm(j,i-1)
- dcnorm_safe2(j)=dc_norm(j,i)
- dxnorm_safe(j)=dc_norm(j,i+nres)
- enddo
- do j=1,3
- c(j,i)=ddc(j)+aincr
- if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
- if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
- if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
- dc(j,i)=c(j,i+1)-c(j,i)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call zerograd
- call etotal(energia1)
- etot1=energia1(0)
- write (iout,*) "ij",i,j," etot1",etot1
- else
-!- split gradient
- call etotal_long(energia1)
- etot11=energia1(0)
- call etotal_short(energia1)
- etot12=energia1(0)
- endif
-!- end split gradient
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- c(j,i)=ddc(j)-aincr
- if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
- if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
- if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
- dc(j,i)=c(j,i+1)-c(j,i)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call zerograd
- call etotal(energia1)
- etot2=energia1(0)
- write (iout,*) "ij",i,j," etot2",etot2
- ggg(j)=(etot1-etot2)/(2*aincr)
- else
-!- split gradient
- call etotal_long(energia1)
- etot21=energia1(0)
- ggg(j)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1)
- etot22=energia1(0)
- ggg1(j)=(etot12-etot22)/(2*aincr)
-!- end split gradient
-! write (iout,*) "etot21",etot21," etot22",etot22
- endif
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- c(j,i)=ddc(j)
- if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
- if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
- if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
- dc(j,i)=c(j,i+1)-c(j,i)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i-1)=dcnorm_safe1(j)
- dc_norm(j,i)=dcnorm_safe2(j)
- dc_norm(j,i+nres)=dxnorm_safe(j)
- enddo
- do j=1,3
- c(j,i+nres)=ddx(j)+aincr
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call zerograd
- call etotal(energia1)
- etot1=energia1(0)
- else
-!- split gradient
- call etotal_long(energia1)
- etot11=energia1(0)
- call etotal_short(energia1)
- etot12=energia1(0)
- endif
-!- end split gradient
- c(j,i+nres)=ddx(j)-aincr
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- call int_from_cart1(.false.)
- if (.not.split_ene) then
- call zerograd
- call etotal(energia1)
- etot2=energia1(0)
- ggg(j+3)=(etot1-etot2)/(2*aincr)
- else
-!- split gradient
- call etotal_long(energia1)
- etot21=energia1(0)
- ggg(j+3)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1)
- etot22=energia1(0)
- ggg1(j+3)=(etot12-etot22)/(2*aincr)
-!- end split gradient
- endif
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- c(j,i+nres)=ddx(j)
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dxnorm_safe(j)
- call int_from_cart1(.false.)
- enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
- if (split_ene) then
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
- k=1,6)
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
- ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
+ itk=itortyp(itype(k,1))
+ if (k.lt.nres-1) then
+ itk1=itortyp(itype(k+1,1))
+ else
+ itk1=ntortyp+1
+ endif
+ itl=itortyp(itype(l,1))
+ if (l.lt.nres-1) then
+ itl1=itortyp(itype(l+1,1))
+ else
+ itl1=ntortyp+1
+ endif
+!d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
+!d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
+!d & ' itl',itl,' itl1',itl1
+#ifdef MOMENT
+ if (imat.eq.1) then
+ s1=dip(3,jj,i)*dip(3,kk,k)
+ else
+ s1=dip(2,jj,j)*dip(2,kk,l)
+ endif
+#endif
+ call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
+ else
+ call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
+ endif
+ call transpose2(EUg(1,1,k),auxmat(1,1))
+ call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+!d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
+#ifdef MOMENT
+ eello6_graph4=-(s1+s2+s3+s4)
+#else
+ eello6_graph4=-(s2+s3+s4)
+#endif
+! Derivatives in gamma(i-1)
+ if (i.gt.1) then
+#ifdef MOMENT
+ if (imat.eq.1) then
+ s1=dipderg(2,jj,i)*dip(3,kk,k)
+ else
+ s1=dipderg(4,jj,j)*dip(2,kk,l)
+ endif
+#endif
+ s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
+ else
+ call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
+ endif
+ s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+!d write (2,*) 'turn6 derivatives'
+#ifdef MOMENT
+ gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
+#else
+ gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
+#endif
+ else
+#ifdef MOMENT
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
+#else
+ g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
+#endif
+ endif
+ endif
+! Derivatives in gamma(k-1)
+#ifdef MOMENT
+ if (imat.eq.1) then
+ s1=dip(3,jj,i)*dipderg(2,kk,k)
+ else
+ s1=dip(2,jj,j)*dipderg(4,kk,l)
+ endif
+#endif
+ call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
+ else
+ call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
+ endif
+ call transpose2(EUgder(1,1,k),auxmat1(1,1))
+ call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+#ifdef MOMENT
+ gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
+#else
+ gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
+#endif
+ else
+#ifdef MOMENT
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
+#else
+ g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
+#endif
+ endif
+! Derivatives in gamma(j-1) or gamma(l-1)
+ if (l.eq.j+1 .and. l.gt.1) then
+ call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
+ else if (j.gt.1) then
+ call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+ gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
+ else
+ g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
endif
+ endif
+! Cartesian derivatives.
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+#ifdef MOMENT
+ if (iii.eq.1) then
+ if (imat.eq.1) then
+ s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
+ else
+ s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
+ endif
+ else
+ if (imat.eq.1) then
+ s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
+ else
+ s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
+ endif
+ endif
+#endif
+ call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
+ auxvec(1))
+ s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+ if (j.eq.l+1) then
+ call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
+ b1(1,itj1),auxvec(1))
+ s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
+ else
+ call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
+ b1(1,itl1),auxvec(1))
+ s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
+ endif
+ call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
+ pizda(1,1))
+ vv(1)=pizda(1,1)-pizda(2,2)
+ vv(2)=pizda(2,1)+pizda(1,2)
+ s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+ if (swap) then
+ if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+#ifdef MOMENT
+ derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
+ -(s1+s2+s4)
+#else
+ derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
+ -(s2+s4)
+#endif
+ derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
+ else
+#ifdef MOMENT
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
+#else
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
+#endif
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ endif
+ else
+#ifdef MOMENT
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
+#endif
+ if (l.eq.j+1) then
+ derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+ else
+ derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+ endif
+ endif
+ enddo
+ enddo
enddo
return
- end subroutine check_ecartint
-#else
+ end function eello6_graph4
!-----------------------------------------------------------------------------
- subroutine check_ecartint
-! Check the gradient of the energy in Cartesian coordinates.
- use io_base, only: intout
-! implicit real*8 (a-h,o-z)
+ real(kind=8) function eello_turn6(i,jj,kk)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
+! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
+! include 'COMMON.INTERACT'
! include 'COMMON.CONTACTS'
-! include 'COMMON.MD'
-! include 'COMMON.LOCAL'
-! include 'COMMON.SPLITELE'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- real(kind=8),dimension(6) :: ggg,ggg1
- real(kind=8),dimension(3) :: cc,xx,ddc,ddx
- real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
- real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
- real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
- real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
- real(kind=8),dimension(0:n_ene) :: energia,energia1
- integer :: uiparm(1)
- real(kind=8) :: urparm(1)
-!EL external fdum
- integer :: i,j,k,nf
- real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
- etot21,etot22
- r_cut=2.0d0
- rlambd=0.3d0
- icg=1
- nf=0
- nfl=0
- call intout
-! call intcartderiv
-! call checkintcartgrad
- call zerograd
- aincr=2.0D-5
- write(iout,*) 'Calling CHECK_ECARTINT.',aincr
- nf=0
- icall=0
- call geom_to_var(nvar,x)
- if (.not.split_ene) then
- call etotal(energia)
- etot=energia(0)
-!el call enerprint(energia)
- call cartgrad
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
-! 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
- else
-!- split gradient check
- call zerograd
- call etotal_long(energia)
-!el call enerprint(energia)
- call cartgrad
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
-! 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 cartgrad
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s1(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s1(j,i)=gcart(j,i)
- grad_s1(j+3,i)=gxcart(j,i)
- enddo
- enddo
- endif
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
- do i=0,nres
- do j=1,3
- xx(j)=c(j,i+nres)
- ddc(j)=dc(j,i)
- ddx(j)=dc(j,i+nres)
- do k=1,3
- dcnorm_safe(k)=dc_norm(k,i)
- dxnorm_safe(k)=dc_norm(k,i+nres)
+! include 'COMMON.TORSION'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
+ real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
+ real(kind=8),dimension(3) :: ggg1,ggg2
+ real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
+ real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
+! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
+! the respective energy moment and not to the cluster cumulant.
+!el local variables
+ integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
+ integer :: j1,j2,l1,l2,ll
+ real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
+ real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
+ s1=0.0d0
+ s8=0.0d0
+ s13=0.0d0
+!
+ eello_turn6=0.0d0
+ j=i+4
+ k=i+1
+ l=i+3
+ iti=itortyp(itype(i,1))
+ itk=itortyp(itype(k,1))
+ itk1=itortyp(itype(k+1,1))
+ itl=itortyp(itype(l,1))
+ itj=itortyp(itype(j,1))
+!d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
+!d write (2,*) 'i',i,' k',k,' j',j,' l',l
+!d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
+!d eello6=0.0d0
+!d return
+!d endif
+!d write (iout,*)
+!d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
+!d & ' and',k,l
+!d call checkint_turn6(i,jj,kk,eel_turn6_num)
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+ derx_turn(lll,kkk,iii)=0.0d0
enddo
enddo
- 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.
-! if (nfgtasks.gt.1)
-! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#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)
- etot11=energia1(0)
- call etotal_short(energia1)
- etot12=energia1(0)
-! write (iout,*) "etot11",etot11," etot12",etot12
- endif
-!- end split gradient
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- 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)
- else
-!- split gradient
- call etotal_long(energia1)
- etot21=energia1(0)
- ggg(j)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1)
- etot22=energia1(0)
- ggg1(j)=(etot12-etot22)/(2*aincr)
-!- end split gradient
-! write (iout,*) "etot21",etot21," etot22",etot22
- endif
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- dc(j,i)=ddc(j)
- call chainbuild_cart
- enddo
- 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)
-! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
-! write (iout,*) "dxnormnorm",dsqrt(
-! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
-! write (iout,*) "dxnormnormsafe",dsqrt(
-! & 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
-!- split gradient
- call etotal_long(energia1)
- etot11=energia1(0)
- call etotal_short(energia1)
- etot12=energia1(0)
- endif
-!- end split gradient
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- 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,'(3f15.10)') (dxnorm_safe(k),k=1,3)
-! write (iout,*)
-! write (iout,*) "dxnormnorm",dsqrt(
-! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
-! 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)
- else
-!- split gradient
- call etotal_long(energia1)
- etot21=energia1(0)
- ggg(j+3)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1)
- etot22=energia1(0)
- ggg1(j+3)=(etot12-etot22)/(2*aincr)
-!- end split gradient
- endif
-! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- dc(j,i+nres)=ddx(j)
- call chainbuild_cart
- enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
- if (split_ene) then
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
- k=1,6)
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
- i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
- ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
- endif
enddo
- return
- end subroutine check_ecartint
+!d eij=1.0d0
+!d ekl=1.0d0
+!d ekont=1.0d0
+ eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
+!d eello6_5=0.0d0
+!d write (2,*) 'eello6_5',eello6_5
+#ifdef MOMENT
+ call transpose2(AEA(1,1,1),auxmat(1,1))
+ call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
+ ss1=scalar2(Ub2(1,i+2),b1(1,itl))
+ s1 = (auxmat(1,1)+auxmat(2,2))*ss1
#endif
-!-----------------------------------------------------------------------------
- subroutine check_eint
-! Check the gradient of energy in internal coordinates.
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
- integer :: uiparm(1)
- real(kind=8) :: urparm(1)
- real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
- character(len=6) :: key
-!EL external fdum
- integer :: i,ii,nf
- real(kind=8) :: xi,aincr,etot,etot1,etot2
- call zerograd
- aincr=1.0D-7
- print '(a)','Calling CHECK_INT.'
- nf=0
- nfl=0
- icg=1
- call geom_to_var(nvar,x)
- call var_to_geom(nvar,x)
- call chainbuild
- icall=1
-! print *,'ICG=',ICG
- call etotal(energia)
- etot = energia(0)
-!el call enerprint(energia)
-! print *,'ICG=',ICG
-#ifdef MPL
- if (MyID.ne.BossID) then
- call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
- nf=x(nvar+1)
- nfl=x(nvar+2)
- icg=x(nvar+3)
- endif
+ call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
+ call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
+ s2 = scalar2(b1(1,itk),vtemp1(1))
+#ifdef MOMENT
+ call transpose2(AEA(1,1,2),atemp(1,1))
+ call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
+ call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
+ s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
#endif
- nf=1
- nfl=3
-!d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
- call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
-!d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
- icall=1
- do i=1,nvar
- xi=x(i)
- x(i)=xi-0.5D0*aincr
- call var_to_geom(nvar,x)
- call chainbuild
- call etotal(energia1)
- etot1=energia1(0)
- x(i)=xi+0.5D0*aincr
- call var_to_geom(nvar,x)
- call chainbuild
- call etotal(energia2)
- etot2=energia2(0)
- gg(i)=(etot2-etot1)/aincr
- write (iout,*) i,etot1,etot2
- x(i)=xi
+ call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
+ call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
+ s12 = scalar2(Ub2(1,i+2),vtemp3(1))
+#ifdef MOMENT
+ call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
+ call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
+ call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
+ call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
+ ss13 = scalar2(b1(1,itk),vtemp4(1))
+ s13 = (gtemp(1,1)+gtemp(2,2))*ss13
+#endif
+! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
+! s1=0.0d0
+! s2=0.0d0
+! s8=0.0d0
+! s12=0.0d0
+! s13=0.0d0
+ eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
+! Derivatives in gamma(i+2)
+ s1d =0.0d0
+ s8d =0.0d0
+#ifdef MOMENT
+ call transpose2(AEA(1,1,1),auxmatd(1,1))
+ call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+ call transpose2(AEAderg(1,1,2),atempd(1,1))
+ call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
+ s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
+#endif
+ call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
+ call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+ gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
+! Derivatives in gamma(i+3)
+#ifdef MOMENT
+ call transpose2(AEA(1,1,1),auxmatd(1,1))
+ call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
+#endif
+ call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
+ call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
+ s2d = scalar2(b1(1,itk),vtemp1d(1))
+#ifdef MOMENT
+ call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
+ s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
+#endif
+ s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
+#ifdef MOMENT
+ call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
+ call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
+ s13d = (gtempd(1,1)+gtempd(2,2))*ss13
+#endif
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
+ -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+#else
+ gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
+ -0.5d0*ekont*(s2d+s12d)
+#endif
+! Derivatives in gamma(i+4)
+ call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
+ call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+#ifdef MOMENT
+ call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
+ call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
+ s13d = (gtempd(1,1)+gtempd(2,2))*ss13
+#endif
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
+#else
+ gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
+#endif
+! Derivatives in gamma(i+5)
+#ifdef MOMENT
+ call transpose2(AEAderg(1,1,1),auxmatd(1,1))
+ call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+#endif
+ call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
+ call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
+ s2d = scalar2(b1(1,itk),vtemp1d(1))
+#ifdef MOMENT
+ call transpose2(AEA(1,1,2),atempd(1,1))
+ call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
+ s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
+#endif
+ call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+#ifdef MOMENT
+ call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
+ ss13d = scalar2(b1(1,itk),vtemp4d(1))
+ s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
+#endif
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
+ -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+#else
+ gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
+ -0.5d0*ekont*(s2d+s12d)
+#endif
+! Cartesian derivatives
+ do iii=1,2
+ do kkk=1,5
+ do lll=1,3
+#ifdef MOMENT
+ call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
+ call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+ s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+#endif
+ call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
+ call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
+ vtemp1d(1))
+ s2d = scalar2(b1(1,itk),vtemp1d(1))
+#ifdef MOMENT
+ call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
+ call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
+ s8d = -(atempd(1,1)+atempd(2,2))* &
+ scalar2(cc(1,1,itl),vtemp2(1))
+#endif
+ call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
+ auxmatd(1,1))
+ call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+ s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+! s1d=0.0d0
+! s2d=0.0d0
+! s8d=0.0d0
+! s12d=0.0d0
+! s13d=0.0d0
+#ifdef MOMENT
+ derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
+ - 0.5d0*(s1d+s2d)
+#else
+ derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
+ - 0.5d0*s2d
+#endif
+#ifdef MOMENT
+ derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
+ - 0.5d0*(s8d+s12d)
+#else
+ derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
+ - 0.5d0*s12d
+#endif
+ enddo
+ enddo
enddo
- write (iout,'(/2a)')' Variable Numerical Analytical',&
- ' RelDiff*100% '
- do i=1,nvar
- if (i.le.nphi) then
- ii=i
- key = ' phi'
- else if (i.le.nphi+ntheta) then
- ii=i-nphi
- key=' theta'
- else if (i.le.nphi+ntheta+nside) then
- ii=i-(nphi+ntheta)
- key=' alpha'
- else
- ii=i-(nphi+ntheta+nside)
- key=' omega'
- endif
- write (iout,'(i3,a,i3,3(1pd16.6))') &
- i,key,ii,gg(i),gana(i),&
- 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
+#ifdef MOMENT
+ do kkk=1,5
+ do lll=1,3
+ call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
+ achuj_tempd(1,1))
+ call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
+ call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
+ s13d=(gtempd(1,1)+gtempd(2,2))*ss13
+ derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
+ call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
+ vtemp4d(1))
+ ss13d = scalar2(b1(1,itk),vtemp4d(1))
+ s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
+ derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
+ enddo
enddo
- return
- end subroutine check_eint
-!-----------------------------------------------------------------------------
-! econstr_local.F
-!-----------------------------------------------------------------------------
- subroutine Econstr_back
-! MD with umbrella_sampling using Wolyne's distance measure as a constraint
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
-! include 'COMMON.VAR'
-! include 'COMMON.MD'
- use MD_data
-!#ifndef LANG0
-! include 'COMMON.LANGEVIN'
-!#else
-! include 'COMMON.LANGEVIN.lang0'
-!#endif
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.NAMES'
-! include 'COMMON.TIME1'
- integer :: i,j,ii,k
- real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
-
- if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
- if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
- if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
-
- Uconst_back=0.0d0
- do i=1,nres
- dutheta(i)=0.0d0
- dugamma(i)=0.0d0
- do j=1,3
- duscdiff(j,i)=0.0d0
- duscdiffx(j,i)=0.0d0
- enddo
- enddo
- do i=1,nfrag_back
- ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
-!
-! Deviations from theta angles
-!
- utheta_i=0.0d0
- do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
- dtheta_i=theta(j)-thetaref(j)
- utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
- dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
- enddo
- utheta(i)=utheta_i/(ii-1)
-!
-! Deviations from gamma angles
-!
- ugamma_i=0.0d0
- do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
- dgamma_i=pinorm(phi(j)-phiref(j))
-! write (iout,*) j,phi(j),phi(j)-phiref(j)
- ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
- dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
-! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
- enddo
- ugamma(i)=ugamma_i/(ii-2)
-!
-! Deviations from local SC geometry
-!
- uscdiff(i)=0.0d0
- do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
- dxx=xxtab(j)-xxref(j)
- dyy=yytab(j)-yyref(j)
- dzz=zztab(j)-zzref(j)
- uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
- do k=1,3
- duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
- (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
- (ii-1)
- duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
- (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
- (ii-1)
- duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
- (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
- /(ii-1)
- enddo
-! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
-! & xxref(j),yyref(j),zzref(j)
- enddo
- uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
-! write (iout,*) i," uscdiff",uscdiff(i)
-!
-! Put together deviations from local geometry
-!
- Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
- wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
-! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
-! & " uconst_back",uconst_back
- utheta(i)=dsqrt(utheta(i))
- ugamma(i)=dsqrt(ugamma(i))
- uscdiff(i)=dsqrt(uscdiff(i))
- enddo
- return
- end subroutine Econstr_back
-!-----------------------------------------------------------------------------
-! energy_p_new-sep_barrier.F
-!-----------------------------------------------------------------------------
- real(kind=8) function sscale(r)
-! include "COMMON.SPLITELE"
- real(kind=8) :: r,gamm
- if(r.lt.r_cut-rlamb) then
- sscale=1.0d0
- else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
- gamm=(r-(r_cut-rlamb))/rlamb
- sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
- else
- sscale=0d0
- endif
- return
- end function sscale
- real(kind=8) function sscale_grad(r)
-! include "COMMON.SPLITELE"
- real(kind=8) :: r,gamm
- if(r.lt.r_cut-rlamb) then
- sscale_grad=0.0d0
- else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
- gamm=(r-(r_cut-rlamb))/rlamb
- sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
+#endif
+!d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
+!d & 16*eel_turn6_num
+!d goto 1112
+ if (j.lt.nres-1) then
+ j1=j+1
+ j2=j-1
else
- sscale_grad=0d0
+ j1=j-1
+ j2=j-2
endif
- return
- end function sscale_grad
-
-!!!!!!!!!! PBCSCALE
- real(kind=8) function sscale_ele(r)
-! include "COMMON.SPLITELE"
- real(kind=8) :: r,gamm
- if(r.lt.r_cut_ele-rlamb_ele) then
- sscale_ele=1.0d0
- else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
- gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
- sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ if (l.lt.nres-1) then
+ l1=l+1
+ l2=l-1
else
- sscale_ele=0d0
+ l1=l-1
+ l2=l-2
endif
+ do ll=1,3
+!grad ggg1(ll)=eel_turn6*g_contij(ll,1)
+!grad ggg2(ll)=eel_turn6*g_contij(ll,2)
+!grad ghalf=0.5d0*ggg1(ll)
+!d ghalf=0.0d0
+ gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
+ gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
+ gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
+ +ekont*derx_turn(ll,2,1)
+ gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
+ gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
+ +ekont*derx_turn(ll,4,1)
+ gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
+ gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
+ gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
+!grad ghalf=0.5d0*ggg2(ll)
+!d ghalf=0.0d0
+ gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
+ +ekont*derx_turn(ll,2,2)
+ gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
+ gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
+ +ekont*derx_turn(ll,4,2)
+ gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
+ gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
+ gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
+ enddo
+!d goto 1112
+!grad do m=i+1,j-1
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
+!grad enddo
+!grad enddo
+!grad do m=k+1,l-1
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
+!grad enddo
+!grad enddo
+!grad1112 continue
+!grad do m=i+2,j2
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
+!grad enddo
+!grad enddo
+!grad do m=k+2,l2
+!grad do ll=1,3
+!grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
+!grad enddo
+!grad enddo
+!d do iii=1,nres-3
+!d write (2,*) iii,g_corr6_loc(iii)
+!d enddo
+ eello_turn6=ekont*eel_turn6
+!d write (2,*) 'ekont',ekont
+!d write (2,*) 'eel_turn6',ekont*eel_turn6
return
- end function sscale_ele
+ end function eello_turn6
+!-----------------------------------------------------------------------------
+ subroutine MATVEC2(A1,V1,V2)
+!DIR$ INLINEALWAYS MATVEC2
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
+#endif
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+ real(kind=8),dimension(2) :: V1,V2
+ real(kind=8),dimension(2,2) :: A1
+ real(kind=8) :: vaux1,vaux2
+! DO 1 I=1,2
+! VI=0.0
+! DO 3 K=1,2
+! 3 VI=VI+A1(I,K)*V1(K)
+! Vaux(I)=VI
+! 1 CONTINUE
- real(kind=8) function sscagrad_ele(r)
- real(kind=8) :: r,gamm
-! include "COMMON.SPLITELE"
- if(r.lt.r_cut_ele-rlamb_ele) then
- sscagrad_ele=0.0d0
- else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
- gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
- sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
- else
- sscagrad_ele=0.0d0
- 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
+ vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
+ vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
-!!!!!!!!!!!!!!!
+ v2(1)=vaux1
+ v2(2)=vaux2
+ end subroutine MATVEC2
!-----------------------------------------------------------------------------
- subroutine elj_long(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the LJ potential of interaction.
-!
-! implicit real*8 (a-h,o-z)
+ subroutine MATMAT2(A1,A2,A3)
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
+#endif
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.TORSION'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.NAMES'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CONTACTS'
- real(kind=8),parameter :: accur=1.0d-10
- 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
- real(kind=8) :: e1,e2,evdwij,evdw
-! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(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,1)
- if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
- if (sss.lt.1.0d0) then
- rrij=1.0D0/rij
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- evdwij=e1+e2
- evdw=evdw+(1.0d0-sss)*evdwij
-!
-! Calculate the components of the gradient in DC and X
-!
- fac=-rrij*(e1+evdwij)*(1.0d0-sss)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
+ real(kind=8),dimension(2,2) :: A1,A2,A3
+ real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
+! DIMENSION AI3(2,2)
+! DO J=1,2
+! A3IJ=0.0
+! DO K=1,2
+! A3IJ=A3IJ+A1(I,K)*A2(K,J)
+! enddo
+! A3(I,J)=A3IJ
+! enddo
+! enddo
+
+ ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
+ ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
+ ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
+ ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
+
+ A3(1,1)=AI3_11
+ A3(2,1)=AI3_21
+ A3(1,2)=AI3_12
+ A3(2,2)=AI3_22
+ end subroutine MATMAT2
+!-----------------------------------------------------------------------------
+ real(kind=8) function scalar2(u,v)
+!DIR$ INLINEALWAYS scalar2
+ implicit none
+ real(kind=8),dimension(2) :: u,v
+ real(kind=8) :: sc
+ integer :: i
+ scalar2=u(1)*v(1)+u(2)*v(2)
+ return
+ end function scalar2
+!-----------------------------------------------------------------------------
+ subroutine transpose2(a,at)
+!DIR$ INLINEALWAYS transpose2
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::transpose2
+#endif
+ implicit none
+ real(kind=8),dimension(2,2) :: a,at
+ at(1,1)=a(1,1)
+ at(1,2)=a(2,1)
+ at(2,1)=a(1,2)
+ at(2,2)=a(2,2)
+ return
+ end subroutine transpose2
+!-----------------------------------------------------------------------------
+ subroutine transpose(n,a,at)
+ implicit none
+ integer :: n,i,j
+ real(kind=8),dimension(n,n) :: a,at
+ do i=1,n
+ do j=1,n
+ at(j,i)=a(i,j)
enddo
enddo
-!******************************************************************************
-!
-! N O T E !!!
-!
-! To save time, the factor of EXPON has been extracted from ALL components
-! of GVDWC and GRADX. Remember to multiply them by this factor before further
-! use!
-!
-!******************************************************************************
return
- end subroutine elj_long
+ end subroutine transpose
!-----------------------------------------------------------------------------
- subroutine elj_short(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the LJ potential of interaction.
-!
-! implicit real*8 (a-h,o-z)
+ subroutine prodmat3(a1,a2,kk,transp,prod)
+!DIR$ INLINEALWAYS prodmat3
+#ifndef OSF
+!DEC$ ATTRIBUTES FORCEINLINE::prodmat3
+#endif
+ implicit none
+ integer :: i,j
+ real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
+ logical :: transp
+!rc double precision auxmat(2,2),prod_(2,2)
+
+ if (transp) then
+!rc call transpose2(kk(1,1),auxmat(1,1))
+!rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
+!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
+
+ prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
+ +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
+ prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
+ +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
+ prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
+ +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
+ prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
+ +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
+
+ else
+!rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
+!rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
+
+ prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
+ +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
+ prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
+ +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
+ prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
+ +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
+ prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
+ +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
+
+ endif
+! call transpose2(a2(1,1),a2t(1,1))
+
+!rc print *,transp
+!rc print *,((prod_(i,j),i=1,2),j=1,2)
+!rc print *,((prod(i,j),i=1,2),j=1,2)
+
+ return
+ end subroutine prodmat3
+!-----------------------------------------------------------------------------
+! energy_p_new_barrier.F
+!-----------------------------------------------------------------------------
+ subroutine sum_gradient
+! implicit real(kind=8) (a-h,o-z)
+ use io_base, only: pdbout
! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
+#ifndef ISNAN
+ external proc_proc
+#ifdef WINPGI
+!MS$ATTRIBUTES C :: proc_proc
+#endif
+#endif
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
+ gloc_scbuf !(3,maxres)
+
+ real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
+!#endif
+!el local variables
+ integer :: i,j,k,ierror,ierr
+ real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
+ gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
+ gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
+ gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
+ gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
+ gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
+ gsccorr_max,gsccorrx_max,time00
+
+! include 'COMMON.SETUP'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.FFIELD'
! include 'COMMON.DERIV'
! include 'COMMON.INTERACT'
-! include 'COMMON.TORSION'
! include 'COMMON.SBRIDGE'
-! include 'COMMON.NAMES'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CONTACTS'
- real(kind=8),parameter :: accur=1.0d-10
- 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
- real(kind=8) :: e1,e2,evdwij,evdw
-! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-! Change 12/1/95
- num_conti=0
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(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,1)
- if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
-! Change 12/1/95 to calculate four-body interactions
- rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
- if (sss.gt.0.0d0) then
- rrij=1.0D0/rij
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- evdwij=e1+e2
- evdw=evdw+sss*evdwij
-!
-! Calculate the components of the gradient in DC and X
-!
- fac=-rrij*(e1+evdwij)*sss
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-!******************************************************************************
-!
-! N O T E !!!
-!
-! To save time, the factor of EXPON has been extracted from ALL components
-! of GVDWC and GRADX. Remember to multiply them by this factor before further
-! use!
-!
-!******************************************************************************
- return
- end subroutine elj_short
-!-----------------------------------------------------------------------------
- subroutine eljk_long(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the LJK potential of interaction.
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.NAMES'
- real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
- logical :: scheck
-!el local variables
- integer :: i,iint,j,k,itypi,itypi1,itypj
- real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
- fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
-! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-!
-! Calculate SC interaction energy.
+! include 'COMMON.VAR'
+! include 'COMMON.CONTROL'
+! include 'COMMON.TIME1'
+! include 'COMMON.MAXGRAD'
+! include 'COMMON.SCCOR'
+#ifdef TIMING
+ time01=MPI_Wtime()
+#endif
+!#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "sum_gradient gvdwc, gvdwx"
+ do i=1,nres
+ write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
+ i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+#ifdef MPI
+ gradbufc=0.0d0
+ gradbufx=0.0d0
+ gradbufc_sum=0.0d0
+ gloc_scbuf=0.0d0
+ glocbuf=0.0d0
+! FG slaves call the following matching MPI_Bcast in ERGASTULUM
+ if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
+ call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
+#endif
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
- 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_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,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)
- evdw=evdw+(1.0d0-sss)*evdwij
-!
-! Calculate the components of the gradient in DC and X
+! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
+! in virtual-bond-vector coordinates
!
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- fac=fac*(1.0d0-sss)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
+#ifdef DEBUG
+! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
+! do i=1,nres-1
+! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
+! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
+! enddo
+! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
+! do i=1,nres-1
+! write (iout,'(i5,3f10.5,2x,f10.5)')
+! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
+! enddo
+! write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
+! do i=1,nres
+! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
+! i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
+! (gvdwc_scpp(j,i),j=1,3)
+! enddo
+! write (iout,*) "gelc_long gvdwpp gel_loc_long"
+! do i=1,nres
+! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
+! i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
+! (gelc_loc_long(j,i),j=1,3)
+! enddo
+ call flush(iout)
+#endif
+#ifdef SPLITELE
+ do i=0,nct
do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
+ gradbufc(j,i)=wsc*gvdwc(j,i)+ &
+ wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
+ welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+ wcorr*gradcorr_long(j,i)+ &
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i)+ &
+ wstrain*ghpbc(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +gradafm(j,i) &
+ +welec*gshieldc(j,i) &
+ +wcorr*gshieldc_ec(j,i) &
+ +wturn3*gshieldc_t3(j,i)&
+ +wturn4*gshieldc_t4(j,i)&
+ +wel_loc*gshieldc_ll(j,i)&
+ +wtube*gg_tube(j,i) &
+ +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
+ wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
+ wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
+ wcorr_nucl*gradcorr_nucl(j,i)&
+ +wcorr3_nucl*gradcorr3_nucl(j,i)+&
+ wcatprot* gradpepcat(j,i)+ &
+ wcatcat*gradcatcat(j,i)+ &
+ wscbase*gvdwc_scbase(j,i)+ &
+ wpepbase*gvdwc_pepbase(j,i)+&
+ wscpho*gvdwc_scpho(j,i)+ &
+ wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)+ &
+ wmartini*(gradlipbond(j,i)+gradlipang(j,i)+gradliplj(j,i)+gradlipelec(j,i))+&
+ wcat_tran*gradcattranc(j,i)+gradcatangc(j,i)+&
+ wlip_prot*gradpepmart(j,i)
+
+
+
+
+
+
+ enddo
+ enddo
+#else
+ do i=0,nct
+ do j=1,3
+ gradbufc(j,i)=wsc*gvdwc(j,i)+ &
+ wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
+ welec*gelc_long(j,i)+ &
+ wbond*gradb(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+ wcorr*gradcorr_long(j,i)+ &
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i)+ &
+ wstrain*ghpbc(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +gradafm(j,i) &
+ +welec*gshieldc(j,i)&
+ +wcorr*gshieldc_ec(j,i) &
+ +wturn4*gshieldc_t4(j,i) &
+ +wel_loc*gshieldc_ll(j,i)&
+ +wtube*gg_tube(j,i) &
+ +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
+ wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
+ wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
+ wcorr_nucl*gradcorr_nucl(j,i) &
+ +wcorr3_nucl*gradcorr3_nucl(j,i) +&
+ wcatprot* gradpepcat(j,i)+ &
+ wcatcat*gradcatcat(j,i)+ &
+ wscbase*gvdwc_scbase(j,i)+ &
+ wpepbase*gvdwc_pepbase(j,i)+&
+ wscpho*gvdwc_scpho(j,i)+&
+ wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)+&
+ wmartini*(gradlipbond(j,i)+gradlipang(j,i)+gradliplj(j,i)+gradlipelec(j,i))+&
+ wcat_tran*gradcattranc(j,i)+gradcatangc(j,i)+&
+ wlip_prot*gradpepmart(j,i)
+
+
+
enddo
+ enddo
+#endif
+#ifdef MPI
+ if (nfgtasks.gt.1) then
+ time00=MPI_Wtime()
+#ifdef DEBUG
+ write (iout,*) "gradbufc before allreduce"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
enddo
- return
- end subroutine eljk_long
-!-----------------------------------------------------------------------------
- subroutine eljk_short(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the LJK potential of interaction.
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.NAMES'
- real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
- logical :: scheck
-!el local variables
- integer :: i,iint,j,k,itypi,itypi1,itypj
- real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
- fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
-! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
- 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_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,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)
- evdw=evdw+sss*evdwij
-!
-! Calculate the components of the gradient in DC and X
-!
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- fac=fac*sss
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
+ call flush(iout)
+#endif
+ do i=0,nres
do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
+ gradbufc_sum(j,i)=gradbufc(j,i)
enddo
enddo
- return
- end subroutine eljk_short
-!-----------------------------------------------------------------------------
- subroutine ebp_long(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Berne-Pechukas potential of interaction.
-!
- use calc_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.NAMES'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
-! double precision rrsave(maxdim)
- logical :: lprn
-!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac
- real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
- evdw=0.0D0
-! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-! if (icall.eq.0) then
-! lprn=.true.
-! else
- lprn=.false.
-! endif
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.lt.1.0d0) then
-
-! Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-! Calculate whole angle-dependent part of epsilon and contributions
-! to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
-!d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-!d & restyp(itypi,1),i,restyp(itypj,1),j,
-!d & epsi,sigm,chi1,chi2,chip1,chip2,
-!d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-!d & om1,om2,om12,1.0D0/dsqrt(rrij),
-!d & evdwij
- endif
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-! Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-! Calculate the angular part of the gradient and sum add the contributions
-! to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-! stop
- return
- end subroutine ebp_long
-!-----------------------------------------------------------------------------
- subroutine ebp_short(evdw)
+! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
+! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
+! time_reduce=time_reduce+MPI_Wtime()-time00
+#ifdef DEBUG
+! write (iout,*) "gradbufc_sum after allreduce"
+! do i=1,nres
+! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
+! enddo
+! call flush(iout)
+#endif
+#ifdef TIMING
+! time_allreduce=time_allreduce+MPI_Wtime()-time00
+#endif
+ do i=0,nres
+ do k=1,3
+ gradbufc(k,i)=0.0d0
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
+ write (iout,*) (i," jgrad_start",jgrad_start(i),&
+ " jgrad_end ",jgrad_end(i),&
+ i=igrad_start,igrad_end)
+#endif
!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Berne-Pechukas potential of interaction.
+! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
+! do not parallelize this part.
!
- use calc_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.NAMES'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
-! double precision rrsave(maxdim)
- logical :: lprn
-!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
- real(kind=8) :: sss,e1,e2,evdw
- evdw=0.0D0
-! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-! if (icall.eq.0) then
-! lprn=.true.
-! else
- lprn=.false.
-! endif
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-!
-! Calculate SC interaction energy.
+! do i=igrad_start,igrad_end
+! do j=jgrad_start(i),jgrad_end(i)
+! do k=1,3
+! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
+! enddo
+! enddo
+! enddo
+ do j=1,3
+ gradbufc(j,nres-1)=gradbufc_sum(j,nres)
+ enddo
+ do i=nres-2,-1,-1
+ do j=1,3
+ gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "gradbufc after summing"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+ else
+#endif
+!el#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gradbufc"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+!el#undef DEBUG
+ do i=-1,nres
+ do j=1,3
+ gradbufc_sum(j,i)=gradbufc(j,i)
+ gradbufc(j,i)=0.0d0
+ enddo
+ enddo
+ do j=1,3
+ gradbufc(j,nres-1)=gradbufc_sum(j,nres)
+ enddo
+ do i=nres-2,-1,-1
+ do j=1,3
+ gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
+ enddo
+ enddo
+! do i=nnt,nres-1
+! do k=1,3
+! gradbufc(k,i)=0.0d0
+! enddo
+! do j=i+1,nres
+! do k=1,3
+! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
+! enddo
+! enddo
+! enddo
+!el#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gradbufc after summing"
+ do i=1,nres
+ write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+ enddo
+ call flush(iout)
+#endif
+!el#undef DEBUG
+#ifdef MPI
+ endif
+#endif
+ do k=1,3
+ gradbufc(k,nres)=0.0d0
+ enddo
+!el----------------
+!el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
+!el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
+!el-----------------
+ do i=-1,nct
+ do j=1,3
+#ifdef SPLITELE
+ gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
+ wel_loc*gel_loc(j,i)+ &
+ 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
+ welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+ wcorr*gradcorr_long(j,i)+ &
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i))+ &
+ wbond*gradb(j,i)+ &
+ wcorr*gradcorr(j,i)+ &
+ wturn3*gcorr3_turn(j,i)+ &
+ wturn4*gcorr4_turn(j,i)+ &
+ wcorr5*gradcorr5(j,i)+ &
+ wcorr6*gradcorr6(j,i)+ &
+ wturn6*gcorr6_turn(j,i)+ &
+ wsccor*gsccorc(j,i) &
+ +wscloc*gscloc(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +gradafm(j,i) &
+ +welec*gshieldc(j,i) &
+ +welec*gshieldc_loc(j,i) &
+ +wcorr*gshieldc_ec(j,i) &
+ +wcorr*gshieldc_loc_ec(j,i) &
+ +wturn3*gshieldc_t3(j,i) &
+ +wturn3*gshieldc_loc_t3(j,i) &
+ +wturn4*gshieldc_t4(j,i) &
+ +wturn4*gshieldc_loc_t4(j,i) &
+ +wel_loc*gshieldc_ll(j,i) &
+ +wel_loc*gshieldc_loc_ll(j,i) &
+ +wtube*gg_tube(j,i) &
+ +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
+ +wvdwpsb*gvdwpsb1(j,i))&
+ +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)!&
+! + gradcattranc(j,i)
+! if (i.eq.21) then
+! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
+! wturn4*gshieldc_t4(j,i), &
+! wturn4*gshieldc_loc_t4(j,i)
+! endif
+! if ((i.le.2).and.(i.ge.1))
+! print *,gradc(j,i,icg),&
+! gradbufc(j,i),welec*gelc(j,i), &
+! wel_loc*gel_loc(j,i), &
+! wscp*gvdwc_scpp(j,i), &
+! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
+! wel_loc*gel_loc_long(j,i), &
+! wcorr*gradcorr_long(j,i), &
+! wcorr5*gradcorr5_long(j,i), &
+! wcorr6*gradcorr6_long(j,i), &
+! wturn6*gcorr6_turn_long(j,i), &
+! wbond*gradb(j,i), &
+! wcorr*gradcorr(j,i), &
+! wturn3*gcorr3_turn(j,i), &
+! wturn4*gcorr4_turn(j,i), &
+! wcorr5*gradcorr5(j,i), &
+! wcorr6*gradcorr6(j,i), &
+! wturn6*gcorr6_turn(j,i), &
+! wsccor*gsccorc(j,i) &
+! ,wscloc*gscloc(j,i) &
+! ,wliptran*gliptranc(j,i) &
+! ,gradafm(j,i) &
+! ,welec*gshieldc(j,i) &
+! ,welec*gshieldc_loc(j,i) &
+! ,wcorr*gshieldc_ec(j,i) &
+! ,wcorr*gshieldc_loc_ec(j,i) &
+! ,wturn3*gshieldc_t3(j,i) &
+! ,wturn3*gshieldc_loc_t3(j,i) &
+! ,wturn4*gshieldc_t4(j,i) &
+! ,wturn4*gshieldc_loc_t4(j,i) &
+! ,wel_loc*gshieldc_ll(j,i) &
+! ,wel_loc*gshieldc_loc_ll(j,i) &
+! ,wtube*gg_tube(j,i) &
+! ,wbond_nucl*gradb_nucl(j,i) &
+! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
+! wvdwpsb*gvdwpsb1(j,i)&
+! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- if (sss.gt.0.0d0) then
+#else
+ gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
+ wel_loc*gel_loc(j,i)+ &
+ 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
+ welec*gelc_long(j,i)+ &
+ wel_loc*gel_loc_long(j,i)+ &
+!el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
+ wcorr5*gradcorr5_long(j,i)+ &
+ wcorr6*gradcorr6_long(j,i)+ &
+ wturn6*gcorr6_turn_long(j,i))+ &
+ wbond*gradb(j,i)+ &
+ wcorr*gradcorr(j,i)+ &
+ wturn3*gcorr3_turn(j,i)+ &
+ wturn4*gcorr4_turn(j,i)+ &
+ wcorr5*gradcorr5(j,i)+ &
+ wcorr6*gradcorr6(j,i)+ &
+ wturn6*gcorr6_turn(j,i)+ &
+ wsccor*gsccorc(j,i) &
+ +wscloc*gscloc(j,i) &
+ +gradafm(j,i) &
+ +wliptran*gliptranc(j,i) &
+ +welec*gshieldc(j,i) &
+ +welec*gshieldc_loc(j,i) &
+ +wcorr*gshieldc_ec(j,i) &
+ +wcorr*gshieldc_loc_ec(j,i) &
+ +wturn3*gshieldc_t3(j,i) &
+ +wturn3*gshieldc_loc_t3(j,i) &
+ +wturn4*gshieldc_t4(j,i) &
+ +wturn4*gshieldc_loc_t4(j,i) &
+ +wel_loc*gshieldc_ll(j,i) &
+ +wel_loc*gshieldc_loc_ll(j,i) &
+ +wtube*gg_tube(j,i) &
+ +wbond_nucl*gradb_nucl(j,i) &
+ +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
+ +wvdwpsb*gvdwpsb1(j,i))&
+ +wsbloc*gsbloc(j,i)+wcatnucl*gradnuclcat(j,i)!&
+! + gradcattranc(j,i)
-! Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-! Calculate whole angle-dependent part of epsilon and contributions
-! to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*sss
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
-!d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-!d & restyp(itypi,1),i,restyp(itypj,1),j,
-!d & epsi,sigm,chi1,chi2,chip1,chip2,
-!d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-!d & om1,om2,om12,1.0D0/dsqrt(rrij),
-!d & evdwij
- endif
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-! Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-! Calculate the angular part of the gradient and sum add the contributions
-! to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-! stop
- return
- end subroutine ebp_short
-!-----------------------------------------------------------------------------
- subroutine egb_long(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Gay-Berne potential of interaction.
-!
- use calc_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.NAMES'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
-! include 'COMMON.CONTROL'
- logical :: lprn
-!el local variables
- integer :: iint,itypi,itypi1,itypj,subchap
- 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,aa,bb,fracinbuf,sslipi,sslipj,&
- ssgradlipi,ssgradlipj
- evdw=0.0D0
-!cccc energy_dec=.false.
-! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-! if (icall.eq.0) lprn=.false.
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
-! 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
+#endif
+ gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
+ wbond*gradbx(j,i)+ &
+ wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
+ wsccor*gsccorx(j,i) &
+ +wscloc*gsclocx(j,i) &
+ +wliptran*gliptranx(j,i) &
+ +welec*gshieldx(j,i) &
+ +wcorr*gshieldx_ec(j,i) &
+ +wturn3*gshieldx_t3(j,i) &
+ +wturn4*gshieldx_t4(j,i) &
+ +wel_loc*gshieldx_ll(j,i)&
+ +wtube*gg_tube_sc(j,i) &
+ +wbond_nucl*gradbx_nucl(j,i) &
+ +wvdwsb*gvdwsbx(j,i) &
+ +welsb*gelsbx(j,i) &
+ +wcorr_nucl*gradxorr_nucl(j,i)&
+ +wcorr3_nucl*gradxorr3_nucl(j,i) &
+ +wsbloc*gsblocx(j,i) &
+ +wcatprot* gradpepcatx(j,i)&
+ +wscbase*gvdwx_scbase(j,i) &
+ +wpepbase*gvdwx_pepbase(j,i)&
+ +wscpho*gvdwx_scpho(j,i)+wcatnucl*gradnuclcatx(j,i)&
+ +wcat_tran*gradcattranx(j,i)+gradcatangx(j,i)&
+ +wlip_prot*gradpepmartx(j,i)
-!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 (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
- ELSE
-!el ind=ind+1
- 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,1),itype(j,1)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)
- yj=c(2,nres+j)
- zj=c(3,nres+j)
-! Searching for nearest neighbour
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
+ enddo
+ enddo
+! write(iout,*), "const_homol",constr_homology
+ if (constr_homology.gt.0) then
+ do i=1,nct
+ do j=1,3
+ gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i)
+! write(iout,*) "duscdiff",duscdiff(j,i)
+ gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i)
enddo
+ enddo
+ endif
+!#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc before adding corr"
+ do i=1,4*nres
+ write (iout,*) i,gloc(i,icg)
+ enddo
+#endif
+ do i=1,nres-3
+ gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
+ +wcorr5*g_corr5_loc(i) &
+ +wcorr6*g_corr6_loc(i) &
+ +wturn4*gel_loc_turn4(i) &
+ +wturn3*gel_loc_turn3(i) &
+ +wturn6*gel_loc_turn6(i) &
+ +wel_loc*gel_loc_loc(i)
+ enddo
+#ifdef DEBUG
+ write (iout,*) "gloc after adding corr"
+ do i=1,4*nres
+ write (iout,*) i,gloc(i,icg)
+ enddo
+#endif
+!#undef DEBUG
+#ifdef MPI
+ if (nfgtasks.gt.1) then
+ do j=1,3
+ do i=0,nres
+ gradbufc(j,i)=gradc(j,i,icg)
+ gradbufx(j,i)=gradx(j,i,icg)
enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
- sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
- sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
- if (sss_ele_cut.le.0.0) cycle
- if (sss.lt.1.0d0) then
-
-! Calculate angle-dependent terms of energy and contributions to their
-! derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-! for diagnostics; uncomment
-! rij_shift=1.2*sig0ij
-! I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-!d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-!d & restyp(itypi,1),i,restyp(itypj,1),j,
-!d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-!---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa
- e2=fac*bb
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- 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
-! if (energy_dec) write (iout,*) &
-! 'evdw',i,j,evdwij,"egb_long"
-
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
- fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
- /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
- /sigmaii(itypi,itypj))
-! fac=0.0d0
-! Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- 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
- enddo ! i
-! write (iout,*) "Number of loop steps in EGB:",ind
-!ccc energy_dec=.false.
- return
- end subroutine egb_long
-!-----------------------------------------------------------------------------
- subroutine egb_short(evdw)
+ enddo
+ do i=1,4*nres
+ glocbuf(i)=gloc(i,icg)
+ enddo
+!#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc_sc before reduce"
+ do i=1,nres
+ do j=1,1
+ write (iout,*) i,j,gloc_sc(j,i,icg)
+ enddo
+ enddo
+#endif
+!#undef DEBUG
+ do i=0,nres
+ do j=1,3
+ gloc_scbuf(j,i)=gloc_sc(j,i,icg)
+ enddo
+ enddo
+ time00=MPI_Wtime()
+ call MPI_Barrier(FG_COMM,IERR)
+ time_barrier_g=time_barrier_g+MPI_Wtime()-time00
+ time00=MPI_Wtime()
+ call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ time_reduce=time_reduce+MPI_Wtime()-time00
+ call MPI_Reduce(gloc_scbuf(1,0),gloc_sc(1,0,icg),3*nres+3,&
+ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ time_reduce=time_reduce+MPI_Wtime()-time00
+!#define DEBUG
+! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
+#ifdef DEBUG
+ write (iout,*) "gloc_sc after reduce"
+ do i=0,nres
+ do j=1,1
+ write (iout,*) i,j,gloc_sc(j,i,icg)
+ enddo
+ enddo
+#endif
+!#undef DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc after reduce"
+ do i=1,4*nres
+ write (iout,*) i,gloc(i,icg)
+ enddo
+#endif
+ endif
+#endif
+ if (gnorm_check) then
!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Gay-Berne potential of interaction.
+! Compute the maximum elements of the gradient
!
+ gvdwc_max=0.0d0
+ gvdwc_scp_max=0.0d0
+ gelc_max=0.0d0
+ gvdwpp_max=0.0d0
+ gradb_max=0.0d0
+ ghpbc_max=0.0d0
+ gradcorr_max=0.0d0
+ gel_loc_max=0.0d0
+ gcorr3_turn_max=0.0d0
+ gcorr4_turn_max=0.0d0
+ gradcorr5_max=0.0d0
+ gradcorr6_max=0.0d0
+ gcorr6_turn_max=0.0d0
+ gsccorc_max=0.0d0
+ gscloc_max=0.0d0
+ gvdwx_max=0.0d0
+ gradx_scp_max=0.0d0
+ ghpbx_max=0.0d0
+ gradxorr_max=0.0d0
+ gsccorx_max=0.0d0
+ gsclocx_max=0.0d0
+ do i=1,nct
+ gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
+ if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
+ gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
+ if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
+ gvdwc_scp_max=gvdwc_scp_norm
+ gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
+ if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
+ gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
+ if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
+ gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
+ if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
+ ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
+ if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
+ gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
+ if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
+ gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
+ if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
+ gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
+ gcorr3_turn(1,i)))
+ if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
+ gcorr3_turn_max=gcorr3_turn_norm
+ gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
+ gcorr4_turn(1,i)))
+ if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
+ gcorr4_turn_max=gcorr4_turn_norm
+ gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
+ if (gradcorr5_norm.gt.gradcorr5_max) &
+ gradcorr5_max=gradcorr5_norm
+ gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
+ if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
+ gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
+ gcorr6_turn(1,i)))
+ if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
+ gcorr6_turn_max=gcorr6_turn_norm
+ gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
+ if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
+ gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
+ if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
+ gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
+ if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
+ gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
+ if (gradx_scp_norm.gt.gradx_scp_max) &
+ gradx_scp_max=gradx_scp_norm
+ ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
+ if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
+ gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
+ if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
+ gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
+ if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
+ gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
+ if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
+ enddo
+ if (gradout) then
+#ifdef AIX
+ open(istat,file=statname,position="append")
+#else
+ open(istat,file=statname,access="append")
+#endif
+ write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
+ gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
+ gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
+ gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
+ gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
+ gsccorx_max,gsclocx_max
+ close(istat)
+ if (gvdwc_max.gt.1.0d4) then
+ write (iout,*) "gvdwc gvdwx gradb gradbx"
+ do i=nnt,nct
+ write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
+ gradb(j,i),gradbx(j,i),j=1,3)
+ enddo
+ call pdbout(0.0d0,'cipiszcze',iout)
+ call flush(iout)
+ endif
+ endif
+ endif
+!#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gradc gradx gloc"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
+ i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
+ enddo
+#endif
+!#undef DEBUG
+#ifdef TIMING
+ time_sumgradient=time_sumgradient+MPI_Wtime()-time01
+#endif
+ return
+ end subroutine sum_gradient
+!-----------------------------------------------------------------------------
+ subroutine sc_grad
+! implicit real(kind=8) (a-h,o-z)
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'
- logical :: lprn
-!el local variables
- integer :: iint,itypi,itypi1,itypj,subchap
- 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,aa,bb,fracinbuf,sslipi,sslipj,&
- ssgradlipi,ssgradlipj
- evdw=0.0D0
-!cccc energy_dec=.false.
-! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-! if (icall.eq.0) lprn=.false.
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
+! 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
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- 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
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
+! " sigder",sigder
+! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
+! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
+!C print *,sss_ele_cut,'in sc_grad'
+ do k=1,3
+ dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+ dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
+ enddo
+ do k=1,3
+ gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
+!C print *,'gg',k,gg(k)
+ enddo
+! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
+! write (iout,*) "gg",(gg(k),k=1,3)
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
+ *sss_ele_cut
-!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
+ 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
-!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
+! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ enddo
+!
+! Calculate the components of the gradient in DC and X
+!
+!grad do k=i,j-1
+!grad do l=1,3
+!grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
+!grad enddo
+!grad enddo
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
+ enddo
+ return
+ end subroutine sc_grad
-! if (energy_dec) write (iout,*) &
-! 'evdw',i,j,evdwij,' ss'
- ELSE
-!el ind=ind+1
- 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,1),itype(j,1)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-! 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)
-! Searching for nearest neighbour
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ subroutine sc_grad_cat
+ use calc_data
+ real(kind=8), dimension(3) :: dcosom1,dcosom2
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
+ +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
+ +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
- sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
- sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
- if (sss_ele_cut.le.0.0) cycle
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
- if (sss.gt.0.0d0) then
+ 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))
+ enddo
+ do k=1,3
+ gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))
+! print *,'gg',k,gg(k)
+ enddo
+! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
+! write (iout,*) "gg",(gg(k),k=1,3)
+ do k=1,3
+ gradpepcatx(k,i)=gradpepcatx(k,i)-gg(k)*sss_ele_cut &
+ +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut
-! Calculate angle-dependent terms of energy and contributions to their
-! derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-! for diagnostics; uncomment
-! rij_shift=1.2*sig0ij
-! I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-!d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-!d & restyp(itypi,1),i,restyp(itypj,1),j,
-!d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-!---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa
- e2=fac*bb
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*sss*sss_ele_cut
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- 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
+! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) &
+! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'evdw',i,j,evdwij
-! if (energy_dec) write (iout,*) &
-! 'evdw',i,j,evdwij,"egb_short"
+! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ enddo
+!
+! Calculate the components of the gradient in DC and X
+!
+ do l=1,3
+ gradpepcat(l,i)=gradpepcat(l,i)-gg(l)*sss_ele_cut
+ gradpepcat(l,j)=gradpepcat(l,j)+gg(l)*sss_ele_cut
+ enddo
+ end subroutine sc_grad_cat
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
- fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
- /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
- /sigmaii(itypi,itypj))
+ subroutine sc_grad_cat_pep
+ use calc_data
+ real(kind=8), dimension(3) :: dcosom1,dcosom2
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
+ +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
+ +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
-! fac=0.0d0
-! Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-! Calculate angular part of the gradient.
- call sc_grad_scale(sss)
- endif
- ENDIF !mask_dyn_ss
- enddo ! j
- enddo ! iint
- enddo ! i
-! write (iout,*) "Number of loop steps in EGB:",ind
-!ccc energy_dec=.false.
- return
- end subroutine egb_short
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+! write (iout,*) "gg",(gg(k),k=1,3)
+
+ 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)
+ gradpepcat(k,i)= gradpepcat(k,i) +sss_ele_cut*(0.5*(- gg(k)) &
+ + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
+ *dsci_inv*2.0 &
+ - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0)
+ gradpepcat(k,i+1)= gradpepcat(k,i+1) +sss_ele_cut*(0.5*(- gg(k)) &
+ - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
+ *dsci_inv*2.0 &
+ + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0)
+ gradpepcat(k,j)=gradpepcat(k,j)+gg(k)*sss_ele_cut
+ enddo
+ end subroutine sc_grad_cat_pep
+
+#ifdef CRYST_THETA
!-----------------------------------------------------------------------------
- subroutine egbv_long(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Gay-Berne-Vorobjev potential of interaction.
-!
- use calc_data
-! implicit real*8 (a-h,o-z)
+ subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
+
+ use comm_calcthet
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.NAMES'
-! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- logical :: lprn
+!el real(kind=8) :: term1,term2,termm,diffak,ratak,&
+!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
+!el delthe0,sig0inv,sigtc,sigsqtc,delthec,
+ real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
+ real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
+!el integer :: it
+!el common /calcthet/ term1,term2,termm,diffak,ratak,&
+!el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
+!el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
- real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
- evdw=0.0D0
-! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-! if (icall.eq.0) lprn=.true.
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- if (sss.lt.1.0d0) then
-
-! Calculate angle-dependent terms of energy and contributions to their
-! derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-! I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-!---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- 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
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- 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,&
- om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
- evdwij+e_augm
- endif
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-! Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-! Calculate angular part of the gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- end subroutine egbv_long
+ delthec=thetai-thet_pred_mean
+ delthe0=thetai-theta0i
+! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
+ t3 = thetai-thet_pred_mean
+ t6 = t3**2
+ t9 = term1
+ t12 = t3*sigcsq
+ t14 = t12+t6*sigsqtc
+ t16 = 1.0d0
+ t21 = thetai-theta0i
+ t23 = t21**2
+ t26 = term2
+ t27 = t21*t26
+ t32 = termexp
+ t40 = t32**2
+ E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
+ -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
+ *(-t12*t9-ak*sig0inv*t27)
+ return
+ end subroutine mixder
+#endif
!-----------------------------------------------------------------------------
- subroutine egbv_short(evdw)
+! cartder.F
+!-----------------------------------------------------------------------------
+ subroutine cartder
+!-----------------------------------------------------------------------------
+! This subroutine calculates the derivatives of the consecutive virtual
+! bond vectors and the SC vectors in the virtual-bond angles theta and
+! virtual-torsional angles phi, as well as the derivatives of SC vectors
+! in the angles alpha and omega, describing the location of a side chain
+! in its local coordinate system.
!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Gay-Berne-Vorobjev potential of interaction.
+! The derivatives are stored in the following arrays:
!
- use calc_data
-! implicit real*8 (a-h,o-z)
+! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
+! The structure is as follows:
+!
+! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
+! dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4)
+! . . . . . . . . . . . . . . . . . .
+! dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4)
+! .
+! .
+! .
+! dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N)
+!
+! DXDV - the derivatives of the side-chain vectors in theta and phi.
+! The structure is same as above.
+!
+! DCDS - the derivatives of the side chain vectors in the local spherical
+! andgles alph and omega:
+!
+! dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2)
+! dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3)
+! .
+! .
+! .
+! dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1)
+!
+! Version of March '95, based on an early version of November '91.
+!
+!**********************************************************************
+! implicit real(kind=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.GEO'
+! include 'COMMON.LOCAL'
! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
- logical :: lprn
+ real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
+ real(kind=8),dimension(3,3) :: dp,temp
+!el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+ real(kind=8),dimension(3) :: xx,xx1
!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
- real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
- evdw=0.0D0
-! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-! if (icall.eq.0) lprn=.true.
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
+ integer :: i,k,l,j,m,ind,ind1,jjj
+ real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
+ tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
+ sint2,xp,yp,xxp,yyp,zzp,dj
+
+! common /przechowalnia/ fromto
+#ifdef FIVEDIAG
+ if(.not. allocated(fromto)) allocate(fromto(3,3))
+#else
+ if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
+#endif
+! get the position of the jth ijth fragment of the chain coordinate system
+! in the fromto array.
+! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
!
-! Calculate SC interaction energy.
+! maxdim=(nres-1)*(nres-2)/2
+! allocate(dcdv(6,maxdim),dxds(6,nres))
+! calculate the derivatives of transformation matrix elements in theta
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- if (sss.gt.0.0d0) then
-
-! Calculate angle-dependent terms of energy and contributions to their
-! derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-! I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-!---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- 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
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+(evdwij+e_augm)*sss
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- 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,&
- om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
- evdwij+e_augm
- endif
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-! Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-! Calculate angular part of the gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- end subroutine egbv_short
-!-----------------------------------------------------------------------------
- subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
+!el call flush(iout) !el
+ do i=1,nres-2
+ rdt(1,1,i)=-rt(1,2,i)
+ rdt(1,2,i)= rt(1,1,i)
+ rdt(1,3,i)= 0.0d0
+ rdt(2,1,i)=-rt(2,2,i)
+ rdt(2,2,i)= rt(2,1,i)
+ rdt(2,3,i)= 0.0d0
+ rdt(3,1,i)=-rt(3,2,i)
+ rdt(3,2,i)= rt(3,1,i)
+ rdt(3,3,i)= 0.0d0
+ enddo
!
-! This subroutine calculates the average interaction energy and its gradient
-! in the virtual-bond vectors between non-adjacent peptide groups, based on
-! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
-! The potential depends both on the distance of peptide-group centers and on
-! the orientation of the CA-CA virtual bonds.
+! derivatives in phi
!
-! implicit real*8 (a-h,o-z)
-
- use comm_locel
-#ifdef MPI
- include 'mpif.h'
-#endif
-! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
-! include 'COMMON.SETUP'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VECTORS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.TIME1'
- real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
- 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
-!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
-!el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
-!el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
-!el num_conti,j1,j2
-! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- real(kind=8) :: scal_el=1.0d0
-#else
- real(kind=8) :: scal_el=0.5d0
-#endif
-! 12/13/98
-! 13-go grudnia roku pamietnego...
- real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
- 0.0d0,1.0d0,0.0d0,&
- 0.0d0,0.0d0,1.0d0/),shape(unmat))
-!el local variables
- integer :: i,j,k
- real(kind=8) :: fac
- real(kind=8) :: dxj,dyj,dzj
- real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
+ do i=2,nres-2
+ drt(1,1,i)= 0.0d0
+ drt(1,2,i)= 0.0d0
+ drt(1,3,i)= 0.0d0
+ drt(2,1,i)= rt(3,1,i)
+ drt(2,2,i)= rt(3,2,i)
+ drt(2,3,i)= rt(3,3,i)
+ drt(3,1,i)=-rt(2,1,i)
+ drt(3,2,i)=-rt(2,2,i)
+ drt(3,3,i)=-rt(2,3,i)
+ enddo
+!
+! generate the matrix products of type r(i)t(i)...r(j)t(j)
+!
+#ifndef FIVEDIAG
+ do i=2,nres-2
+ ind=indmat(i,i+1)
+ do k=1,3
+ do l=1,3
+ temp(k,l)=rt(k,l,i)
+ enddo
+ enddo
+ do k=1,3
+ do l=1,3
+ fromto(k,l,ind)=temp(k,l)
+ enddo
+ enddo
-! allocate(num_cont_hb(nres)) !(maxres)
-!d write(iout,*) 'In EELEC'
-!d do i=1,nloctyp
-!d write(iout,*) 'Type',i
-!d write(iout,*) 'B1',B1(:,i)
-!d write(iout,*) 'B2',B2(:,i)
-!d write(iout,*) 'CC',CC(:,:,i)
-!d write(iout,*) 'DD',DD(:,:,i)
-!d write(iout,*) 'EE',EE(:,:,i)
-!d enddo
-!d call check_vecgrad
-!d stop
- if (icheckgrad.eq.1) then
- do i=1,nres-1
- fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
+ do j=i+1,nres-2
+ ind=indmat(i,j+1)
do k=1,3
- dc_norm(k,i)=dc(k,i)*fac
+ do l=1,3
+ dpkl=0.0d0
+ do m=1,3
+ dpkl=dpkl+temp(k,m)*rt(m,l,j)
+ enddo
+ dp(k,l)=dpkl
+ fromto(k,l,ind)=dpkl
+ enddo
+ enddo
+ do k=1,3
+ do l=1,3
+ temp(k,l)=dp(k,l)
+ enddo
enddo
-! write (iout,*) 'i',i,' fac',fac
enddo
- endif
- if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
- .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
- wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
-! call vec_and_deriv
-#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
- endif
-!d do i=1,nres-1
-!d write (iout,*) 'i=',i
-!d do k=1,3
-!d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
-!d enddo
-!d do k=1,3
-!d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
-!d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
-!d enddo
-!d enddo
- t_eelecij=0.0d0
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
-!el ind=0
- do i=1,nres
- num_cont_hb(i)=0
- enddo
-!d print '(a)','Enter EELEC'
-!d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
-! 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)
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
enddo
+#endif
!
+! Calculate derivatives.
!
-! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
+ ind1=0
+ do i=1,nres-2
+ ind1=ind1+1
!
-! Loop over i,i+2 and i,i+3 pairs of the peptide groups
+! Derivatives of DC(i+1) in theta(i+2)
!
- do i=iturn3_start,iturn3_end
- 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)
- 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
- 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,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)
- 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
- num_conti=num_cont_hb(i)
- call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
- call eturn4(i,eello_turn4)
- num_cont_hb(i)=num_conti
- enddo ! i
+ do j=1,3
+ do k=1,2
+ dpjk=0.0D0
+ do l=1,3
+ dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
+ enddo
+ dp(j,k)=dpjk
+ prordt(j,k,i)=dp(j,k)
+ enddo
+ dp(j,3)=0.0D0
+ dcdv(j,ind1)=vbld(i+1)*dp(j,1)
+ enddo
!
-! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
+! Derivatives of SC(i+1) in theta(i+2)
+!
+ xx1(1)=-0.5D0*xloc(2,i+1)
+ xx1(2)= 0.5D0*xloc(1,i+1)
+ do j=1,3
+ xj=0.0D0
+ do k=1,2
+ xj=xj+r(j,k,i)*xx1(k)
+ enddo
+ xx(j)=xj
+ enddo
+ do j=1,3
+ rj=0.0D0
+ do k=1,3
+ rj=rj+prod(j,k,i)*xx(k)
+ enddo
+ dxdv(j,ind1)=rj
+ enddo
!
- do i=iatel_s,iatel_e
- if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- 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,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
- enddo ! i
-! write (iout,*) "Number of loop steps in EELEC:",ind
-!d do i=1,nres
-!d write (iout,'(i3,3f10.5,5x,3f10.5)')
-!d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
-!d enddo
-! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
-!cc eel_loc=eel_loc+eello_turn3
-!d print *,"Processor",fg_rank," t_eelecij",t_eelecij
- return
- end subroutine eelec_scale
-!-----------------------------------------------------------------------------
- subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
-! implicit real*8 (a-h,o-z)
-
- use comm_locel
-! include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
-! include 'COMMON.CONTROL'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VECTORS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.TIME1'
- 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
-!el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
-!el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
-!el num_conti,j1,j2
-! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- real(kind=8) :: scal_el=1.0d0
-#else
- real(kind=8) :: scal_el=0.5d0
-#endif
-! 12/13/98
-! 13-go grudnia roku pamietnego...
- real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
- 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,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
- real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
- real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
- real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
- dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
- ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
- wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
- ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
- ecosam,ecosbm,ecosgm,ghalf,time00
-! integer :: maxconts
-! maxconts = nres/4
-! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
-! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
-! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
-! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
-! 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)
-
-#ifdef MPI
- time00=MPI_Wtime()
-#endif
-!d write (iout,*) "eelecij",i,j
-!el ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
-! xj=c(1,j)+0.5D0*dxj-xmedi
-! yj=c(2,j)+0.5D0*dyj-ymedi
-! zj=c(3,j)+0.5D0*dzj-zmedi
- 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
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
-! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
-! 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*(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,
-!d & xmedi,ymedi,zmedi,xj,yj,zj
-
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
- write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
- endif
-
+! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
+! than the other off-diagonal derivatives.
!
-! Calculate contributions to the Cartesian gradient.
+ do j=1,3
+ dxoiij=0.0D0
+ do k=1,3
+ dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
+ enddo
+ dxdv(j,ind1+1)=dxoiij
+ enddo
+!d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
!
-#ifdef SPLITELE
- 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
- erij(3)=zj*rmij
+! Derivatives of DC(i+1) in phi(i+2)
!
-! 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
-! do k=1,3
-! ghalf=0.5D0*ggg(k)
-! gelc(k,i)=gelc(k,i)+ghalf
-! gelc(k,j)=gelc(k,j)+ghalf
-! enddo
-! 9/28/08 AL Gradient compotents will be summed only at the end
+ do j=1,3
do k=1,3
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
+ dpjk=0.0
+ do l=2,3
+ dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
+ enddo
+ dp(j,k)=dpjk
+ prodrt(j,k,i)=dp(j,k)
+ enddo
+ dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
+ enddo
!
-! Loop over residues i+1 thru j-1.
+! Derivatives of SC(i+1) in phi(i+2)
!
-!grad do k=i+1,j-1
-!grad do l=1,3
-!grad gelc(l,k)=gelc(l,k)+ggg(l)
-!grad enddo
-!grad enddo
- 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
-! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
-! enddo
-! 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+ xx(1)= 0.0D0
+ xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
+ xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
+ do j=1,3
+ rj=0.0D0
+ do k=2,3
+ rj=rj+prod(j,k,i)*xx(k)
enddo
+ dxdv(j+3,ind1)=-rj
+ enddo
!
-! Loop over residues i+1 thru j-1.
-!
-!grad do k=i+1,j-1
-!grad do l=1,3
-!grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
-!grad enddo
-!grad enddo
-#else
- 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
- erij(2)=yj*rmij
- erij(3)=zj*rmij
+! Derivatives of SC(i+1) in phi(i+3).
!
-! Radial derivatives. First process both termini of the fragment (i,j)
-!
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
-! do k=1,3
-! ghalf=0.5D0*ggg(k)
-! gelc(k,i)=gelc(k,i)+ghalf
-! gelc(k,j)=gelc(k,j)+ghalf
-! enddo
-! 9/28/08 AL Gradient compotents will be summed only at the end
+ do j=1,3
+ dxoiij=0.0D0
do k=1,3
- gelc_long(k,j)=gelc(k,j)+ggg(k)
- gelc_long(k,i)=gelc(k,i)-ggg(k)
+ dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
enddo
+ dxdv(j+3,ind1+1)=dxoiij
+ enddo
!
-! Loop over residues i+1 thru j-1.
+! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
+! theta(nres) and phi(i+3) thru phi(nres).
!
-!grad do k=i+1,j-1
-!grad do l=1,3
-!grad gelc(l,k)=gelc(l,k)+ggg(l)
-!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
+ do j=i+1,nres-2
+ ind1=ind1+1
+ ind=indmat(i+1,j+1)
+!d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
+#ifdef FIVEDIAG
+ call build_fromto(i+1,j+1,fromto)
+!c write(iout,'(7hfromto 9f10.5)')((fromto(k,l),l=1,3),k=1,3)
do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,2
+ tempkl=tempkl+prordt(k,m,i)*fromto(m,l)
+ enddo
+ temp(k,l)=tempkl
+ enddo
enddo
-#endif
-!
-! Angular part
-!
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
+#else
do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
-!d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
-!d & (dcosg(k),k=1,3)
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,2
+ tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
+ enddo
+ temp(k,l)=tempkl
+ enddo
+ enddo
+#endif
+!d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
+!d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
+!d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
+! Derivatives of virtual-bond vectors in theta
do k=1,3
- ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
+ dcdv(k,ind1)=vbld(i+1)*temp(k,1)
enddo
-! do k=1,3
-! ghalf=0.5D0*ggg(k)
-! gelc(k,i)=gelc(k,i)+ghalf
-! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
-! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
-! gelc(k,j)=gelc(k,j)+ghalf
-! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
-! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-! enddo
-!grad do k=i+1,j-1
-!grad do l=1,3
-!grad gelc(l,k)=gelc(l,k)+ggg(l)
-!grad enddo
-!grad enddo
+!d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
+! Derivatives of SC vectors in theta
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)&
- *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)&
- *sss_ele_cut
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
+ dxoijk=0.0D0
+ do l=1,3
+ dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
+ enddo
+ dxdv(k,ind1+1)=dxoijk
enddo
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
- .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
- .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
!
-! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
-! energy of a peptide unit is assumed in the form of a second-order
-! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
-! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
-! are computed for EVERY pair of non-contiguous peptide groups.
+!--- Calculate the derivatives in phi
!
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
+#ifdef FIVEDIAG
+ do k=1,3
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,3
+ tempkl=tempkl+prodrt(k,m,i)*fromto(m,l)
+ enddo
+ temp(k,l)=tempkl
enddo
- enddo
-!d write (iout,*) 'EELEC: i',i,' j',j
-!d write (iout,*) 'j',j,' j1',j1,' j2',j2
-!d write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
- fac=dsqrt(-ael6i)*r3ij
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
-!d write (iout,'(4i5,4f10.5)')
-!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)
-!d write (iout,'(4f10.5)')
-!d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
-!d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
-!d write (iout,'(4f10.5)') ury,urz,vry,vrz
-!d write (iout,'(9f10.5/)')
-!d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
-! Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
+ enddo
+#else
do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,3
+ tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
+ enddo
+ temp(k,l)=tempkl
+ enddo
enddo
-! Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
-! Add the contributions coming from er
- fac3=-3.0d0*fac
+#endif
+
+
do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
+ dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
+ enddo
do k=1,3
-! Derivatives in DC(i)
-!grad ghalf1=0.5d0*agg(k,1)
-!grad ghalf2=0.5d0*agg(k,2)
-!grad ghalf3=0.5d0*agg(k,3)
-!grad ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
- -3.0d0*uryg(k,2)*vry)!+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
- -3.0d0*uryg(k,2)*vrz)!+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
- -3.0d0*urzg(k,2)*vry)!+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
- -3.0d0*urzg(k,2)*vrz)!+ghalf4
-! Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
- -3.0d0*uryg(k,3)*vry)!+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
- -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
- -3.0d0*urzg(k,3)*vry)!+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
- -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
-! Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
- -3.0d0*vryg(k,2)*ury)!+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
- -3.0d0*vrzg(k,2)*ury)!+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
- -3.0d0*vryg(k,2)*urz)!+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
- -3.0d0*vrzg(k,2)*urz)!+ghalf4
-! Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
- -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
- -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
- -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
- -3.0d0*vrzg(k,3)*urz)
-!grad if (j.eq.nres-1 .and. i.lt.j-2) then
-!grad do l=1,4
-!grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
-!grad enddo
-!grad endif
- enddo
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
- a22=-a22
- a23=-a23
- do l=1,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
+ dxoijk=0.0D0
+ do l=1,3
+ dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
enddo
+ dxdv(k+3,ind1+1)=dxoijk
enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
+ enddo
+ enddo
+!
+! Derivatives in alpha and omega:
+!
+ do i=2,nres-1
+! dsci=dsc(itype(i,1))
+ dsci=vbld(i+nres)
+#ifdef OSF
+ alphi=alph(i)
+ omegi=omeg(i)
+ if(alphi.ne.alphi) alphi=100.0
+ if(omegi.ne.omegi) omegi=-100.0
+#else
+ alphi=alph(i)
+ omegi=omeg(i)
+#endif
+!d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
+ cosalphi=dcos(alphi)
+ sinalphi=dsin(alphi)
+ cosomegi=dcos(omegi)
+ sinomegi=dsin(omegi)
+ temp(1,1)=-dsci*sinalphi
+ temp(2,1)= dsci*cosalphi*cosomegi
+ temp(3,1)=-dsci*cosalphi*sinomegi
+ temp(1,2)=0.0D0
+ temp(2,2)=-dsci*sinalphi*sinomegi
+ temp(3,2)=-dsci*sinalphi*cosomegi
+ theta2=pi-0.5D0*theta(i+1)
+ cost2=dcos(theta2)
+ sint2=dsin(theta2)
+ jjj=0
+!d print *,((temp(l,k),l=1,3),k=1,2)
+ do j=1,2
+ xp=temp(1,j)
+ yp=temp(2,j)
+ xxp= xp*cost2+yp*sint2
+ yyp=-xp*sint2+yp*cost2
+ zzp=temp(3,j)
+ xx(1)=xxp
+ xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
+ xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
+ do k=1,3
+ dj=0.0D0
+ do l=1,3
+ dj=dj+prod(k,l,i-1)*xx(l)
enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
- IF (wel_loc.gt.0.0d0) THEN
-! 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)
-! 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*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)) &
- *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)
+ dxds(jjj+k,i)=dj
+ enddo
+ jjj=jjj+3
+ enddo
+ enddo
+ return
+ end subroutine cartder
+#ifdef FIVEDIAG
+ subroutine build_fromto(i,j,fromto)
+ implicit none
+ integer i,j,jj,k,l,m
+ double precision fromto(3,3),temp(3,3),dp(3,3)
+ double precision dpkl
+ save temp
+!
+! generate the matrix products of type r(i)t(i)...r(j)t(j) on the fly
+!
+! write (iout,*) "temp on entry"
+! write (iout,'(3f10.5)') ((temp(k,l),l=1,3),k=1,3)
+! do i=2,nres-2
+! ind=indmat(i,i+1)
+ if (j.eq.i+1) then
+ do k=1,3
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))&
- *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 gel_loc(l,i)=gel_loc(l,i)+ghalf
-!grad gel_loc(l,j)=gel_loc(l,j)+ghalf
+ temp(k,l)=rt(k,l,i)
enddo
-!grad do k=i+1,j2
-!grad do l=1,3
-!grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
-!grad enddo
-!grad enddo
-! Remaining derivatives of eello
+ enddo
+ do k=1,3
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
-
- 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
-
+ fromto(k,l)=temp(k,l)
enddo
- ENDIF
-! Change 12/26/95 to calculate four-body contributions to H-bonding energy
-! if (j.gt.i+1 .and. num_conti.le.maxconts) then
- if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
- .and. num_conti.le.maxconts) then
-! write (iout,*) i,j," entered corr"
-!
-! Calculate the contact function. The ith column of the array JCONT will
-! contain the numbers of atoms that make contacts with the atom I (of numbers
-! greater than I). The arrays FACONT and GACONT will contain the values of
-! the contact function and its derivative.
-! r0ij=1.02D0*rpp(iteli,itelj)
-! r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-! r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
-!elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
-!elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
- write (iout,*) 'WARNING - max. # of contacts exceeded;',&
- ' will skip next contacts for this conf.',num_conti
- else
- jcont_hb(num_conti,i)=j
-!d write (iout,*) "i",i," j",j," num_conti",num_conti,
-!d & " jcont_hb",jcont_hb(num_conti,i)
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
- wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
-! terms.
- d_cont(num_conti,i)=rij
-!d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
-! --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
-! --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
- enddo
- enddo
- enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
-! Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-! fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
-! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
-! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
-! ees0mij=0.0D0
- 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
-! ees0m(num_conti,i)=0.0D0
-! End diagnostics.
-! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
-! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
-! Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-! ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
-! Diagnostics
-! ecosap=ecosa1
-! ecosbp=ecosb1
-! ecosgp=ecosg1
-! ecosam=0.0D0
-! ecosbm=0.0D0
-! ecosgm=0.0D0
-! End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
-!d facont_hb(num_conti,i)=1.0D0
-! Following line is for diagnostics.
-!d fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
-! gggp(1)=gggp(1)+ees0pijp*xj
-! gggp(2)=gggp(2)+ees0pijp*yj
-! gggp(3)=gggp(3)+ees0pijp*zj
-! gggm(1)=gggm(1)+ees0mijp*xj
-! gggm(2)=gggm(2)+ees0mijp*yj
-! gggm(3)=gggm(3)+ees0mijp*zj
- 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
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
-!
-! 10/24/08 cgrad and ! comments indicate the parts of the code removed
-! following the change of gradient-summation algorithm.
-!
-!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) &
- *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
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
- do k=1,4
- do l=1,3
- ghalf=0.5d0*agg(l,k)
- aggi(l,k)=aggi(l,k)+ghalf
- aggi1(l,k)=aggi1(l,k)+agg(l,k)
- aggj(l,k)=aggj(l,k)+ghalf
+ enddo
+ else
+! do j=i+1,nres-2
+! ind=indmat(i,j+1)
+ do k=1,3
+ do l=1,3
+ dpkl=0.0d0
+ do m=1,3
+ dpkl=dpkl+temp(k,m)*rt(m,l,j-1)
enddo
+ dp(k,l)=dpkl
+ fromto(k,l)=dpkl
enddo
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do k=1,4
- do l=1,3
- aggj1(l,k)=aggj1(l,k)+agg(l,k)
- enddo
- enddo
- endif
- endif
- 128 continue
-! t_eelecij=t_eelecij+MPI_Wtime()-time00
+ enddo
+ do k=1,3
+ do l=1,3
+ temp(k,l)=dp(k,l)
+ enddo
+ enddo
+ endif
+! write (iout,*) "temp upon exit"
+! write (iout,'(3f10.5)') ((temp(k,l),l=1,3),k=1,3)
+! enddo
+! enddo
return
- end subroutine eelecij_scale
+ end subroutine build_fromto
+#endif
+
!-----------------------------------------------------------------------------
- subroutine evdwpp_short(evdw1)
-!
-! Compute Evdwpp
-!
-! implicit real*8 (a-h,o-z)
+! checkder_p.F
+!-----------------------------------------------------------------------------
+ subroutine check_cartgrad
+! Check the gradient of Cartesian coordinates in internal coordinates.
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
! include 'COMMON.IOUNITS'
-! include 'COMMON.GEO'
! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
! include 'COMMON.CHAIN'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.TORSION'
-! include 'COMMON.VECTORS'
-! include 'COMMON.FFIELD'
- real(kind=8),dimension(3) :: ggg
-! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- real(kind=8) :: scal_el=1.0d0
-#else
- real(kind=8) :: scal_el=0.5d0
-#endif
-!el local variables
- 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,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- 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,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
-!el ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
-! xj=c(1,j)+0.5D0*dxj-xmedi
-! yj=c(2,j)+0.5D0*dyj-ymedi
-! zj=c(3,j)+0.5D0*dzj-zmedi
- xj=c(1,j)+0.5D0*dxj
- yj=c(2,j)+0.5D0*dyj
- zj=c(3,j)+0.5D0*dzj
- 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
- r6ij=r3ij*r3ij
- ev1=aaa*r6ij*r6ij
-! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- evdwij=ev1+ev2
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
- endif
- evdw1=evdw1+evdwij*sss*sss_ele_cut
-!
-! Calculate contributions to the Cartesian gradient.
-!
- 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)
- enddo
- endif
- enddo ! j
- enddo ! i
- return
- end subroutine evdwpp_short
-!-----------------------------------------------------------------------------
- subroutine escp_long(evdw2,evdw2_14)
-!
-! This subroutine calculates the excluded-volume interaction energy between
-! peptide-group centers and side chains and its gradient in virtual-bond and
-! side-chain vectors.
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.FFIELD'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CONTROL'
- real(kind=8),dimension(3) :: ggg
-!el local variables
- 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,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,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)
- 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.lt.1.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)*(1.0d0-sss)*sss_ele_cut
- endif
- evdwij=e1+e2
- 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.
+ real(kind=8),dimension(6,nres) :: temp
+ real(kind=8),dimension(3) :: xx,gg
+ integer :: i,k,j,ii
+ real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
+! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
!
- 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
-! 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
+! Check the gradient of the virtual-bond and SC vectors in the internal
+! coordinates.
+!
+ aincr=1.0d-6
+ aincr2=5.0d-7
+ call cartder
+ write (iout,'(a)') '**************** dx/dalpha'
+ write (iout,'(a)')
+ do i=2,nres-1
+ alphi=alph(i)
+ alph(i)=alph(i)+aincr
+ do k=1,3
+ temp(k,i)=dc(k,nres+i)
enddo
-
- 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)
+ call chainbuild
+ do k=1,3
+ gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
+ xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
enddo
+ write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
+ i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
+ alph(i)=alphi
+ call chainbuild
enddo
-!******************************************************************************
-!
-! N O T E !!!
-!
-! To save time the factor EXPON has been extracted from ALL components
-! of GVDWC and GRADX. Remember to multiply them by this factor before further
-! use!
-!
-!******************************************************************************
- return
- end subroutine escp_long
-!-----------------------------------------------------------------------------
- subroutine escp_short(evdw2,evdw2_14)
-!
-! This subroutine calculates the excluded-volume interaction energy between
-! peptide-group centers and side chains and its gradient in virtual-bond and
-! side-chain vectors.
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.FFIELD'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CONTROL'
- real(kind=8),dimension(3) :: ggg
-!el local variables
- 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,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,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)
- 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)
+ write (iout,'(a)')
+ write (iout,'(a)') '**************** dx/domega'
+ write (iout,'(a)')
+ do i=2,nres-1
+ omegi=omeg(i)
+ omeg(i)=omeg(i)+aincr
+ do k=1,3
+ temp(k,i)=dc(k,nres+i)
enddo
- enddo
-!******************************************************************************
-!
-! N O T E !!!
-!
-! To save time the factor EXPON has been extracted from ALL components
-! of GVDWC and GRADX. Remember to multiply them by this factor before further
-! use!
-!
-!******************************************************************************
- return
- end subroutine escp_short
-!-----------------------------------------------------------------------------
-! energy_p_new-sep_barrier.F
-!-----------------------------------------------------------------------------
- subroutine sc_grad_scale(scalfac)
-! implicit real*8 (a-h,o-z)
- use calc_data
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.CALC'
-! include 'COMMON.IOUNITS'
- real(kind=8),dimension(3) :: dcosom1,dcosom2
- real(kind=8) :: scalfac
-!el local variables
-! integer :: i,j,k,l
-
- 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
-! diagnostics only
-! eom1=0.0d0
-! eom2=0.0d0
-! eom12=evdwij*eps1_om12
-! end diagnostics
-! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-! & " sigder",sigder
-! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
+ call chainbuild
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)=(dc(k,nres+i)-temp(k,i))/aincr
+ xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
+ (aincr*dabs(dxds(k+3,i))+aincr))
+ enddo
+ write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
+ i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
+ omeg(i)=omegi
+ call chainbuild
enddo
- do k=1,3
- gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
- *sss_ele_cut
- enddo
-! write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k) &
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
- *sss_ele_cut
- 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*scalfac&
- *sss_ele_cut
-! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ write (iout,'(a)')
+ write (iout,'(a)') '**************** dx/dtheta'
+ write (iout,'(a)')
+ do i=3,nres
+ theti=theta(i)
+ theta(i)=theta(i)+aincr
+ do j=i-1,nres-1
+ do k=1,3
+ temp(k,j)=dc(k,nres+j)
+ enddo
+ enddo
+ call chainbuild
+ do j=i-1,nres-1
+ ii = indmat(i-2,j)
+! print *,'i=',i-2,' j=',j-1,' ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
+ (aincr*dabs(dxdv(k,ii))+aincr))
+ enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
+ write(iout,'(a)')
+ enddo
+ write (iout,'(a)')
+ theta(i)=theti
+ call chainbuild
enddo
-!
-! Calculate the components of the gradient in DC and X
-!
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ write (iout,'(a)') '***************** dx/dphi'
+ write (iout,'(a)')
+ do i=4,nres
+ phi(i)=phi(i)+aincr
+ do j=i-1,nres-1
+ do k=1,3
+ temp(k,j)=dc(k,nres+j)
+ enddo
+ enddo
+ call chainbuild
+ do j=i-1,nres-1
+ ii = indmat(i-2,j)
+! print *,'ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
+ (aincr*dabs(dxdv(k+3,ii))+aincr))
+ enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
+ write(iout,'(a)')
+ enddo
+ phi(i)=phi(i)-aincr
+ call chainbuild
enddo
- return
- end subroutine sc_grad_scale
-!-----------------------------------------------------------------------------
-! energy_split-sep.F
-!-----------------------------------------------------------------------------
- subroutine etotal_long(energia)
-!
-! Compute the long-range slow-varying contributions to the energy
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- use MD_data, only: totT,usampl,eq_time
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-!MS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
- real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
-#endif
-! include 'COMMON.SETUP'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.SBRIDGE'
+ write (iout,'(a)') '****************** ddc/dtheta'
+ do i=1,nres-2
+ thet=theta(i+2)
+ theta(i+2)=thet+aincr
+ do j=i,nres
+ do k=1,3
+ temp(k,j)=dc(k,j)
+ enddo
+ enddo
+ call chainbuild
+ do j=i+1,nres-1
+ ii = indmat(i,j)
+! print *,'ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
+ (aincr*dabs(dcdv(k,ii))+aincr))
+ enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
+ enddo
+ do j=1,nres
+ do k=1,3
+ dc(k,j)=temp(k,j)
+ enddo
+ enddo
+ theta(i+2)=thet
+ enddo
+ write (iout,'(a)') '******************* ddc/dphi'
+ do i=1,nres-3
+ phii=phi(i+3)
+ phi(i+3)=phii+aincr
+ do j=1,nres
+ do k=1,3
+ temp(k,j)=dc(k,j)
+ enddo
+ enddo
+ call chainbuild
+ do j=i+2,nres-1
+ ii = indmat(i+1,j)
+! print *,'ii=',ii
+ do k=1,3
+ gg(k)=(dc(k,j)-temp(k,j))/aincr
+ xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
+ (aincr*dabs(dcdv(k+3,ii))+aincr))
+ enddo
+ write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
+ i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
+ write (iout,'(a)')
+ enddo
+ do j=1,nres
+ do k=1,3
+ dc(k,j)=temp(k,j)
+ enddo
+ enddo
+ phi(i+3)=phii
+ enddo
+ return
+ end subroutine check_cartgrad
+!-----------------------------------------------------------------------------
+ subroutine check_ecart
+! Check the gradient of the energy in Cartesian coordinates.
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.VAR'
+! include 'COMMON.CONTACTS'
+ use comm_srutu
+!#ifdef LBFGS
+! use minimm, only: funcgrad
+!#endif
+!el integer :: icall
+!el common /srutu/ icall
+! real(kind=8) :: funcgrad
+ real(kind=8),dimension(6) :: ggg
+ real(kind=8),dimension(3) :: cc,xx,ddc,ddx
+ real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
+ real(kind=8),dimension(6,nres) :: grad_s
+ real(kind=8),dimension(0:n_ene) :: energia,energia1
+ integer :: uiparm(1)
+ real(kind=8) :: urparm(1)
+!EL external fdum
+ integer :: nf,i,j,k
+ real(kind=8) :: aincr,etot,etot1,ff
+ icg=1
+ nf=0
+ nfl=0
+ call zerograd
+ aincr=1.0D-5
+ print '(a)','CG processor',me,' calling CHECK_CART.',aincr
+ nf=0
+ icall=0
+ call geom_to_var(nvar,x)
+ call etotal(energia)
+ etot=energia(0)
+#ifdef LBFGS
+ ff=funcgrad(x,g)
+#else
+!el call enerprint(energia)
+ call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
+#endif
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
+ 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)
+ enddo
+ enddo
+ call flush(iout)
+ write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
+ do i=1,nres
+ do j=1,3
+ xx(j)=c(j,i+nres)
+ ddc(j)=dc(j,i)
+ ddx(j)=dc(j,i+nres)
+ enddo
+ do j=1,3
+ dc(j,i)=dc(j,i)+aincr
+ do k=i+1,nres
+ c(j,k)=c(j,k)+aincr
+ c(j,k+nres)=c(j,k+nres)+aincr
+ enddo
+ call zerograd
+ call etotal(energia1)
+ etot1=energia1(0)
+ ggg(j)=(etot1-etot)/aincr
+ dc(j,i)=ddc(j)
+ do k=i+1,nres
+ c(j,k)=c(j,k)-aincr
+ c(j,k+nres)=c(j,k+nres)-aincr
+ enddo
+ enddo
+ do j=1,3
+ c(j,i+nres)=c(j,i+nres)+aincr
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call zerograd
+ call etotal(energia1)
+ etot1=energia1(0)
+ ggg(j+3)=(etot1-etot)/aincr
+ c(j,i+nres)=xx(j)
+ dc(j,i+nres)=ddx(j)
+ enddo
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
+ enddo
+ return
+ end subroutine check_ecart
+#ifdef CARGRAD
+!-----------------------------------------------------------------------------
+ subroutine check_ecartint
+! Check the gradient of the energy in Cartesian coordinates.
+ use io_base, only: intout
+ use MD_data, only: iset
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.IOUNITS'
! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
+! include 'COMMON.CONTACTS'
! include 'COMMON.MD'
- real(kind=8),dimension(0:n_ene) :: energia
-!el local variables
- integer :: i,n_corr,n_corr1,ierror,ierr
- real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
- evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
- ecorr,ecorr5,ecorr6,eturn6,time00
-! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
-!elwrite(iout,*)"in etotal long"
-
- if (modecalc.eq.12.or.modecalc.eq.14) then
-#ifdef MPI
-! if (fg_rank.eq.0) call int_from_cart1(.false.)
-#else
- call int_from_cart1(.false.)
+! include 'COMMON.LOCAL'
+! include 'COMMON.SPLITELE'
+ use comm_srutu
+!el integer :: icall
+!el common /srutu/ icall
+ real(kind=8),dimension(6) :: ggg,ggg1
+ real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
+ real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
+ real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
+ real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
+ real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
+ real(kind=8),dimension(0:n_ene) :: energia,energia1
+ integer :: uiparm(1)
+ real(kind=8) :: urparm(1)
+!EL external fdum
+ integer :: i,j,k,nf
+ real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
+ etot21,etot22
+ r_cut=2.0d0
+ rlambd=0.3d0
+ icg=1
+ nf=0
+ nfl=0
+ if (iset.eq.0) iset=1
+ call intout
+! call intcartderiv
+! call checkintcartgrad
+ call zerograd
+ aincr=graddelta
+ write(iout,*) 'Calling CHECK_ECARTINT.,kupa'
+ nf=0
+ icall=0
+ call geom_to_var(nvar,x)
+ write (iout,*) "split_ene ",split_ene
+ call flush(iout)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia)
+ etot=energia(0)
+ call cartgrad
+#ifdef FIVEDIAG
+ call grad_transform
#endif
- endif
-!elwrite(iout,*)"in etotal long"
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s(j,0)=gcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s(j,i)=gcart(j,i)
+ grad_s(j+3,i)=gxcart(j,i)
+ write(iout,*) "before movement analytical gradient"
+
+ enddo
+ enddo
+ 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
-#ifdef MPI
-! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
-! & " absolute rank",myrank," nfgtasks",nfgtasks
- call flush(iout)
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-! FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (fg_rank.eq.0) then
- call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
-! write (iout,*) "Processor",myrank," BROADCAST iorder"
-! call flush(iout)
-! FG master sets up the WEIGHTS_ array which will be broadcast to the
-! FG slaves as WEIGHTS array.
- weights_(1)=wsc
- weights_(2)=wscp
- weights_(3)=welec
- weights_(4)=wcorr
- weights_(5)=wcorr5
- weights_(6)=wcorr6
- weights_(7)=wel_loc
- weights_(8)=wturn3
- weights_(9)=wturn4
- weights_(10)=wturn6
- weights_(11)=wang
- weights_(12)=wscloc
- weights_(13)=wtor
- weights_(14)=wtor_d
- weights_(15)=wstrain
- weights_(16)=wvdwpp
- weights_(17)=wbond
- weights_(18)=scal14
- weights_(21)=wsccor
-! FG Master broadcasts the WEIGHTS_ array
- call MPI_Bcast(weights_(1),n_ene,&
- MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- else
-! FG slaves receive the WEIGHTS array
- call MPI_Bcast(weights(1),n_ene,&
- MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- wsc=weights(1)
- wscp=weights(2)
- welec=weights(3)
- wcorr=weights(4)
- wcorr5=weights(5)
- wcorr6=weights(6)
- wel_loc=weights(7)
- wturn3=weights(8)
- wturn4=weights(9)
- wturn6=weights(10)
- wang=weights(11)
- wscloc=weights(12)
- wtor=weights(13)
- wtor_d=weights(14)
- wstrain=weights(15)
- wvdwpp=weights(16)
- wbond=weights(17)
- scal14=weights(18)
- wsccor=weights(21)
- endif
- call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
- time_Bcastw=time_Bcastw+MPI_Wtime()-time00
-! call chainbuild_cart
-! call int_from_cart1(.false.)
- endif
-! write (iout,*) 'Processor',myrank,
-! & ' calling etotal_short ipot=',ipot
-! call flush(iout)
-! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
-#endif
-!d print *,'nnt=',nnt,' nct=',nct
-!
-!elwrite(iout,*)"in etotal long"
-! Compute the side-chain and electrostatic interaction energy
-!
- goto (101,102,103,104,105,106) ipot
-! Lennard-Jones potential.
- 101 call elj_long(evdw)
-!d print '(a)','Exit ELJ'
- goto 107
-! Lennard-Jones-Kihara potential (shifted).
- 102 call eljk_long(evdw)
- goto 107
-! Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp_long(evdw)
- goto 107
-! Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb_long(evdw)
- goto 107
-! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv_long(evdw)
- goto 107
-! Soft-sphere potential
- 106 call e_softsphere(evdw)
-!
-! Calculate electrostatic (H-bonding) energy of the main chain.
-!
- 107 continue
- call vec_and_deriv
- if (ipot.lt.6) then
-#ifdef SPLITELE
- if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
- wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
- .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
- .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#else
- if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
- wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
- .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
- .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#endif
- call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
- else
- ees=0
- evdw1=0
- eel_loc=0
- eello_turn3=0
- eello_turn4=0
- endif
- else
-! write (iout,*) "Soft-spheer ELEC potential"
- call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
- eello_turn4)
- endif
-!
-! Calculate excluded-volume interaction energy between peptide groups
-! and side chains.
-!
- if (ipot.lt.6) then
- if(wscp.gt.0d0) then
- call escp_long(evdw2,evdw2_14)
- else
- evdw2=0
- evdw2_14=0
- endif
- else
- call escp_soft_sphere(evdw2,evdw2_14)
- endif
-!
-! 12/1/95 Multi-body terms
-!
- n_corr=0
- n_corr1=0
- if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
- .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
-! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
-! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
- else
- ecorr=0.0d0
- ecorr5=0.0d0
- ecorr6=0.0d0
- eturn6=0.0d0
- endif
- if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
- endif
-!
-! If performing constraint dynamics, call the constraint energy
-! after the equilibration time
- if(usampl.and.totT.gt.eq_time) then
- call EconstrQ
- call Econstr_back
else
- Uconst=0.0d0
- Uconst_back=0.0d0
- endif
-!
-! Sum the energies
-!
- do i=1,n_ene
- energia(i)=0.0d0
- enddo
- energia(1)=evdw
-#ifdef SCP14
- energia(2)=evdw2-evdw2_14
- energia(18)=evdw2_14
-#else
- energia(2)=evdw2
- energia(18)=0.0d0
-#endif
-#ifdef SPLITELE
- energia(3)=ees
- energia(16)=evdw1
-#else
- energia(3)=ees+evdw1
- energia(16)=0.0d0
-#endif
- energia(4)=ecorr
- energia(5)=ecorr5
- energia(6)=ecorr6
- energia(7)=eel_loc
- energia(8)=eello_turn3
- energia(9)=eello_turn4
- energia(10)=eturn6
- energia(20)=Uconst+Uconst_back
- call sum_energy(energia,.true.)
-! write (iout,*) "Exit ETOTAL_LONG"
- call flush(iout)
- return
- end subroutine etotal_long
-!-----------------------------------------------------------------------------
- subroutine etotal_short(energia)
-!
-! Compute the short-range fast-varying contributions to the energy
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-!MS$ATTRIBUTES C :: proc_proc
+!- split gradient check
+ call zerograd
+ call etotal_long(energia)
+!el call enerprint(energia)
+ call cartgrad
+#ifdef FIVEDIAG
+ call grad_transform
#endif
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s(j,0)=gcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s(j,i)=gcart(j,i)
+ grad_s(j+3,i)=gxcart(j,i)
+ enddo
+ enddo
+ call zerograd
+ call etotal_short(energia)
+ call enerprint(energia)
+ call cartgrad
+#ifdef FIVEDIAG
+ call grad_transform
#endif
-#ifdef MPI
- include "mpif.h"
- integer :: ierror,ierr
- real(kind=8),dimension(n_ene) :: weights_
- real(kind=8) :: time00
-#endif
-! include 'COMMON.SETUP'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.DERIV'
-! include 'COMMON.INTERACT'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CHAIN'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
- real(kind=8),dimension(0:n_ene) :: energia
-!el local variables
- integer :: i,nres6
- real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
- real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
- nres6=6*nres
-! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
-! call flush(iout)
- if (modecalc.eq.12.or.modecalc.eq.14) then
-#ifdef MPI
- if (fg_rank.eq.0) call int_from_cart1(.false.)
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s1(j,0)=gcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s1(j,i)=gcart(j,i)
+ grad_s1(j+3,i)=gxcart(j,i)
+ enddo
+ enddo
+ endif
+ write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
+#ifdef FIVEDIAG
+ do i=1,nres
#else
- call int_from_cart1(.false.)
+ do i=nnt,nct
#endif
+ do j=1,3
+ if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
+ if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
+ ddc(j)=c(j,i)
+ ddx(j)=c(j,i+nres)
+ dcnorm_safe1(j)=dc_norm(j,i-1)
+ dcnorm_safe2(j)=dc_norm(j,i)
+ dxnorm_safe(j)=dc_norm(j,i+nres)
+ enddo
+ do j=1,3
+ c(j,i)=ddc(j)+aincr
+ if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
+ if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
+ if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia1)
+ etot1=energia1(0)
+! write (iout,*) "ij",i,j," etot1",etot1
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot11=energia1(0)
+ call etotal_short(energia1)
+ etot12=energia1(0)
+ endif
+!- end split gradient
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
+ c(j,i)=ddc(j)-aincr
+ if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
+ if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
+ if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia1)
+ etot2=energia1(0)
+! write (iout,*) "ij",i,j," etot2",etot2
+ ggg(j)=(etot1-etot2)/(2*aincr)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot21=energia1(0)
+ ggg(j)=(etot11-etot21)/(2*aincr)
+ call etotal_short(energia1)
+ etot22=energia1(0)
+ ggg1(j)=(etot12-etot22)/(2*aincr)
+!- end split gradient
+! write (iout,*) "etot21",etot21," etot22",etot22
+ endif
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
+ c(j,i)=ddc(j)
+ if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
+ if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
+ if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ dc_norm(j,i-1)=dcnorm_safe1(j)
+ dc_norm(j,i)=dcnorm_safe2(j)
+ dc_norm(j,i+nres)=dxnorm_safe(j)
+ enddo
+ do j=1,3
+ c(j,i+nres)=ddx(j)+aincr
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia1)
+ etot1=energia1(0)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot11=energia1(0)
+ call etotal_short(energia1)
+ etot12=energia1(0)
+ endif
+!- end split gradient
+ c(j,i+nres)=ddx(j)-aincr
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia1)
+ etot2=energia1(0)
+ ggg(j+3)=(etot1-etot2)/(2*aincr)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot21=energia1(0)
+ ggg(j+3)=(etot11-etot21)/(2*aincr)
+ call etotal_short(energia1)
+ etot22=energia1(0)
+ ggg1(j+3)=(etot12-etot22)/(2*aincr)
+!- end split gradient
+ endif
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
+ c(j,i+nres)=ddx(j)
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ dc_norm(j,i+nres)=dxnorm_safe(j)
+ call int_from_cart1(.false.)
+ enddo
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
+ if (split_ene) then
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
+ k=1,6)
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
+ ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
+ endif
+ enddo
+ return
+ end subroutine check_ecartint
+#else
+!-----------------------------------------------------------------------------
+ subroutine check_ecartint
+! Check the gradient of the energy in Cartesian coordinates.
+ use io_base, only: intout
+ use MD_data, only: iset
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.VAR'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.MD'
+! include 'COMMON.LOCAL'
+! include 'COMMON.SPLITELE'
+ use comm_srutu
+!el integer :: icall
+!el common /srutu/ icall
+ real(kind=8),dimension(6) :: ggg,ggg1
+ real(kind=8),dimension(3) :: cc,xx,ddc,ddx
+ real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
+ real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
+ real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
+ real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
+ real(kind=8),dimension(0:n_ene) :: energia,energia1
+ integer :: uiparm(1)
+ real(kind=8) :: urparm(1)
+!EL external fdum
+ integer :: i,j,k,nf
+ real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
+ etot21,etot22
+ r_cut=2.0d0
+ rlambd=0.3d0
+ icg=1
+ nf=0
+ nfl=0
+ if (iset.eq.0) iset=1
+ call intout
+! call intcartderiv
+! call checkintcartgrad
+ call zerograd
+ aincr=1.0D-6
+ write(iout,*) 'Calling CHECK_ECARTINT.',aincr
+ nf=0
+ icall=0
+ call geom_to_var(nvar,x)
+ if (.not.split_ene) then
+ call etotal(energia)
+ etot=energia(0)
+! call enerprint(energia)
+ call cartgrad
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s(j,0)=gcart(j,0)
+ grad_s(j+3,0)=gxcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s(j,i)=gcart(j,i)
+ grad_s(j+3,i)=gxcart(j,i)
+ enddo
+ enddo
+ write(iout,*) "before movement analytical gradient"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+
+ else
+!- split gradient check
+ call zerograd
+ call etotal_long(energia)
+!el call enerprint(energia)
+ call cartgrad
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s(j,0)=gcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s(j,i)=gcart(j,i)
+! 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 cartgrad
+ icall =1
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+ do j=1,3
+ grad_s1(j,0)=gcart(j,0)
+ enddo
+ do i=1,nres
+ do j=1,3
+ grad_s1(j,i)=gcart(j,i)
+ grad_s1(j+3,i)=gxcart(j,i)
+ enddo
+ enddo
endif
-#ifdef MPI
-! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
-! & " absolute rank",myrank," nfgtasks",nfgtasks
-! call flush(iout)
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-! FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (fg_rank.eq.0) then
- call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
-! write (iout,*) "Processor",myrank," BROADCAST iorder"
-! call flush(iout)
-! FG master sets up the WEIGHTS_ array which will be broadcast to the
-! FG slaves as WEIGHTS array.
- weights_(1)=wsc
- weights_(2)=wscp
- weights_(3)=welec
- weights_(4)=wcorr
- weights_(5)=wcorr5
- weights_(6)=wcorr6
- weights_(7)=wel_loc
- weights_(8)=wturn3
- weights_(9)=wturn4
- weights_(10)=wturn6
- weights_(11)=wang
- weights_(12)=wscloc
- weights_(13)=wtor
- weights_(14)=wtor_d
- weights_(15)=wstrain
- weights_(16)=wvdwpp
- weights_(17)=wbond
- weights_(18)=scal14
- weights_(21)=wsccor
+ 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)
+ 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
+ call chainbuild_cart
+#ifdef MPI
+! Broadcast the order to compute internal coordinates to the slaves.
+! if (nfgtasks.gt.1)
+! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
+#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)
+ etot11=energia1(0)
+ call etotal_short(energia1)
+ etot12=energia1(0)
+! write (iout,*) "etot11",etot11," etot12",etot12
+ endif
+!- end split gradient
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
+ dc(j,i)=ddc(j)-aincr
+ call chainbuild_cart
+! call int_from_cart1(.false.)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia1)
+! call enerprint(energia1)
+ etot2=energia1(0)
+ ggg(j)=(etot1-etot2)/(2*aincr)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot21=energia1(0)
+ ggg(j)=(etot11-etot21)/(2*aincr)
+ call etotal_short(energia1)
+ etot22=energia1(0)
+ ggg1(j)=(etot12-etot22)/(2*aincr)
+!- end split gradient
+! write (iout,*) "etot21",etot21," etot22",etot22
+ endif
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
+ dc(j,i)=ddc(j)
+ call chainbuild_cart
+ enddo
+ 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)
+! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
+! write (iout,*) "dxnormnorm",dsqrt(
+! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
+! write (iout,*) "dxnormnormsafe",dsqrt(
+! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
+! write (iout,*)
+ if (.not.split_ene) then
+ call zerograd
+ call etotal(energia1)
+! call enerprint(energia1)
+ etot1=energia1(0)
+! print *,"ene",energia1(0),energia1(57)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot11=energia1(0)
+ call etotal_short(energia1)
+ etot12=energia1(0)
+ endif
+!- end split gradient
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
+ 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,'(3f15.10)') (dxnorm_safe(k),k=1,3)
+! write (iout,*)
+! write (iout,*) "dxnormnorm",dsqrt(
+! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
+! 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)
+! call enerprint(energia1)
+! print *,"ene",energia1(0),energia1(57)
+ ggg(j+3)=(etot1-etot2)/(2*aincr)
+ else
+!- split gradient
+ call etotal_long(energia1)
+ etot21=energia1(0)
+ ggg(j+3)=(etot11-etot21)/(2*aincr)
+ call etotal_short(energia1)
+ etot22=energia1(0)
+ ggg1(j+3)=(etot12-etot22)/(2*aincr)
+!- end split gradient
+ endif
+! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
+ dc(j,i+nres)=ddx(j)
+ call chainbuild_cart
+ enddo
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
+ if (split_ene) then
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
+ k=1,6)
+ write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
+ i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
+ ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
+ endif
+ enddo
+ return
+ end subroutine check_ecartint
+#endif
+!-----------------------------------------------------------------------------
+ subroutine check_eint
+! Check the gradient of energy in internal coordinates.
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.VAR'
+! include 'COMMON.GEO'
+ use comm_srutu
+!#ifdef LBFGS
+! use minimm, only : funcgrad
+!#endif
+!el integer :: icall
+!el common /srutu/ icall
+! real(kind=8) :: funcgrad
+ real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
+ integer :: uiparm(1)
+ real(kind=8) :: urparm(1)
+ real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
+ character(len=6) :: key
+!EL external fdum
+ integer :: i,ii,nf
+ real(kind=8) :: xi,aincr,etot,etot1,etot2,ff
+ call zerograd
+ aincr=1.0D-7
+ print '(a)','Calling CHECK_INT.'
+ nf=0
+ nfl=0
+ icg=1
+ call geom_to_var(nvar,x)
+ call var_to_geom(nvar,x)
+ call chainbuild
+ icall=1
+! print *,'ICG=',ICG
+ call etotal(energia)
+ etot = energia(0)
+!el call enerprint(energia)
+! print *,'ICG=',ICG
+#ifdef MPL
+ if (MyID.ne.BossID) then
+ call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
+ nf=x(nvar+1)
+ nfl=x(nvar+2)
+ icg=x(nvar+3)
+ endif
+#endif
+ nf=1
+ nfl=3
+#ifdef LBFGS
+ ff=funcgrad(x,gana)
+#else
+
+!d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
+ call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
+!d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
+#endif
+ icall=1
+ do i=1,nvar
+ xi=x(i)
+ x(i)=xi-0.5D0*aincr
+ call var_to_geom(nvar,x)
+ call chainbuild
+ call etotal(energia1)
+ etot1=energia1(0)
+ x(i)=xi+0.5D0*aincr
+ call var_to_geom(nvar,x)
+ call chainbuild
+ call etotal(energia2)
+ etot2=energia2(0)
+ gg(i)=(etot2-etot1)/aincr
+ write (iout,*) i,etot1,etot2
+ x(i)=xi
+ enddo
+ write (iout,'(/2a)')' Variable Numerical Analytical',&
+ ' RelDiff*100% '
+ do i=1,nvar
+ if (i.le.nphi) then
+ ii=i
+ key = ' phi'
+ else if (i.le.nphi+ntheta) then
+ ii=i-nphi
+ key=' theta'
+ else if (i.le.nphi+ntheta+nside) then
+ ii=i-(nphi+ntheta)
+ key=' alpha'
+ else
+ ii=i-(nphi+ntheta+nside)
+ key=' omega'
+ endif
+ write (iout,'(i3,a,i3,3(1pd16.6))') &
+ i,key,ii,gg(i),gana(i),&
+ 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
+ enddo
+ return
+ end subroutine check_eint
+!-----------------------------------------------------------------------------
+! econstr_local.F
+!-----------------------------------------------------------------------------
+ subroutine Econstr_back
+! MD with umbrella_sampling using Wolyne's distance measure as a constraint
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.VAR'
+! include 'COMMON.MD'
+ use MD_data
+!#ifndef LANG0
+! include 'COMMON.LANGEVIN'
+!#else
+! include 'COMMON.LANGEVIN.lang0'
+!#endif
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.NAMES'
+! include 'COMMON.TIME1'
+ integer :: i,j,ii,k
+ real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
+
+ if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
+ if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
+ if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
+
+ Uconst_back=0.0d0
+ do i=1,nres
+ dutheta(i)=0.0d0
+ dugamma(i)=0.0d0
+ do j=1,3
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
+ enddo
+ enddo
+ do i=1,nfrag_back
+ ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
+!
+! Deviations from theta angles
+!
+ utheta_i=0.0d0
+ do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
+ dtheta_i=theta(j)-thetaref(j)
+ utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
+ dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
+ enddo
+ utheta(i)=utheta_i/(ii-1)
+!
+! Deviations from gamma angles
+!
+ ugamma_i=0.0d0
+ do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
+ dgamma_i=pinorm(phi(j)-phiref(j))
+! write (iout,*) j,phi(j),phi(j)-phiref(j)
+ ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
+ dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
+! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
+ enddo
+ ugamma(i)=ugamma_i/(ii-2)
+!
+! Deviations from local SC geometry
+!
+ uscdiff(i)=0.0d0
+ do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
+ dxx=xxtab(j)-xxref(j)
+ dyy=yytab(j)-yyref(j)
+ dzz=zztab(j)-zzref(j)
+ uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
+ do k=1,3
+ duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
+ (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
+ (ii-1)
+ duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
+ (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
+ (ii-1)
+ duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
+ (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
+ /(ii-1)
+ enddo
+! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
+! & xxref(j),yyref(j),zzref(j)
+ enddo
+ uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
+! write (iout,*) i," uscdiff",uscdiff(i)
+!
+! Put together deviations from local geometry
+!
+ Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
+ wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
+! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
+! & " uconst_back",uconst_back
+ utheta(i)=dsqrt(utheta(i))
+ ugamma(i)=dsqrt(ugamma(i))
+ uscdiff(i)=dsqrt(uscdiff(i))
+ enddo
+ return
+ end subroutine Econstr_back
+!-----------------------------------------------------------------------------
+! energy_p_new-sep_barrier.F
+!-----------------------------------------------------------------------------
+ real(kind=8) function sscale(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm
+ if(r.lt.r_cut-rlamb) then
+ sscale=1.0d0
+ else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+ gamm=(r-(r_cut-rlamb))/rlamb
+ sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale=0d0
+ endif
+ return
+ end function sscale
+ real(kind=8) function sscale_grad(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm
+ if(r.lt.r_cut-rlamb) then
+ sscale_grad=0.0d0
+ else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+ gamm=(r-(r_cut-rlamb))/rlamb
+ sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
+ else
+ sscale_grad=0d0
+ endif
+ return
+ end function sscale_grad
+!SCALINING MARTINI
+ real(kind=8) function sscale_martini(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm
+! print *,"here2",r_cut_mart,r
+ if(r.lt.r_cut_mart-rlamb_mart) then
+ sscale_martini=1.0d0
+ else if(r.le.r_cut_mart.and.r.ge.r_cut_mart-rlamb_mart) then
+ gamm=(r-(r_cut_mart-rlamb_mart))/rlamb_mart
+ sscale_martini=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale_martini=0.0d0
+ endif
+ return
+ end function sscale_martini
+ real(kind=8) function sscale_grad_martini(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm
+ if(r.lt.r_cut_mart-rlamb_mart) then
+ sscale_grad_martini=0.0d0
+ else if(r.le.r_cut_mart.and.r.ge.r_cut_mart-rlamb_mart) then
+ gamm=(r-(r_cut_mart-rlamb_mart))/rlamb_mart
+ sscale_grad_martini=gamm*(6*gamm-6.0d0)/rlamb_mart
+ else
+ sscale_grad_martini=0.0d0
+ endif
+ return
+ end function sscale_grad_martini
+ real(kind=8) function sscale_martini_angle(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm,r_cut_angle,rlamb_angle
+! print *,"here2",r_cut_angle,r
+ r_cut_angle=3.12d0
+ rlamb_angle=0.1d0
+ if(r.lt.r_cut_angle-rlamb_angle) then
+ sscale_martini_angle=1.0d0
+ else if(r.le.r_cut_angle.and.r.ge.r_cut_angle-rlamb_angle) then
+ gamm=(r-(r_cut_angle-rlamb_angle))/rlamb_angle
+ sscale_martini_angle=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale_martini_angle=0.0d0
+ endif
+ return
+ end function sscale_martini_angle
+ real(kind=8) function sscale_grad_martini_angle(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm,r_cut_angle,rlamb_angle
+ r_cut_angle=3.12d0
+ rlamb_angle=0.1d0
+ if(r.lt.r_cut_angle-rlamb_angle) then
+ sscale_grad_martini_angle=0.0d0
+ else if(r.le.r_cut_angle.and.r.ge.r_cut_angle-rlamb_angle) then
+ gamm=(r-(r_cut_angle-rlamb_angle))/rlamb_angle
+ sscale_grad_martini_angle=gamm*(6*gamm-6.0d0)/rlamb_angle
+ else
+ sscale_grad_martini_angle=0.0d0
+ endif
+ return
+ end function sscale_grad_martini_angle
+
+
+!!!!!!!!!! PBCSCALE
+ real(kind=8) function sscale_ele(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm
+ if(r.lt.r_cut_ele-rlamb_ele) then
+ sscale_ele=1.0d0
+ else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
+ gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
+ sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale_ele=0d0
+ endif
+ return
+ end function sscale_ele
+
+ real(kind=8) function sscagrad_ele(r)
+ real(kind=8) :: r,gamm
+! include "COMMON.SPLITELE"
+ if(r.lt.r_cut_ele-rlamb_ele) then
+ sscagrad_ele=0.0d0
+ else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
+ gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
+ sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
+ else
+ sscagrad_ele=0.0d0
+ endif
+ return
+ end function sscagrad_ele
+!!!!!!!!!! PBCSCALE
+ real(kind=8) function sscale2(r,r_cc,r_ll)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm,r_cc,r_ll
+ if(r.lt.r_cc-r_ll) then
+ sscale2=1.0d0
+ else if(r.le.r_cc.and.r.ge.r_cc-r_ll) then
+ gamm=(r-(r_cc-r_ll))/r_ll
+ sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale2=0d0
+ endif
+ return
+ end function sscale2
+
+ real(kind=8) function sscagrad2(r,r_cc,r_ll)
+ real(kind=8) :: r,gamm,r_cc,r_ll
+! include "COMMON.SPLITELE"
+ if(r.lt.r_cc-r_ll) then
+ sscagrad2=0.0d0
+ else if(r.le.r_cc.and.r.ge.r_cc-r_ll) then
+ gamm=(r-(r_cc-r_ll))/r_ll
+ sscagrad2=gamm*(6*gamm-6.0d0)/r_ll
+ else
+ sscagrad2=0.0d0
+ endif
+ return
+ end function sscagrad2
+
+ 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)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the LJ potential of interaction.
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.TORSION'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.NAMES'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CONTACTS'
+ real(kind=8),parameter :: accur=1.0d-10
+ 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
+ real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,aa,bb
+! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(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,1)
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ rij=xj*xj+yj*yj+zj*zj
+ sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
+ if (sss.lt.1.0d0) then
+ rrij=1.0D0/rij
+ eps0ij=eps(itypi,itypj)
+ fac=rrij**expon2
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ evdwij=e1+e2
+ evdw=evdw+(1.0d0-sss)*evdwij
+!
+! Calculate the components of the gradient in DC and X
+!
+ fac=-rrij*(e1+evdwij)*(1.0d0-sss)
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ gvdwc(k,i)=gvdwc(k,i)-gg(k)
+ gvdwc(k,j)=gvdwc(k,j)+gg(k)
+ enddo
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ do i=1,nct
+ do j=1,3
+ gvdwc(j,i)=expon*gvdwc(j,i)
+ gvdwx(j,i)=expon*gvdwx(j,i)
+ enddo
+ enddo
+!******************************************************************************
+!
+! N O T E !!!
+!
+! To save time, the factor of EXPON has been extracted from ALL components
+! of GVDWC and GRADX. Remember to multiply them by this factor before further
+! use!
+!
+!******************************************************************************
+ return
+ end subroutine elj_long
+!-----------------------------------------------------------------------------
+ subroutine elj_short(evdw)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the LJ potential of interaction.
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.TORSION'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.NAMES'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CONTACTS'
+ real(kind=8),parameter :: accur=1.0d-10
+ 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
+ real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj
+! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+! Change 12/1/95
+ num_conti=0
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(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,1)
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+! Change 12/1/95 to calculate four-body interactions
+ rij=xj*xj+yj*yj+zj*zj
+ sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
+ if (sss.gt.0.0d0) then
+ rrij=1.0D0/rij
+ eps0ij=eps(itypi,itypj)
+ fac=rrij**expon2
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ evdwij=e1+e2
+ evdw=evdw+sss*evdwij
+!
+! Calculate the components of the gradient in DC and X
+!
+ fac=-rrij*(e1+evdwij)*sss
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ gvdwc(k,i)=gvdwc(k,i)-gg(k)
+ gvdwc(k,j)=gvdwc(k,j)+gg(k)
+ enddo
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ do i=1,nct
+ do j=1,3
+ gvdwc(j,i)=expon*gvdwc(j,i)
+ gvdwx(j,i)=expon*gvdwx(j,i)
+ enddo
+ enddo
+!******************************************************************************
+!
+! N O T E !!!
+!
+! To save time, the factor of EXPON has been extracted from ALL components
+! of GVDWC and GRADX. Remember to multiply them by this factor before further
+! use!
+!
+!******************************************************************************
+ return
+ end subroutine elj_short
+!-----------------------------------------------------------------------------
+ subroutine eljk_long(evdw)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the LJK potential of interaction.
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.NAMES'
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
+ logical :: scheck
+!el local variables
+ integer :: i,iint,j,k,itypi,itypi1,itypj
+ real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
+ fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
+! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ fac_augm=rrij**expon
+ e_augm=augm(itypi,itypj)*fac_augm
+ r_inv_ij=dsqrt(rrij)
+ rij=1.0D0/r_inv_ij
+ sss=sscale(rij/sigma(itypi,itypj))
+ 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_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,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)
+ evdw=evdw+(1.0d0-sss)*evdwij
+!
+! Calculate the components of the gradient in DC and X
+!
+ fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
+ fac=fac*(1.0d0-sss)
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ gvdwc(k,i)=gvdwc(k,i)-gg(k)
+ gvdwc(k,j)=gvdwc(k,j)+gg(k)
+ enddo
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ do i=1,nct
+ do j=1,3
+ gvdwc(j,i)=expon*gvdwc(j,i)
+ gvdwx(j,i)=expon*gvdwx(j,i)
+ enddo
+ enddo
+ return
+ end subroutine eljk_long
+!-----------------------------------------------------------------------------
+ subroutine eljk_short(evdw)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the LJK potential of interaction.
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.NAMES'
+ real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
+ logical :: scheck
+!el local variables
+ integer :: i,iint,j,k,itypi,itypi1,itypj
+ real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
+ fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij,&
+ sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
+! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ fac_augm=rrij**expon
+ e_augm=augm(itypi,itypj)*fac_augm
+ r_inv_ij=dsqrt(rrij)
+ rij=1.0D0/r_inv_ij
+ sss=sscale(rij/sigma(itypi,itypj))
+ 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_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,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)
+ evdw=evdw+sss*evdwij
+!
+! Calculate the components of the gradient in DC and X
+!
+ fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
+ fac=fac*sss
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k)
+ gvdwx(k,j)=gvdwx(k,j)+gg(k)
+ gvdwc(k,i)=gvdwc(k,i)-gg(k)
+ gvdwc(k,j)=gvdwc(k,j)+gg(k)
+ enddo
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ do i=1,nct
+ do j=1,3
+ gvdwc(j,i)=expon*gvdwc(j,i)
+ gvdwx(j,i)=expon*gvdwx(j,i)
+ enddo
+ enddo
+ return
+ end subroutine eljk_short
+!-----------------------------------------------------------------------------
+ subroutine ebp_long(evdw)
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the Berne-Pechukas potential of interaction.
+!
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.NAMES'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+ use comm_srutu
+!el integer :: icall
+!el common /srutu/ icall
+! double precision rrsave(maxdim)
+ logical :: lprn
+!el local variables
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,aa,bb
+ real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
+ evdw=0.0D0
+! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+! if (icall.eq.0) then
+! lprn=.true.
+! else
+ lprn=.false.
+! endif
+!el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+!el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+!chi1=chi(itypi,itypj)
+!chi2=chi(itypj,itypi)
+!chi12=chi1*chi2
+!chip1=chip(itypi)
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+
+ if (sss.lt.1.0d0) then
+
+ ! Calculate the angle-dependent terms of energy & contributions to derivatives.
+ call sc_angular
+ ! Calculate whole angle-dependent part of epsilon and contributions
+ ! to its derivatives
+ fac=(rrij*sigsq)**expon2
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=evdwij*eps3rt
+ eps3der=evdwij*eps2rt
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+evdwij*(1.0d0-sss)
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+ !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
+ !d & restyp(itypi,1),i,restyp(itypj,1),j,
+ !d & epsi,sigm,chi1,chi2,chip1,chip2,
+ !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
+ !d & om1,om2,om12,1.0D0/dsqrt(rrij),
+ !d & evdwij
+ endif
+ ! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)
+ sigder=fac/sigsq
+ fac=rrij*fac
+ ! Calculate radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+ ! Calculate the angular part of the gradient and sum add the contributions
+ ! to the appropriate components of the Cartesian gradient.
+ call sc_grad_scale(1.0d0-sss)
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ ! stop
+ return
+ end subroutine ebp_long
+ !-----------------------------------------------------------------------------
+ subroutine ebp_short(evdw)
+ !
+ ! This subroutine calculates the interaction energy of nonbonded side chains
+ ! assuming the Berne-Pechukas potential of interaction.
+ !
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+ ! include 'DIMENSIONS'
+ ! include 'COMMON.GEO'
+ ! include 'COMMON.VAR'
+ ! include 'COMMON.LOCAL'
+ ! include 'COMMON.CHAIN'
+ ! include 'COMMON.DERIV'
+ ! include 'COMMON.NAMES'
+ ! include 'COMMON.INTERACT'
+ ! include 'COMMON.IOUNITS'
+ ! include 'COMMON.CALC'
+ use comm_srutu
+ !el integer :: icall
+ !el common /srutu/ icall
+! double precision rrsave(maxdim)
+ logical :: lprn
+ !el local variables
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
+ real(kind=8) :: sss,e1,e2,evdw,aa,bb, &
+ sslipi,ssgradlipi,sslipj,ssgradlipj
+ evdw=0.0D0
+ ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ ! if (icall.eq.0) then
+ ! lprn=.true.
+ ! else
+ lprn=.false.
+ ! endif
+ !el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ ! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+ !
+ ! Calculate SC interaction energy.
+ !
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+ !el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+ ! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+
+ if (sss.gt.0.0d0) then
+
+! Calculate the angle-dependent terms of energy & contributions to derivatives.
+ call sc_angular
+! Calculate whole angle-dependent part of epsilon and contributions
+! to its derivatives
+ fac=(rrij*sigsq)**expon2
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=evdwij*eps3rt
+ eps3der=evdwij*eps2rt
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+evdwij*sss
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+!d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
+!d & restyp(itypi,1),i,restyp(itypj,1),j,
+!d & epsi,sigm,chi1,chi2,chip1,chip2,
+!d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
+!d & om1,om2,om12,1.0D0/dsqrt(rrij),
+!d & evdwij
+ endif
+! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)
+ sigder=fac/sigsq
+ fac=rrij*fac
+! Calculate radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+! Calculate the angular part of the gradient and sum add the contributions
+! to the appropriate components of the Cartesian gradient.
+ call sc_grad_scale(sss)
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+! stop
+ return
+ end subroutine ebp_short
+!-----------------------------------------------------------------------------
+ subroutine egb_long(evdw)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the Gay-Berne potential of interaction.
+!
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.NAMES'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+! include 'COMMON.CONTROL'
+ logical :: lprn
+!el local variables
+ integer :: iint,itypi,itypi1,itypj,subchap
+ 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,aa,bb,fracinbuf,sslipi,sslipj,&
+ ssgradlipi,ssgradlipj
+
+
+ evdw=0.0D0
+!cccc energy_dec=.false.
+! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ lprn=.false.
+! if (icall.eq.0) lprn=.false.
+!el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
+! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+ IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
+! 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,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,1),itype(j,1)
+ sig0ij=sigma(itypi,itypj)
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+! Searching for nearest neighbour
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+ sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
+ if (sss_ele_cut.le.0.0) cycle
+ if (sss.lt.1.0d0) then
+
+! Calculate angle-dependent terms of energy and contributions to their
+! derivatives.
+ call sc_angular
+ sigsq=1.0D0/sigsq
+ sig=sig0ij*dsqrt(sigsq)
+ rij_shift=1.0D0/rij-sig+sig0ij
+! for diagnostics; uncomment
+! rij_shift=1.2*sig0ij
+! I hate to put IF's in the loops, but here don't have another choice!!!!
+ if (rij_shift.le.0.0D0) then
+ evdw=1.0D20
+!d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+!d & restyp(itypi,1),i,restyp(itypj,1),j,
+!d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
+ return
+ endif
+ sigder=-sig*sigsq
+!---------------------------------------------------------------
+ rij_shift=1.0D0/rij_shift
+ fac=rij_shift**expon
+ e1=fac*fac*aa
+ e2=fac*bb
+ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=evdwij*eps3rt
+ eps3der=evdwij*eps2rt
+! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
+! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+ write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
+ 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
+! if (energy_dec) write (iout,*) &
+! 'evdw',i,j,evdwij,"egb_long"
+
+! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)*rij_shift
+ sigder=fac*sigder
+ fac=rij*fac
+ fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
+ *rij-sss_grad/(1.0-sss)*rij &
+ /sigmaii(itypi,itypj))
+! fac=0.0d0
+! Calculate the radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ 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
+ enddo ! i
+! write (iout,*) "Number of loop steps in EGB:",ind
+!ccc energy_dec=.false.
+ return
+ end subroutine egb_long
+!-----------------------------------------------------------------------------
+ subroutine egb_short(evdw)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the Gay-Berne potential of interaction.
+!
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.NAMES'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+! include 'COMMON.CONTROL'
+ logical :: lprn
+!el local variables
+ integer :: iint,itypi,itypi1,itypj,subchap,countss
+ 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,aa,bb,fracinbuf,sslipi,sslipj,&
+ ssgradlipi,ssgradlipj
+ evdw=0.0D0
+!cccc energy_dec=.false.
+! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ lprn=.false.
+ countss=0
+! if (icall.eq.0) lprn=.false.
+!el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+
+ 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)
+ 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
+ countss=countss+1
+ call dyn_ssbond_ene(i,j,evdwij,countss)
+ 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
+ ELSE
+
+! typj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+ dscj_inv=dsc_inv(itypj)
+! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
+! & 1.0d0/vbld(j+nres)
+! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
+ sig0ij=sigma(itypi,itypj)
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+! 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)
+! Searching for nearest neighbour
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+ sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+ if (sss_ele_cut.le.0.0) cycle
+
+ if (sss.gt.0.0d0) then
+
+! Calculate angle-dependent terms of energy and contributions to their
+! derivatives.
+ call sc_angular
+ sigsq=1.0D0/sigsq
+ sig=sig0ij*dsqrt(sigsq)
+ rij_shift=1.0D0/rij-sig+sig0ij
+! for diagnostics; uncomment
+! rij_shift=1.2*sig0ij
+! I hate to put IF's in the loops, but here don't have another choice!!!!
+ if (rij_shift.le.0.0D0) then
+ evdw=1.0D20
+!d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+!d & restyp(itypi,1),i,restyp(itypj,1),j,
+!d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
+ return
+ endif
+ sigder=-sig*sigsq
+!---------------------------------------------------------------
+ rij_shift=1.0D0/rij_shift
+ fac=rij_shift**expon
+ e1=fac*fac*aa
+ e2=fac*bb
+ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=evdwij*eps3rt
+ eps3der=evdwij*eps2rt
+! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
+! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+evdwij*sss*sss_ele_cut
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+ write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
+ 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
+! if (energy_dec) write (iout,*) &
+! 'evdw',i,j,evdwij,"egb_short"
+
+! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)*rij_shift
+ sigder=fac*sigder
+ fac=rij*fac
+ fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
+ *rij+sss_grad/sss*rij &
+ /sigmaii(itypi,itypj))
+
+! fac=0.0d0
+! Calculate the radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+! Calculate angular part of the gradient.
+ call sc_grad_scale(sss)
+ endif
+ ENDIF !mask_dyn_ss
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+! write (iout,*) "Number of loop steps in EGB:",ind
+!ccc energy_dec=.false.
+ return
+ end subroutine egb_short
+!-----------------------------------------------------------------------------
+ subroutine egbv_long(evdw)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the Gay-Berne-Vorobjev potential of interaction.
+!
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.NAMES'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+ use comm_srutu
+!el integer :: icall
+!el common /srutu/ icall
+ logical :: lprn
+!el local variables
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij,&
+ sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
+ real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
+ evdw=0.0D0
+! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ lprn=.false.
+! if (icall.eq.0) lprn=.true.
+!el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+
+! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+!el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+ sig0ij=sigma(itypi,itypj)
+ r0ij=r0(itypi,itypj)
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+
+ if (sss.lt.1.0d0) then
+
+! Calculate angle-dependent terms of energy and contributions to their
+! derivatives.
+ call sc_angular
+ sigsq=1.0D0/sigsq
+ sig=sig0ij*dsqrt(sigsq)
+ rij_shift=1.0D0/rij-sig+r0ij
+! I hate to put IF's in the loops, but here don't have another choice!!!!
+ if (rij_shift.le.0.0D0) then
+ evdw=1.0D20
+ return
+ endif
+ sigder=-sig*sigsq
+!---------------------------------------------------------------
+ rij_shift=1.0D0/rij_shift
+ fac=rij_shift**expon
+ 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
+ fac_augm=rrij**expon
+ e_augm=augm(itypi,itypj)*fac_augm
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+ write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
+ 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,&
+ om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
+ evdwij+e_augm
+ endif
+! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)*rij_shift
+ sigder=fac*sigder
+ fac=rij*fac-2*expon*rrij*e_augm
+! Calculate the radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+! Calculate angular part of the gradient.
+ call sc_grad_scale(1.0d0-sss)
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ end subroutine egbv_long
+!-----------------------------------------------------------------------------
+ subroutine egbv_short(evdw)
+!
+! This subroutine calculates the interaction energy of nonbonded side chains
+! assuming the Gay-Berne-Vorobjev potential of interaction.
+!
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.NAMES'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+ use comm_srutu
+!el integer :: icall
+!el common /srutu/ icall
+ logical :: lprn
+!el local variables
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift,&
+ sslipi,ssgradlipi, sslipj,ssgradlipj,aa,bb
+ real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
+ evdw=0.0D0
+! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ lprn=.false.
+! if (icall.eq.0) lprn=.true.
+!el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+!el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+ sig0ij=sigma(itypi,itypj)
+ r0ij=r0(itypi,itypj)
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+
+ if (sss.gt.0.0d0) then
+
+! Calculate angle-dependent terms of energy and contributions to their
+! derivatives.
+ call sc_angular
+ sigsq=1.0D0/sigsq
+ sig=sig0ij*dsqrt(sigsq)
+ rij_shift=1.0D0/rij-sig+r0ij
+! I hate to put IF's in the loops, but here don't have another choice!!!!
+ if (rij_shift.le.0.0D0) then
+ evdw=1.0D20
+ return
+ endif
+ sigder=-sig*sigsq
+!---------------------------------------------------------------
+ rij_shift=1.0D0/rij_shift
+ fac=rij_shift**expon
+ 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
+ fac_augm=rrij**expon
+ e_augm=augm(itypi,itypj)*fac_augm
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+(evdwij+e_augm)*sss
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+ write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
+ 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,&
+ om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
+ evdwij+e_augm
+ endif
+! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)*rij_shift
+ sigder=fac*sigder
+ fac=rij*fac-2*expon*rrij*e_augm
+! Calculate the radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+! Calculate angular part of the gradient.
+ call sc_grad_scale(sss)
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ end subroutine egbv_short
+!-----------------------------------------------------------------------------
+ subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
+!
+! This subroutine calculates the average interaction energy and its gradient
+! in the virtual-bond vectors between non-adjacent peptide groups, based on
+! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
+! The potential depends both on the distance of peptide-group centers and on
+! the orientation of the CA-CA virtual bonds.
+!
+! implicit real(kind=8) (a-h,o-z)
+
+ use comm_locel
+#ifdef MPI
+ include 'mpif.h'
+#endif
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.SETUP'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VECTORS'
+! include 'COMMON.FFIELD'
+! include 'COMMON.TIME1'
+ real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
+ 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
+!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
+!el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
+!el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
+!el num_conti,j1,j2
+! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
+#ifdef MOMENT
+ real(kind=8) :: scal_el=1.0d0
+#else
+ real(kind=8) :: scal_el=0.5d0
+#endif
+! 12/13/98
+! 13-go grudnia roku pamietnego...
+ real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
+ 0.0d0,1.0d0,0.0d0,&
+ 0.0d0,0.0d0,1.0d0/),shape(unmat))
+!el local variables
+ integer :: i,j,k
+ real(kind=8) :: fac
+ real(kind=8) :: dxj,dyj,dzj
+ real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
+
+! allocate(num_cont_hb(nres)) !(maxres)
+!d write(iout,*) 'In EELEC'
+!d do i=1,nloctyp
+!d write(iout,*) 'Type',i
+!d write(iout,*) 'B1',B1(:,i)
+!d write(iout,*) 'B2',B2(:,i)
+!d write(iout,*) 'CC',CC(:,:,i)
+!d write(iout,*) 'DD',DD(:,:,i)
+!d write(iout,*) 'EE',EE(:,:,i)
+!d enddo
+!d call check_vecgrad
+!d stop
+ if (icheckgrad.eq.1) then
+ do i=1,nres-1
+ fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
+ do k=1,3
+ dc_norm(k,i)=dc(k,i)*fac
+ enddo
+! write (iout,*) 'i',i,' fac',fac
+ enddo
+ endif
+ if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
+ .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
+ wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
+! call vec_and_deriv
+#ifdef TIMING
+ time01=MPI_Wtime()
+#endif
+! print *, "before set matrices"
+ call set_matrices
+! print *,"after set catices"
+#ifdef TIMING
+ time_mat=time_mat+MPI_Wtime()-time01
+#endif
+ endif
+!d do i=1,nres-1
+!d write (iout,*) 'i=',i
+!d do k=1,3
+!d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
+!d enddo
+!d do k=1,3
+!d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
+!d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
+!d enddo
+!d enddo
+ t_eelecij=0.0d0
+ ees=0.0D0
+ evdw1=0.0D0
+ eel_loc=0.0d0
+ eello_turn3=0.0d0
+ eello_turn4=0.0d0
+!el ind=0
+ do i=1,nres
+ num_cont_hb(i)=0
+ enddo
+!d print '(a)','Enter EELEC'
+!d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
+! 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)
+ do i=1,nres
+ gel_loc_loc(i)=0.0d0
+ gcorr_loc(i)=0.0d0
+ enddo
+!
+!
+! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
+!
+! Loop over i,i+2 and i,i+3 pairs of the peptide groups
+!
+ do i=iturn3_start,iturn3_end
+ 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)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+ 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,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)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+
+ num_conti=num_cont_hb(i)
+ call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
+ if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
+ 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,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+ num_conti=num_cont_hb(i)
+ do j=ielstart(i),ielend(i)
+ 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
+ enddo ! i
+! write (iout,*) "Number of loop steps in EELEC:",ind
+!d do i=1,nres
+!d write (iout,'(i3,3f10.5,5x,3f10.5)')
+!d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
+!d enddo
+! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
+!cc eel_loc=eel_loc+eello_turn3
+!d print *,"Processor",fg_rank," t_eelecij",t_eelecij
+ return
+ end subroutine eelec_scale
+!-----------------------------------------------------------------------------
+ subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
+! implicit real(kind=8) (a-h,o-z)
+
+ use comm_locel
+! include 'DIMENSIONS'
+#ifdef MPI
+ include "mpif.h"
+#endif
+! include 'COMMON.CONTROL'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VECTORS'
+! include 'COMMON.FFIELD'
+! include 'COMMON.TIME1'
+ 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
+!el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
+!el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
+!el num_conti,j1,j2
+! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
+#ifdef MOMENT
+ real(kind=8) :: scal_el=1.0d0
+#else
+ real(kind=8) :: scal_el=0.5d0
+#endif
+! 12/13/98
+! 13-go grudnia roku pamietnego...
+ real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
+ 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,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
+ real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
+ real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
+ real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
+ dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
+ ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
+ wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
+ ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
+ ecosam,ecosbm,ecosgm,ghalf,time00,faclipij,faclipij2
+! integer :: maxconts
+! maxconts = nres/4
+! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
+! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
+! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
+! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
+! 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)
+
+#ifdef MPI
+ time00=MPI_Wtime()
+#endif
+!d write (iout,*) "eelecij",i,j
+!el ind=ind+1
+ iteli=itel(i)
+ itelj=itel(j)
+ if (j.eq.i+2 .and. itelj.eq.2) iteli=2
+ aaa=app(iteli,itelj)
+ bbb=bpp(iteli,itelj)
+ ael6i=ael6(iteli,itelj)
+ ael3i=ael3(iteli,itelj)
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+! xj=c(1,j)+0.5D0*dxj-xmedi
+! yj=c(2,j)+0.5D0*dyj-ymedi
+! zj=c(3,j)+0.5D0*dzj-zmedi
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ rij=xj*xj+yj*yj+zj*zj
+ rrmij=1.0D0/rij
+ rij=dsqrt(rij)
+ 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
+ cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
+ cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
+ cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
+ fac=cosa-3.0D0*cosb*cosg
+ ev1=aaa*r6ij*r6ij
+! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
+ if (j.eq.i+2) ev1=scal_el*ev1
+ ev2=bbb*r6ij
+ fac3=ael6i*r6ij
+ fac4=ael3i*r3ij
+ evdwij=ev1+ev2
+ el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
+ el2=fac4*fac
+ eesij=el1+el2
+! 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*(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,
+!d & xmedi,ymedi,zmedi,xj,yj,zj
+
+ if (energy_dec) then
+ write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
+ write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
+ endif
+
+!
+! Calculate contributions to the Cartesian gradient.
+!
+#ifdef SPLITELE
+ 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
+ erij(3)=zj*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
+! do k=1,3
+! ghalf=0.5D0*ggg(k)
+! gelc(k,i)=gelc(k,i)+ghalf
+! gelc(k,j)=gelc(k,j)+ghalf
+! enddo
+! 9/28/08 AL Gradient compotents will be summed only at the end
+ do k=1,3
+ gelc_long(k,j)=gelc_long(k,j)+ggg(k)
+ gelc_long(k,i)=gelc_long(k,i)-ggg(k)
+ enddo
+!
+! Loop over residues i+1 thru j-1.
+!
+!grad do k=i+1,j-1
+!grad do l=1,3
+!grad gelc(l,k)=gelc(l,k)+ggg(l)
+!grad enddo
+!grad enddo
+ 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
+! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
+! enddo
+! 9/28/08 AL Gradient compotents will be summed only at the end
+ do k=1,3
+ gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
+ gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+ enddo
+!
+! Loop over residues i+1 thru j-1.
+!
+!grad do k=i+1,j-1
+!grad do l=1,3
+!grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
+!grad enddo
+!grad enddo
+#else
+ 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
+ erij(2)=yj*rmij
+ erij(3)=zj*rmij
+!
+! Radial derivatives. First process both termini of the fragment (i,j)
+!
+ ggg(1)=fac*xj
+ ggg(2)=fac*yj
+ ggg(3)=fac*zj
+! do k=1,3
+! ghalf=0.5D0*ggg(k)
+! gelc(k,i)=gelc(k,i)+ghalf
+! gelc(k,j)=gelc(k,j)+ghalf
+! enddo
+! 9/28/08 AL Gradient compotents will be summed only at the end
+ do k=1,3
+ gelc_long(k,j)=gelc(k,j)+ggg(k)
+ gelc_long(k,i)=gelc(k,i)-ggg(k)
+ enddo
+!
+! Loop over residues i+1 thru j-1.
+!
+!grad do k=i+1,j-1
+!grad do l=1,3
+!grad gelc(l,k)=gelc(l,k)+ggg(l)
+!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
+ do k=1,3
+ gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
+ gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+ enddo
+#endif
+!
+! Angular part
+!
+ ecosa=2.0D0*fac3*fac1+fac4
+ fac4=-3.0D0*fac4
+ fac3=-6.0D0*fac3
+ ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
+ ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
+ do k=1,3
+ dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
+ dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
+ enddo
+!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
+ enddo
+! do k=1,3
+! ghalf=0.5D0*ggg(k)
+! gelc(k,i)=gelc(k,i)+ghalf
+! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
+! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+! gelc(k,j)=gelc(k,j)+ghalf
+! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
+! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+! enddo
+!grad do k=i+1,j-1
+!grad do l=1,3
+!grad gelc(l,k)=gelc(l,k)+ggg(l)
+!grad enddo
+!grad enddo
+ do k=1,3
+ gelc(k,i)=gelc(k,i) &
+ +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+ + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
+ *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)&
+ *sss_ele_cut
+ gelc_long(k,j)=gelc_long(k,j)+ggg(k)
+ gelc_long(k,i)=gelc_long(k,i)-ggg(k)
+ enddo
+ IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
+ .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
+ .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
+!
+! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
+! energy of a peptide unit is assumed in the form of a second-order
+! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
+! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
+! are computed for EVERY pair of non-contiguous peptide groups.
+!
+ if (j.lt.nres-1) then
+ j1=j+1
+ j2=j-1
+ else
+ j1=j-1
+ j2=j-2
+ endif
+ kkk=0
+ do k=1,2
+ do l=1,2
+ kkk=kkk+1
+ muij(kkk)=mu(k,i)*mu(l,j)
+ enddo
+ enddo
+!d write (iout,*) 'EELEC: i',i,' j',j
+!d write (iout,*) 'j',j,' j1',j1,' j2',j2
+!d write(iout,*) 'muij',muij
+ ury=scalar(uy(1,i),erij)
+ urz=scalar(uz(1,i),erij)
+ vry=scalar(uy(1,j),erij)
+ vrz=scalar(uz(1,j),erij)
+ a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
+ a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
+ a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
+ a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
+ fac=dsqrt(-ael6i)*r3ij
+ a22=a22*fac
+ a23=a23*fac
+ a32=a32*fac
+ a33=a33*fac
+!d write (iout,'(4i5,4f10.5)')
+!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)
+!d write (iout,'(4f10.5)')
+!d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
+!d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
+!d write (iout,'(4f10.5)') ury,urz,vry,vrz
+!d write (iout,'(9f10.5/)')
+!d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
+! Derivatives of the elements of A in virtual-bond vectors
+ call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
+ do k=1,3
+ uryg(k,1)=scalar(erder(1,k),uy(1,i))
+ uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
+ uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
+ urzg(k,1)=scalar(erder(1,k),uz(1,i))
+ urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
+ urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
+ vryg(k,1)=scalar(erder(1,k),uy(1,j))
+ vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
+ vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
+ vrzg(k,1)=scalar(erder(1,k),uz(1,j))
+ vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
+ vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
+ enddo
+! Compute radial contributions to the gradient
+ facr=-3.0d0*rrmij
+ a22der=a22*facr
+ a23der=a23*facr
+ a32der=a32*facr
+ a33der=a33*facr
+ agg(1,1)=a22der*xj
+ agg(2,1)=a22der*yj
+ agg(3,1)=a22der*zj
+ agg(1,2)=a23der*xj
+ agg(2,2)=a23der*yj
+ agg(3,2)=a23der*zj
+ agg(1,3)=a32der*xj
+ agg(2,3)=a32der*yj
+ agg(3,3)=a32der*zj
+ agg(1,4)=a33der*xj
+ agg(2,4)=a33der*yj
+ agg(3,4)=a33der*zj
+! Add the contributions coming from er
+ fac3=-3.0d0*fac
+ do k=1,3
+ agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
+ agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
+ agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
+ agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
+ enddo
+ do k=1,3
+! Derivatives in DC(i)
+!grad ghalf1=0.5d0*agg(k,1)
+!grad ghalf2=0.5d0*agg(k,2)
+!grad ghalf3=0.5d0*agg(k,3)
+!grad ghalf4=0.5d0*agg(k,4)
+ aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
+ -3.0d0*uryg(k,2)*vry)!+ghalf1
+ aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
+ -3.0d0*uryg(k,2)*vrz)!+ghalf2
+ aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
+ -3.0d0*urzg(k,2)*vry)!+ghalf3
+ aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
+ -3.0d0*urzg(k,2)*vrz)!+ghalf4
+! Derivatives in DC(i+1)
+ aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
+ -3.0d0*uryg(k,3)*vry)!+agg(k,1)
+ aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
+ -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
+ aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
+ -3.0d0*urzg(k,3)*vry)!+agg(k,3)
+ aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
+ -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
+! Derivatives in DC(j)
+ aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
+ -3.0d0*vryg(k,2)*ury)!+ghalf1
+ aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
+ -3.0d0*vrzg(k,2)*ury)!+ghalf2
+ aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
+ -3.0d0*vryg(k,2)*urz)!+ghalf3
+ aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
+ -3.0d0*vrzg(k,2)*urz)!+ghalf4
+! Derivatives in DC(j+1) or DC(nres-1)
+ aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
+ -3.0d0*vryg(k,3)*ury)
+ aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
+ -3.0d0*vrzg(k,3)*ury)
+ aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
+ -3.0d0*vryg(k,3)*urz)
+ aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
+ -3.0d0*vrzg(k,3)*urz)
+!grad if (j.eq.nres-1 .and. i.lt.j-2) then
+!grad do l=1,4
+!grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
+!grad enddo
+!grad endif
+ enddo
+ acipa(1,1)=a22
+ acipa(1,2)=a23
+ acipa(2,1)=a32
+ acipa(2,2)=a33
+ a22=-a22
+ a23=-a23
+ do l=1,2
+ do k=1,3
+ agg(k,l)=-agg(k,l)
+ aggi(k,l)=-aggi(k,l)
+ aggi1(k,l)=-aggi1(k,l)
+ aggj(k,l)=-aggj(k,l)
+ aggj1(k,l)=-aggj1(k,l)
+ enddo
+ enddo
+ if (j.lt.nres-1) then
+ a22=-a22
+ a32=-a32
+ do l=1,3,2
+ do k=1,3
+ agg(k,l)=-agg(k,l)
+ aggi(k,l)=-aggi(k,l)
+ aggi1(k,l)=-aggi1(k,l)
+ aggj(k,l)=-aggj(k,l)
+ aggj1(k,l)=-aggj1(k,l)
+ enddo
+ enddo
+ else
+ a22=-a22
+ a23=-a23
+ a32=-a32
+ a33=-a33
+ do l=1,4
+ do k=1,3
+ agg(k,l)=-agg(k,l)
+ aggi(k,l)=-aggi(k,l)
+ aggi1(k,l)=-aggi1(k,l)
+ aggj(k,l)=-aggj(k,l)
+ aggj1(k,l)=-aggj1(k,l)
+ enddo
+ enddo
+ endif
+ ENDIF ! WCORR
+ IF (wel_loc.gt.0.0d0) THEN
+! 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)
+! 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*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)) &
+ *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))&
+ *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 gel_loc(l,i)=gel_loc(l,i)+ghalf
+!grad gel_loc(l,j)=gel_loc(l,j)+ghalf
+ enddo
+!grad do k=i+1,j2
+!grad do l=1,3
+!grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
+!grad enddo
+!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))&
+ *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
+! if (j.gt.i+1 .and. num_conti.le.maxconts) then
+ if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
+ .and. num_conti.le.maxconts) then
+! write (iout,*) i,j," entered corr"
+!
+! Calculate the contact function. The ith column of the array JCONT will
+! contain the numbers of atoms that make contacts with the atom I (of numbers
+! greater than I). The arrays FACONT and GACONT will contain the values of
+! the contact function and its derivative.
+! r0ij=1.02D0*rpp(iteli,itelj)
+! r0ij=1.11D0*rpp(iteli,itelj)
+ r0ij=2.20D0*rpp(iteli,itelj)
+! r0ij=1.55D0*rpp(iteli,itelj)
+ call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
+!elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
+ if (fcont.gt.0.0D0) then
+ num_conti=num_conti+1
+ if (num_conti.gt.maxconts) then
+!elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
+ write (iout,*) 'WARNING - max. # of contacts exceeded;',&
+ ' will skip next contacts for this conf.',num_conti
+ else
+ jcont_hb(num_conti,i)=j
+!d write (iout,*) "i",i," j",j," num_conti",num_conti,
+!d & " jcont_hb",jcont_hb(num_conti,i)
+ IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
+ wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
+! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
+! terms.
+ d_cont(num_conti,i)=rij
+!d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
+! --- Electrostatic-interaction matrix ---
+ a_chuj(1,1,num_conti,i)=a22
+ a_chuj(1,2,num_conti,i)=a23
+ a_chuj(2,1,num_conti,i)=a32
+ a_chuj(2,2,num_conti,i)=a33
+! --- Gradient of rij
+ do kkk=1,3
+ grij_hb_cont(kkk,num_conti,i)=erij(kkk)
+ enddo
+ kkll=0
+ do k=1,2
+ do l=1,2
+ kkll=kkll+1
+ do m=1,3
+ a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
+ a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
+ a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
+ a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
+ a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
+ enddo
+ enddo
+ enddo
+ ENDIF
+ IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
+! Calculate contact energies
+ cosa4=4.0D0*cosa
+ wij=cosa-3.0D0*cosb*cosg
+ cosbg1=cosb+cosg
+ cosbg2=cosb-cosg
+! fac3=dsqrt(-ael6i)/r0ij**3
+ fac3=dsqrt(-ael6i)*r3ij
+! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
+ ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
+ if (ees0tmp.gt.0) then
+ ees0pij=dsqrt(ees0tmp)
+ else
+ ees0pij=0
+ endif
+! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
+ ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
+ if (ees0tmp.gt.0) then
+ ees0mij=dsqrt(ees0tmp)
+ else
+ ees0mij=0
+ endif
+! ees0mij=0.0D0
+ 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
+! ees0m(num_conti,i)=0.0D0
+! End diagnostics.
+! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
+! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
+! Angular derivatives of the contact function
+ ees0pij1=fac3/ees0pij
+ ees0mij1=fac3/ees0mij
+ fac3p=-3.0D0*fac3*rrmij
+ ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
+ ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
+! ees0mij1=0.0D0
+ ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
+ ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
+ ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
+ ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
+ ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
+ ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
+ ecosap=ecosa1+ecosa2
+ ecosbp=ecosb1+ecosb2
+ ecosgp=ecosg1+ecosg2
+ ecosam=ecosa1-ecosa2
+ ecosbm=ecosb1-ecosb2
+ ecosgm=ecosg1-ecosg2
+! Diagnostics
+! ecosap=ecosa1
+! ecosbp=ecosb1
+! ecosgp=ecosg1
+! ecosam=0.0D0
+! ecosbm=0.0D0
+! ecosgm=0.0D0
+! End diagnostics
+ facont_hb(num_conti,i)=fcont
+ fprimcont=fprimcont/rij
+!d facont_hb(num_conti,i)=1.0D0
+! Following line is for diagnostics.
+!d fprimcont=0.0D0
+ do k=1,3
+ dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
+ dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
+ enddo
+ do k=1,3
+ gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
+ gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
+ enddo
+! gggp(1)=gggp(1)+ees0pijp*xj
+! gggp(2)=gggp(2)+ees0pijp*yj
+! gggp(3)=gggp(3)+ees0pijp*zj
+! gggm(1)=gggm(1)+ees0mijp*xj
+! gggm(2)=gggm(2)+ees0mijp*yj
+! gggm(3)=gggm(3)+ees0mijp*zj
+ 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
+ gacont_hbr(3,num_conti,i)=fprimcont*zj
+ do k=1,3
+!
+! 10/24/08 cgrad and ! comments indicate the parts of the code removed
+! following the change of gradient-summation algorithm.
+!
+!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) &
+ *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
+ endif ! fcont.gt.0
+ endif ! j.gt.i+1
+ if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
+ do k=1,4
+ do l=1,3
+ ghalf=0.5d0*agg(l,k)
+ aggi(l,k)=aggi(l,k)+ghalf
+ aggi1(l,k)=aggi1(l,k)+agg(l,k)
+ aggj(l,k)=aggj(l,k)+ghalf
+ enddo
+ enddo
+ if (j.eq.nres-1 .and. i.lt.j-2) then
+ do k=1,4
+ do l=1,3
+ aggj1(l,k)=aggj1(l,k)+agg(l,k)
+ enddo
+ enddo
+ endif
+ endif
+ 128 continue
+! t_eelecij=t_eelecij+MPI_Wtime()-time00
+ return
+ end subroutine eelecij_scale
+!-----------------------------------------------------------------------------
+ subroutine evdwpp_short(evdw1)
+!
+! Compute Evdwpp
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.CONTACTS'
+! include 'COMMON.TORSION'
+! include 'COMMON.VECTORS'
+! include 'COMMON.FFIELD'
+ real(kind=8),dimension(3) :: ggg
+! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
+#ifdef MOMENT
+ real(kind=8) :: scal_el=1.0d0
+#else
+ real(kind=8) :: scal_el=0.5d0
+#endif
+!el local variables
+ 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,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,faclipij2
+ 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,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+ 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,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
+!el ind=ind+1
+ iteli=itel(i)
+ itelj=itel(j)
+ if (j.eq.i+2 .and. itelj.eq.2) iteli=2
+ aaa=app(iteli,itelj)
+ bbb=bpp(iteli,itelj)
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+! xj=c(1,j)+0.5D0*dxj-xmedi
+! yj=c(2,j)+0.5D0*dyj-ymedi
+! zj=c(3,j)+0.5D0*dzj-zmedi
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ 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
+ r6ij=r3ij*r3ij
+ ev1=aaa*r6ij*r6ij
+! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
+ if (j.eq.i+2) ev1=scal_el*ev1
+ ev2=bbb*r6ij
+ evdwij=ev1+ev2
+ if (energy_dec) then
+ write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
+ endif
+ evdw1=evdw1+evdwij*sss*sss_ele_cut
+!
+! Calculate contributions to the Cartesian gradient.
+!
+ 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)
+ enddo
+ endif
+ enddo ! j
+ enddo ! i
+ return
+ end subroutine evdwpp_short
+!-----------------------------------------------------------------------------
+ subroutine escp_long(evdw2,evdw2_14)
+!
+! This subroutine calculates the excluded-volume interaction energy between
+! peptide-group centers and side chains and its gradient in virtual-bond and
+! side-chain vectors.
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.FFIELD'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CONTROL'
+ real(kind=8),dimension(3) :: ggg
+!el local variables
+ 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,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))
+ call to_box(xi,yi,zi)
+ do iint=1,nscp_gr(i)
+
+ do j=iscpstart(i,iint),iscpend(i,iint)
+ 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)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ 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.lt.1.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)*(1.0d0-sss)*sss_ele_cut
+ endif
+ evdwij=e1+e2
+ 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)*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
+! 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
+!******************************************************************************
+!
+! N O T E !!!
+!
+! To save time the factor EXPON has been extracted from ALL components
+! of GVDWC and GRADX. Remember to multiply them by this factor before further
+! use!
+!
+!******************************************************************************
+ return
+ end subroutine escp_long
+!-----------------------------------------------------------------------------
+ subroutine escp_short(evdw2,evdw2_14)
+!
+! This subroutine calculates the excluded-volume interaction energy between
+! peptide-group centers and side chains and its gradient in virtual-bond and
+! side-chain vectors.
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.FFIELD'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CONTROL'
+ real(kind=8),dimension(3) :: ggg
+!el local variables
+ 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,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))
+ call to_box(xi,yi,zi)
+ if (zi.lt.0) zi=zi+boxzsize
+
+ do iint=1,nscp_gr(i)
+
+ do j=iscpstart(i,iint),iscpend(i,iint)
+ 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)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(1.0d0/rrij)
+ sss_ele_cut=sscale_ele(rij)
+ 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
+!******************************************************************************
+!
+! N O T E !!!
+!
+! To save time the factor EXPON has been extracted from ALL components
+! of GVDWC and GRADX. Remember to multiply them by this factor before further
+! use!
+!
+!******************************************************************************
+ return
+ end subroutine escp_short
+!-----------------------------------------------------------------------------
+! energy_p_new-sep_barrier.F
+!-----------------------------------------------------------------------------
+ subroutine sc_grad_scale(scalfac)
+! implicit real(kind=8) (a-h,o-z)
+ use calc_data
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.CALC'
+! include 'COMMON.IOUNITS'
+ real(kind=8),dimension(3) :: dcosom1,dcosom2
+ real(kind=8) :: scalfac
+!el local variables
+! integer :: i,j,k,l
+
+ 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
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
+! & " sigder",sigder
+! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
+! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
+ 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))*scalfac&
+ *sss_ele_cut
+ enddo
+! write (iout,*) "gg",(gg(k),k=1,3)
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
+ *sss_ele_cut
+ 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*scalfac&
+ *sss_ele_cut
+! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
+! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
+! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ enddo
+!
+! Calculate the components of the gradient in DC and X
+!
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ enddo
+ return
+ end subroutine sc_grad_scale
+!-----------------------------------------------------------------------------
+! energy_split-sep.F
+!-----------------------------------------------------------------------------
+ subroutine etotal_long(energia)
+!
+! Compute the long-range slow-varying contributions to the energy
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+ use MD_data, only: totT,usampl,eq_time
+#ifndef ISNAN
+ external proc_proc
+#ifdef WINPGI
+!MS$ATTRIBUTES C :: proc_proc
+#endif
+#endif
+#ifdef MPI
+ include "mpif.h"
+ real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
+#endif
+! include 'COMMON.SETUP'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.FFIELD'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.CHAIN'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.MD'
+ real(kind=8),dimension(0:n_ene) :: energia
+!el local variables
+ integer :: i,n_corr,n_corr1,ierror,ierr
+ real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
+ evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
+ ecorr,ecorr5,ecorr6,eturn6,time00, ehomology_constr
+! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
+!elwrite(iout,*)"in etotal long"
+
+ if (modecalc.eq.12.or.modecalc.eq.14) then
+#ifdef MPI
+! if (fg_rank.eq.0) call int_from_cart1(.false.)
+#else
+ call int_from_cart1(.false.)
+#endif
+ endif
+!elwrite(iout,*)"in etotal long"
+ ehomology_constr=0.0d0
+#ifdef MPI
+! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
+! & " absolute rank",myrank," nfgtasks",nfgtasks
+ call flush(iout)
+ if (nfgtasks.gt.1) then
+ time00=MPI_Wtime()
+! FG slaves call the following matching MPI_Bcast in ERGASTULUM
+ if (fg_rank.eq.0) then
+ call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
+! write (iout,*) "Processor",myrank," BROADCAST iorder"
+! call flush(iout)
+! FG master sets up the WEIGHTS_ array which will be broadcast to the
+! FG slaves as WEIGHTS array.
+ weights_(1)=wsc
+ weights_(2)=wscp
+ weights_(3)=welec
+ weights_(4)=wcorr
+ weights_(5)=wcorr5
+ weights_(6)=wcorr6
+ weights_(7)=wel_loc
+ weights_(8)=wturn3
+ weights_(9)=wturn4
+ weights_(10)=wturn6
+ weights_(11)=wang
+ weights_(12)=wscloc
+ weights_(13)=wtor
+ weights_(14)=wtor_d
+ weights_(15)=wstrain
+ weights_(16)=wvdwpp
+ weights_(17)=wbond
+ weights_(18)=scal14
+ weights_(21)=wsccor
+! FG Master broadcasts the WEIGHTS_ array
+ call MPI_Bcast(weights_(1),n_ene,&
+ MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
+ else
+! FG slaves receive the WEIGHTS array
+ call MPI_Bcast(weights(1),n_ene,&
+ MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
+ wsc=weights(1)
+ wscp=weights(2)
+ welec=weights(3)
+ wcorr=weights(4)
+ wcorr5=weights(5)
+ wcorr6=weights(6)
+ wel_loc=weights(7)
+ wturn3=weights(8)
+ wturn4=weights(9)
+ wturn6=weights(10)
+ wang=weights(11)
+ wscloc=weights(12)
+ wtor=weights(13)
+ wtor_d=weights(14)
+ wstrain=weights(15)
+ wvdwpp=weights(16)
+ wbond=weights(17)
+ scal14=weights(18)
+ wsccor=weights(21)
+ endif
+ call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+ time_Bcast=time_Bcast+MPI_Wtime()-time00
+ time_Bcastw=time_Bcastw+MPI_Wtime()-time00
+! call chainbuild_cart
+! call int_from_cart1(.false.)
+ endif
+! write (iout,*) 'Processor',myrank,
+! & ' calling etotal_short ipot=',ipot
+! call flush(iout)
+! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
+#endif
+!d print *,'nnt=',nnt,' nct=',nct
+!
+!elwrite(iout,*)"in etotal long"
+! Compute the side-chain and electrostatic interaction energy
+!
+ goto (101,102,103,104,105,106) ipot
+! Lennard-Jones potential.
+ 101 call elj_long(evdw)
+!d print '(a)','Exit ELJ'
+ goto 107
+! Lennard-Jones-Kihara potential (shifted).
+ 102 call eljk_long(evdw)
+ goto 107
+! Berne-Pechukas potential (dilated LJ, angular dependence).
+ 103 call ebp_long(evdw)
+ goto 107
+! Gay-Berne potential (shifted LJ, angular dependence).
+ 104 call egb_long(evdw)
+ goto 107
+! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
+ 105 call egbv_long(evdw)
+ goto 107
+! Soft-sphere potential
+ 106 call e_softsphere(evdw)
+!
+! Calculate electrostatic (H-bonding) energy of the main chain.
+!
+ 107 continue
+ call vec_and_deriv
+ if (ipot.lt.6) then
+#ifdef SPLITELE
+ if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
+ wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
+ .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
+ .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
+#else
+ if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
+ wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
+ .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
+ .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
+#endif
+ call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
+ else
+ ees=0
+ evdw1=0
+ eel_loc=0
+ eello_turn3=0
+ eello_turn4=0
+ endif
+ else
+! write (iout,*) "Soft-spheer ELEC potential"
+ call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
+ eello_turn4)
+ endif
+!
+! Calculate excluded-volume interaction energy between peptide groups
+! and side chains.
+!
+ if (ipot.lt.6) then
+ if(wscp.gt.0d0) then
+ call escp_long(evdw2,evdw2_14)
+ else
+ evdw2=0
+ evdw2_14=0
+ endif
+ else
+ call escp_soft_sphere(evdw2,evdw2_14)
+ endif
+!
+! 12/1/95 Multi-body terms
+!
+ n_corr=0
+ n_corr1=0
+ if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
+ .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
+ call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
+! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
+! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
+ else
+ ecorr=0.0d0
+ ecorr5=0.0d0
+ ecorr6=0.0d0
+ eturn6=0.0d0
+ endif
+ if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
+ call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
+ endif
+!
+! If performing constraint dynamics, call the constraint energy
+! after the equilibration time
+ if(usampl.and.totT.gt.eq_time) then
+ call EconstrQ
+ call Econstr_back
+ else
+ Uconst=0.0d0
+ Uconst_back=0.0d0
+ endif
+!
+! Sum the energies
+!
+ do i=1,n_ene
+ energia(i)=0.0d0
+ enddo
+ energia(1)=evdw
+#ifdef SCP14
+ energia(2)=evdw2-evdw2_14
+ energia(18)=evdw2_14
+#else
+ energia(2)=evdw2
+ energia(18)=0.0d0
+#endif
+#ifdef SPLITELE
+ energia(3)=ees
+ energia(16)=evdw1
+#else
+ energia(3)=ees+evdw1
+ energia(16)=0.0d0
+#endif
+ energia(4)=ecorr
+ energia(5)=ecorr5
+ energia(6)=ecorr6
+ energia(7)=eel_loc
+ energia(8)=eello_turn3
+ energia(9)=eello_turn4
+ energia(10)=eturn6
+ energia(20)=Uconst+Uconst_back
+ energia(51)=ehomology_constr
+ call sum_energy(energia,.true.)
+! write (iout,*) "Exit ETOTAL_LONG"
+ call flush(iout)
+ return
+ end subroutine etotal_long
+!-----------------------------------------------------------------------------
+ subroutine etotal_short(energia)
+!
+! Compute the short-range fast-varying contributions to the energy
+!
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+#ifndef ISNAN
+ external proc_proc
+#ifdef WINPGI
+!MS$ATTRIBUTES C :: proc_proc
+#endif
+#endif
+#ifdef MPI
+ include "mpif.h"
+ integer :: ierror,ierr
+ real(kind=8),dimension(n_ene) :: weights_
+ real(kind=8) :: time00
+#endif
+! include 'COMMON.SETUP'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.FFIELD'
+! include 'COMMON.DERIV'
+! include 'COMMON.INTERACT'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.CHAIN'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+ real(kind=8),dimension(0:n_ene) :: energia
+!el local variables
+ integer :: i,nres6
+ real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
+ real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr, &
+ ehomology_constr
+ nres6=6*nres
+
+! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
+! call flush(iout)
+ if (modecalc.eq.12.or.modecalc.eq.14) then
+#ifdef MPI
+ if (fg_rank.eq.0) call int_from_cart1(.false.)
+#else
+ call int_from_cart1(.false.)
+#endif
+ endif
+#ifdef MPI
+! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
+! & " absolute rank",myrank," nfgtasks",nfgtasks
+! call flush(iout)
+ if (nfgtasks.gt.1) then
+ time00=MPI_Wtime()
+! FG slaves call the following matching MPI_Bcast in ERGASTULUM
+ if (fg_rank.eq.0) then
+ call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
+! write (iout,*) "Processor",myrank," BROADCAST iorder"
+! call flush(iout)
+! FG master sets up the WEIGHTS_ array which will be broadcast to the
+! FG slaves as WEIGHTS array.
+ weights_(1)=wsc
+ weights_(2)=wscp
+ weights_(3)=welec
+ weights_(4)=wcorr
+ weights_(5)=wcorr5
+ weights_(6)=wcorr6
+ weights_(7)=wel_loc
+ weights_(8)=wturn3
+ weights_(9)=wturn4
+ weights_(10)=wturn6
+ weights_(11)=wang
+ weights_(12)=wscloc
+ weights_(13)=wtor
+ weights_(14)=wtor_d
+ weights_(15)=wstrain
+ weights_(16)=wvdwpp
+ weights_(17)=wbond
+ weights_(18)=scal14
+ weights_(21)=wsccor
! FG Master broadcasts the WEIGHTS_ array
call MPI_Bcast(weights_(1),n_ene,&
MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
else
-! FG slaves receive the WEIGHTS array
- call MPI_Bcast(weights(1),n_ene,&
- MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- wsc=weights(1)
- wscp=weights(2)
- welec=weights(3)
- wcorr=weights(4)
- wcorr5=weights(5)
- wcorr6=weights(6)
- wel_loc=weights(7)
- wturn3=weights(8)
- wturn4=weights(9)
- wturn6=weights(10)
- wang=weights(11)
- wscloc=weights(12)
- wtor=weights(13)
- wtor_d=weights(14)
- wstrain=weights(15)
- wvdwpp=weights(16)
- wbond=weights(17)
- scal14=weights(18)
- wsccor=weights(21)
+! FG slaves receive the WEIGHTS array
+ call MPI_Bcast(weights(1),n_ene,&
+ MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
+ wsc=weights(1)
+ wscp=weights(2)
+ welec=weights(3)
+ wcorr=weights(4)
+ wcorr5=weights(5)
+ wcorr6=weights(6)
+ wel_loc=weights(7)
+ wturn3=weights(8)
+ wturn4=weights(9)
+ wturn6=weights(10)
+ wang=weights(11)
+ wscloc=weights(12)
+ wtor=weights(13)
+ wtor_d=weights(14)
+ wstrain=weights(15)
+ wvdwpp=weights(16)
+ wbond=weights(17)
+ scal14=weights(18)
+ wsccor=weights(21)
+ endif
+! write (iout,*),"Processor",myrank," BROADCAST weights"
+ call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST c"
+ call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST dc"
+ call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
+ call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST theta"
+ call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST phi"
+ call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST alph"
+ call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST omeg"
+ call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+! write (iout,*) "Processor",myrank," BROADCAST vbld"
+ call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
+ king,FG_COMM,IERR)
+ time_Bcast=time_Bcast+MPI_Wtime()-time00
+! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
+ endif
+! write (iout,*) 'Processor',myrank,
+! & ' calling etotal_short ipot=',ipot
+! call flush(iout)
+! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
+#endif
+! call int_from_cart1(.false.)
+!
+! Compute the side-chain and electrostatic interaction energy
+!
+ goto (101,102,103,104,105,106) ipot
+! Lennard-Jones potential.
+ 101 call elj_short(evdw)
+!d print '(a)','Exit ELJ'
+ goto 107
+! Lennard-Jones-Kihara potential (shifted).
+ 102 call eljk_short(evdw)
+ goto 107
+! Berne-Pechukas potential (dilated LJ, angular dependence).
+ 103 call ebp_short(evdw)
+ goto 107
+! Gay-Berne potential (shifted LJ, angular dependence).
+ 104 call egb_short(evdw)
+ goto 107
+! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
+ 105 call egbv_short(evdw)
+ goto 107
+! Soft-sphere potential - already dealt with in the long-range part
+ 106 evdw=0.0d0
+! 106 call e_softsphere_short(evdw)
+!
+! Calculate electrostatic (H-bonding) energy of the main chain.
+!
+ 107 continue
+!
+! Calculate the short-range part of Evdwpp
+!
+ call evdwpp_short(evdw1)
+!
+! Calculate the short-range part of ESCp
+!
+ if (ipot.lt.6) then
+ call escp_short(evdw2,evdw2_14)
+ endif
+!
+! Calculate the bond-stretching energy
+!
+ call ebond(estr)
+!
+! Calculate the disulfide-bridge and other energy and the contributions
+! from other distance constraints.
+! call edis(ehpb)
+!
+! Calculate the virtual-bond-angle energy.
+!
+! Calculate the SC local energy.
+!
+ call vec_and_deriv
+ call esc(escloc)
+!
+ if (wang.gt.0d0) then
+ if (tor_mode.eq.0) then
+ call ebend(ebe)
+ else
+!C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call ebend_kcc(ebe)
+ endif
+ else
+ ebe=0.0d0
+ endif
+ ethetacnstr=0.0d0
+ if (with_theta_constr) call etheta_constr(ethetacnstr)
+
+! write(iout,*) "in etotal afer ebe",ipot
+
+! print *,"Processor",myrank," computed UB"
+!
+! Calculate the SC local energy.
+!
+ call esc(escloc)
+!elwrite(iout,*) "in etotal afer esc",ipot
+! print *,"Processor",myrank," computed USC"
+!
+! Calculate the virtual-bond torsional energy.
+!
+!d print *,'nterm=',nterm
+! if (wtor.gt.0) then
+! call etor(etors,edihcnstr)
+! else
+! etors=0
+! edihcnstr=0
+! endif
+ if (wtor.gt.0.0d0) then
+ if (tor_mode.eq.0) then
+ call etor(etors)
+ else
+!C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
+!C energy function
+ call etor_kcc(etors)
+ endif
+ else
+ etors=0.0d0
+ endif
+ edihcnstr=0.0d0
+ if (ndih_constr.gt.0) call etor_constr(edihcnstr)
+
+! Calculate the virtual-bond torsional energy.
+!
+!
+! 6/23/01 Calculate double-torsional energy
+!
+ if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
+ call etor_d(etors_d)
+ endif
+!
+! Homology restraints
+!
+ if (constr_homology.ge.1) then
+ call e_modeller(ehomology_constr)
+! print *,"tu"
+ else
+ ehomology_constr=0.0d0
+ endif
+
+!
+! 21/5/07 Calculate local sicdechain correlation energy
+!
+ if (wsccor.gt.0.0d0) then
+ call eback_sc_corr(esccor)
+ else
+ esccor=0.0d0
+ endif
+!
+! Put energy components into an array
+!
+ do i=1,n_ene
+ energia(i)=0.0d0
+ enddo
+ energia(1)=evdw
+#ifdef SCP14
+ energia(2)=evdw2-evdw2_14
+ energia(18)=evdw2_14
+#else
+ energia(2)=evdw2
+ energia(18)=0.0d0
+#endif
+#ifdef SPLITELE
+ energia(16)=evdw1
+#else
+ energia(3)=evdw1
+#endif
+ energia(11)=ebe
+ energia(12)=escloc
+ energia(13)=etors
+ energia(14)=etors_d
+ energia(15)=ehpb
+ energia(17)=estr
+ energia(19)=edihcnstr
+ energia(21)=esccor
+ energia(51)=ehomology_constr
+! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
+ call flush(iout)
+ call sum_energy(energia,.true.)
+! write (iout,*) "Exit ETOTAL_SHORT"
+ call flush(iout)
+ return
+ end subroutine etotal_short
+!-----------------------------------------------------------------------------
+! gnmr1.f
+!-----------------------------------------------------------------------------
+ real(kind=8) function gnmr1(y,ymin,ymax)
+! implicit none
+ real(kind=8) :: y,ymin,ymax
+ real(kind=8) :: wykl=4.0d0
+ if (y.lt.ymin) then
+ gnmr1=(ymin-y)**wykl/wykl
+ else if (y.gt.ymax) then
+ gnmr1=(y-ymax)**wykl/wykl
+ else
+ gnmr1=0.0d0
+ endif
+ return
+ end function gnmr1
+!-----------------------------------------------------------------------------
+ real(kind=8) function gnmr1prim(y,ymin,ymax)
+! implicit none
+ real(kind=8) :: y,ymin,ymax
+ real(kind=8) :: wykl=4.0d0
+ if (y.lt.ymin) then
+ gnmr1prim=-(ymin-y)**(wykl-1)
+ else if (y.gt.ymax) then
+ gnmr1prim=(y-ymax)**(wykl-1)
+ else
+ gnmr1prim=0.0d0
+ 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
+ real(kind=8) :: wykl=2.0d0
+ harmonic=(y-ymax)**wykl
+ return
+ end function harmonic
+!-----------------------------------------------------------------------------
+ real(kind=8) function harmonicprim(y,ymax)
+ real(kind=8) :: y,ymin,ymax
+ real(kind=8) :: wykl=2.0d0
+ harmonicprim=(y-ymax)*wykl
+ return
+ end function harmonicprim
+!-----------------------------------------------------------------------------
+! gradient_p.F
+!-----------------------------------------------------------------------------
+#ifndef LBFGS
+ subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
+
+ use io_base, only:intout,briefout
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.VAR'
+! include 'COMMON.INTERACT'
+! include 'COMMON.FFIELD'
+! include 'COMMON.MD'
+! include 'COMMON.IOUNITS'
+ real(kind=8),external :: ufparm
+ integer :: uiparm(1)
+ real(kind=8) :: urparm(1)
+ real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
+ real(kind=8) :: f,gthetai,gphii,galphai,gomegai
+ integer :: n,nf,ind,ind1,i,k,j
+!
+! This subroutine calculates total internal coordinate gradient.
+! Depending on the number of function evaluations, either whole energy
+! is evaluated beforehand, Cartesian coordinates and their derivatives in
+! internal coordinates are reevaluated or only the cartesian-in-internal
+! coordinate derivatives are evaluated. The subroutine was designed to work
+! with SUMSL.
+!
+!
+ icg=mod(nf,2)+1
+
+!d print *,'grad',nf,icg
+ if (nf-nfl+1) 20,30,40
+ 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
+! write (iout,*) 'grad 20'
+ if (nf.eq.0) return
+ goto 40
+ 30 call var_to_geom(n,x)
+ call chainbuild
+! write (iout,*) 'grad 30'
+!
+! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
+!
+ 40 call cartder
+! write (iout,*) 'grad 40'
+! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
+!
+! Convert the Cartesian gradient into internal-coordinate gradient.
+!
+ ind=0
+ ind1=0
+ do i=1,nres-2
+ 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
+ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
+ enddo
+ do k=1,3
+ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
+ enddo
+ enddo
+ do j=i+1,nres-1
+ ind1=ind1+1
+! 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)
+ enddo
+ enddo
+ if (i.gt.1) g(i-1)=gphii
+ if (n.gt.nphi) g(nphi+i)=gthetai
+ enddo
+ if (n.le.nphi+ntheta) goto 10
+ do i=2,nres-1
+ if (itype(i,1).ne.10) then
+ galphai=0.0D0
+ gomegai=0.0D0
+ do k=1,3
+ galphai=galphai+dxds(k,i)*gradx(k,i,icg)
+ enddo
+ do k=1,3
+ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
+ enddo
+ g(ialph(i,1))=galphai
+ g(ialph(i,1)+nside)=gomegai
+ endif
+ enddo
+!
+! Add the components corresponding to local energy terms.
+!
+ 10 continue
+ do i=1,nvar
+!d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
+ g(i)=g(i)+gloc(i,icg)
+ enddo
+! Uncomment following three lines for diagnostics.
+!d call intout
+!elwrite(iout,*) "in gradient after calling intout"
+!d call briefout(0,0.0d0)
+!d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
+ return
+ end subroutine gradient
+#endif
+!-----------------------------------------------------------------------------
+ subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
+
+ use comm_chu
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.DERIV'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.GEO'
+ integer :: n,nf
+!el integer :: jjj
+!el common /chuju/ jjj
+ real(kind=8) :: energia(0:n_ene)
+ integer :: uiparm(1)
+ 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)
+! if (jjj.gt.0) then
+! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
+! endif
+ nfl=nf
+ icg=mod(nf,2)+1
+!d print *,'func',nf,nfl,icg
+ call var_to_geom(n,x)
+ call zerograd
+ call chainbuild
+!d write (iout,*) 'ETOTAL called from FUNC'
+ call etotal(energia)
+ call sum_gradient
+ f=energia(0)
+! if (jjj.gt.0) then
+! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
+! write (iout,*) 'f=',etot
+! jjj=0
+! endif
+ return
+ end subroutine func
+!-----------------------------------------------------------------------------
+ subroutine cartgrad
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+ use energy_data
+ use MD_data, only: totT,usampl,eq_time
+#ifdef MPI
+ include 'mpif.h'
+#endif
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.VAR'
+! include 'COMMON.INTERACT'
+! include 'COMMON.FFIELD'
+! include 'COMMON.MD'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.TIME1'
+!
+ integer :: i,j
+ real(kind=8) :: time00,time01
+
+! This subrouting calculates total Cartesian coordinate gradient.
+! The subroutine chainbuild_cart and energy MUST be called beforehand.
+!
+!#define DEBUG
+#ifdef TIMINGtime01
+ time00=MPI_Wtime()
+#endif
+ icg=1
+ call sum_gradient
+#ifdef TIMING
+#endif
+!#define DEBUG
+!el write (iout,*) "After sum_gradient"
+#ifdef DEBUG
+ write (iout,*) "After sum_gradient"
+ do i=1,nres-1
+ write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
+ write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
+ enddo
+#endif
+!#undef DEBUG
+! If performing constraint dynamics, add the gradients of the constraint energy
+ if(usampl.and.totT.gt.eq_time) then
+ do i=1,nct
+ do j=1,3
+ gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
+ gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
+ enddo
+ enddo
+ do i=1,nres-3
+ gloc(i,icg)=gloc(i,icg)+dugamma(i)
+ enddo
+ do i=1,nres-2
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
+ enddo
+ endif
+!elwrite (iout,*) "After sum_gradient"
+#ifdef TIMING
+ time01=MPI_Wtime()
+#endif
+ call intcartderiv
+!elwrite (iout,*) "After sum_gradient"
+#ifdef TIMING
+ time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
+#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=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),4f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3),gloc(i,icg),(gloc_sc(j,i,icg),j=1,3)
+#endif
+ enddo
+#ifdef TIMING
+ 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
+#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
+#endif
+!#undef DEBUG
+#ifdef CARGRAD
+#ifdef DEBUG
+ write (iout,*) "CARGRAD"
+#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
+! call grad_transform
+#endif
+#ifdef TIMING
+ time_cartgrad=time_cartgrad+MPI_Wtime()-time00
+#endif
+!#undef DEBUG
+ return
+ end subroutine cartgrad
+
+#ifdef FIVEDIAG
+ subroutine grad_transform
+ implicit none
+#ifdef MPI
+ include 'mpif.h'
+#endif
+ integer i,j,kk,mnum
+#ifdef DEBUG
+ write (iout,*)"Converting virtual-bond gradient to CA/SC gradient"
+ write (iout,*) "dC/dX gradient"
+ do i=0,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
+ & (gxcart(j,i),j=1,3)
+ enddo
+#endif
+ do i=nres,1,-1
+ do j=1,3
+ gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
+! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
+ enddo
+! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
+! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
+ enddo
+! Correction: dummy residues
+ do i=2,nres
+ mnum=molnum(i)
+ if (itype(i-1,mnum).eq.ntyp1_molec(mnum) .and.&
+ itype(i,mnum).ne.ntyp1_molec(mnum)) then
+ gcart(:,i)=gcart(:,i)+gcart(:,i-1)
+ else if (itype(i-1,mnum).ne.ntyp1_molec(mnum).and.&
+ itype(i,mnum).eq.ntyp1_molec(mnum)) then
+ gcart(:,i-1)=gcart(:,i-1)+gcart(:,i)
+ endif
+ enddo
+! if (nnt.gt.1) then
+! do j=1,3
+! gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
+! enddo
+! endif
+! if (nct.lt.nres) then
+! do j=1,3
+!! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
+! gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
+! enddo
+! endif
+#ifdef DEBUG
+ write (iout,*) "CA/SC gradient"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
+ & (gxcart(j,i),j=1,3)
+ enddo
+#endif
+ return
+ end subroutine grad_transform
+#endif
+
+ !-----------------------------------------------------------------------------
+ subroutine zerograd
+ ! implicit real(kind=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
+ gradnuclcatx(j,i)=0.0d0
+ gradnuclcat(j,i)=0.0d0
+ gradlipbond(j,i)=0.0d0
+ gradlipang(j,i)=0.0d0
+ gradliplj(j,i)=0.0d0
+ gradlipelec(j,i)=0.0d0
+ gradcattranc(j,i)=0.0d0
+ gradcattranx(j,i)=0.0d0
+ gradcatangx(j,i)=0.0d0
+ gradcatangc(j,i)=0.0d0
+ gradpepmart(j,i)=0.0d0
+ gradpepmartx(j,i)=0.0d0
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
+ enddo
+ enddo
+ do i=0,nres
+ do j=1,3
+ do intertyp=1,3
+ gloc_sc(intertyp,i,icg)=0.0d0
+ enddo
+ 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
+
+ !
+ ! 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(kind=8) (a-h,o-z)
+ ! include 'DIMENSIONS'
+#ifdef MPI
+ 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,IERROR
+ integer :: nres2
+ nres2=2*nres
+
+ !el from module energy-------------
+ !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
+ !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))
+
+
+
+#if defined(MPI) && defined(PARINTDER)
+ 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
+
+ ! 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
+ dcosomicron(j,1,1,i)=0.0d0
+ dcosomicron(j,1,2,i)=0.0d0
+ dcosomicron(j,2,1,i)=0.0d0
+ dcosomicron(j,2,2,i)=0.0d0
+ enddo
+ enddo
+ ! Derivatives of theta's
+#if defined(MPI) && defined(PARINTDER)
+ ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
+ do i=max0(ithet_start-1,3),ithet_end
+#else
+ do i=3,nres
+#endif
+ cost=dcos(theta(i))
+ sint=sqrt(1-cost*cost)
+ do j=1,3
+ dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
+ vbld(i-1)
+ if (((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))) &
+ dtheta(j,1,i)=-dcostheta(j,1,i)/sint
+ dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
+ vbld(i)
+ if ((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))&
+ dtheta(j,2,i)=-dcostheta(j,2,i)/sint
+ enddo
+ enddo
+#if defined(MPI) && defined(PARINTDER)
+ ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
+ do i=max0(ithet_start-1,3),ithet_end
+#else
+ do i=3,nres
+#endif
+ if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).lt.4) 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
+#else
+ do i=4,nres
+#endif
+ ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
+ ! the conventional case
+ sint=dsin(theta(i))
+ sint1=dsin(theta(i-1))
+ sing=dsin(phi(i))
+ cost=dcos(theta(i))
+ cost1=dcos(theta(i-1))
+ cosg=dcos(phi(i))
+ scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
+ ! Obtaining the gamma derivatives from sine derivative
+ if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
+ phi(i).gt.pi34.and.phi(i).le.pi.or. &
+ phi(i).ge.-pi.and.phi(i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
+ do j=1,3
+ if (sint.ne.0.0d0) then
+ ctgt=cost/sint
+ else
+ ctgt=0.0d0
+ endif
+ if (sint1.ne.0.0d0) then
+ ctgt1=cost1/sint1
+ else
+ ctgt1=0.0d0
+ endif
+ cosg_inv=1.0d0/cosg
+! if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
+ dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
+ -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
+ dsinphi(j,2,i)= &
+ -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
+ dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
+ ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
+ dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
+! endif
+! write(iout,*) "just after,close to pi",dphi(j,3,i),&
+! sing*(ctgt1*dtheta(j,2,i-1)),ctgt*dtheta(j,1,i), &
+! (fac0*vp2(j)+sing*dc_norm(j,i-2)),vbld_inv(i-1)
+
+ ! Bug fixed 3/24/05 (AL)
+ enddo
+ ! 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
+#else
+ do i=3,nres
+ !elwrite(iout,*) " vecpr",i,nres
+#endif
+ if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
+ ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).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))
+ ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
+
+ ! Obtaining the gamma derivatives from sine derivative
+ if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
+ tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
+ tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
+ -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
+ *vbld_inv(i-2+nres)
+ dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
+ dsintau(j,1,2,i)= &
+ -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ ! 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
+#else
+ do i=4,nres
+#endif
+ if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
+ (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
+ ! 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))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
+ ! Obtaining the gamma derivatives from sine derivative
+ if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
+ tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
+ tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
+ call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
+ +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ ! 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
+#ifdef PARINTDER
+
+ do i=itau_start,itau_end
+#else
+ do i=3,nres
+#endif
+ ! the conventional case
+ if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
+ (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
+ sint=dsin(omicron(1,i))
+ sint1=dsin(omicron(2,i-1))
+ sing=dsin(tauangle(3,i))
+ cost=dcos(omicron(1,i))
+ cost1=dcos(omicron(2,i-1))
+ cosg=dcos(tauangle(3,i))
+ do j=1,3
+ dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
+ ! 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))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
+ ! Obtaining the gamma derivatives from sine derivative
+ if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
+ tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
+ tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
+ -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
+ *vbld_inv(i-2+nres)
+ dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
+ dsintau(j,3,2,i)= &
+ -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
+ ! 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
+#if defined(MPI) && defined(PARINTDER)
+ do i=ibond_start,ibond_end
+#else
+ do i=2,nres-1
+#endif
+ if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
+ fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
+ fac6=fac5/vbld(i)
+ fac7=fac5*fac5
+ fac8=fac5/vbld(i+1)
+ fac9=fac5/vbld(i+nres)
+ scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
+ scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
+ cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
+ (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
+ -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
+ sina=sqrt(1-cosa*cosa)
+ sino=dsin(omeg(i))
+ ! 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
+ 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
+#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
+#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)
+!#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
+#endif
+!#undef DEBUG
+ call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
+ MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
+ !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)
+#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
+#endif
+!#undef DEBUG
+ return
+ end subroutine intcartderiv
+ !-----------------------------------------------------------------------------
+ subroutine checkintcartgrad
+ ! implicit real(kind=8) (a-h,o-z)
+ ! include 'DIMENSIONS'
+#ifdef MPI
+ 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.)
+ dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
+!el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
+!el (dtheta(j,2,i),j=1,3)
+!el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
+!el (dthetanum(j,2,i),j=1,3)
+!el write (iout,'(5x,3f10.5,5x,3f10.5)') &
+!el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
+!el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
+!el write (iout,*)
+ enddo
+! Check gamma gradient
+ write (iout,*) &
+ "Analytical (upper) and numerical (lower) gradient of gamma"
+ do i=4,nres
+ do j=1,3
+ dcji=dc(j,i-3)
+ dc(j,i-3)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-3)=dcji
+ dcji=dc(j,i-2)
+ dc(j,i-2)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
+!el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
+!el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
+!el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
+!el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
+!el write (iout,'(5x,3(3f10.5,5x))') &
+!el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
+!el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
+!el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
+!el write (iout,*)
+ enddo
+! Check alpha gradient
+ write (iout,*) &
+ "Analytical (upper) and numerical (lower) gradient of alpha"
+ do i=2,nres-1
+ if(itype(i,1).ne.10) then
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
+!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),&
+!el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
+!el write (iout,'(5x,3(3f10.5,5x))') &
+!el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
+!el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
+!el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
+!el write (iout,*)
+ enddo
+! Check omega gradient
+ write (iout,*) &
+ "Analytical (upper) and numerical (lower) gradient of omega"
+ do i=2,nres-1
+ if(itype(i,1).ne.10) then
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
+!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),&
+!el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
+!el write (iout,'(5x,3(3f10.5,5x))') &
+!el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
+!el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
+!el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
+!el write (iout,*)
+ enddo
+ return
+ end subroutine checkintcartgrad
+!-----------------------------------------------------------------------------
+! q_measure.F
+!-----------------------------------------------------------------------------
+ real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.INTERACT'
+! 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) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
+ logical :: lprn=.false.
+ logical :: flag
+! real(kind=8) :: sigm,x
+
+!el sigm(x)=0.25d0*x ! local function
+ qqmax=1.0d10
+ do kkk=1,nperm
+ qq = 0.0d0
+ nl=0
+ if(flag) then
+ do il=seg1+nsep,seg2
+ do jl=seg1,il-nsep
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
+ nl=nl+1
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
+ enddo
+ enddo
+ qq = qq/nl
+ else
+ do il=seg1,seg2
+ if((seg3-il).lt.3) then
+ secseg=il+3
+ else
+ secseg=seg3
+ endif
+ do jl=secseg,seg4
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
+ nl=nl+1
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
+ enddo
+ enddo
+ qq = qq/nl
+ endif
+ if (qqmax.le.qq) qqmax=qq
+ enddo
+ qwolynes=1.0d0-qqmax
+ return
+ end function qwolynes
+!-----------------------------------------------------------------------------
+ subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.INTERACT'
+! include 'COMMON.VAR'
+! include 'COMMON.MD'
+ integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
+ integer :: nsep=3, kkk
+!el real(kind=8) :: dist
+ real(kind=8) :: dij,d0ij,dijCM,d0ijCM
+ logical :: lprn=.false.
+ logical :: flag
+ real(kind=8) :: sim,dd0,fac,ddqij
+!el sigm(x)=0.25d0*x ! local function
+ do kkk=1,nperm
+ do i=0,nres
+ do j=1,3
+ dqwol(j,i)=0.0d0
+ dxqwol(j,i)=0.0d0
+ enddo
+ enddo
+ nl=0
+ if(flag) then
+ do il=seg1+nsep,seg2
+ do jl=seg1,il-nsep
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ sim = 1.0d0/sigm(d0ij)
+ sim = sim*sim
+ dd0 = dij-d0ij
+ fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il)-c(k,jl))*fac
+ dqwol(k,il)=dqwol(k,il)+ddqij
+ dqwol(k,jl)=dqwol(k,jl)-ddqij
+ enddo
+
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
+ nl=nl+1
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ sim = 1.0d0/sigm(d0ijCM)
+ sim = sim*sim
+ dd0=dijCM-d0ijCM
+ fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
+ dxqwol(k,il)=dxqwol(k,il)+ddqij
+ dxqwol(k,jl)=dxqwol(k,jl)-ddqij
+ enddo
+ endif
+ enddo
+ enddo
+ else
+ do il=seg1,seg2
+ if((seg3-il).lt.3) then
+ secseg=il+3
+ else
+ secseg=seg3
+ endif
+ do jl=secseg,seg4
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ sim = 1.0d0/sigm(d0ij)
+ sim = sim*sim
+ dd0 = dij-d0ij
+ fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il)-c(k,jl))*fac
+ dqwol(k,il)=dqwol(k,il)+ddqij
+ dqwol(k,jl)=dqwol(k,jl)-ddqij
+ enddo
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
+ nl=nl+1
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ sim = 1.0d0/sigm(d0ijCM)
+ sim=sim*sim
+ dd0 = dijCM-d0ijCM
+ fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
+ dxqwol(k,il)=dxqwol(k,il)+ddqij
+ dxqwol(k,jl)=dxqwol(k,jl)-ddqij
+ enddo
+ endif
+ enddo
+ enddo
+ endif
+ enddo
+ do i=0,nres
+ do j=1,3
+ dqwol(j,i)=dqwol(j,i)/nl
+ dxqwol(j,i)=dxqwol(j,i)/nl
+ enddo
+ enddo
+ return
+ end subroutine qwolynes_prim
+!-----------------------------------------------------------------------------
+ subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.INTERACT'
+! include 'COMMON.VAR'
+ integer :: seg1,seg2,seg3,seg4
+ logical :: flag
+ real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
+ real(kind=8),dimension(3,0:2*nres) :: cdummy
+ real(kind=8) :: q1,q2
+ real(kind=8) :: delta=1.0d-10
+ integer :: i,j
+
+ do i=0,nres
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i)=c(j,i)
+ c(j,i)=c(j,i)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolan(j,i)=(q2-q1)/delta
+ c(j,i)=cdummy(j,i)
+ enddo
+ enddo
+ do i=0,nres
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i+nres)=c(j,i+nres)
+ c(j,i+nres)=c(j,i+nres)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolxan(j,i)=(q2-q1)/delta
+ c(j,i+nres)=cdummy(j,i+nres)
+ enddo
+ enddo
+! write(iout,*) "Numerical Q carteisan gradients backbone: "
+! do i=0,nct
+! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
+! enddo
+! write(iout,*) "Numerical Q carteisan gradients side-chain: "
+! do i=0,nct
+! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
+! enddo
+ return
+ end subroutine qwol_num
+!-----------------------------------------------------------------------------
+ subroutine EconstrQ
+! MD with umbrella_sampling using Wolyne's distance measure as a constraint
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.VAR'
+! include 'COMMON.MD'
+ use MD_data
+!#ifndef LANG0
+! include 'COMMON.LANGEVIN'
+!#else
+! include 'COMMON.LANGEVIN.lang0'
+!#endif
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.NAMES'
+! include 'COMMON.TIME1'
+ real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
+ real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
+ duconst,duxconst
+ integer :: kstart,kend,lstart,lend,idummy
+ real(kind=8) :: delta=1.0d-7
+ integer :: i,j,k,ii
+ do i=0,nres
+ do j=1,3
+ duconst(j,i)=0.0d0
+ dudconst(j,i)=0.0d0
+ duxconst(j,i)=0.0d0
+ dudxconst(j,i)=0.0d0
+ enddo
+ enddo
+ Uconst=0.0d0
+ do i=1,nfrag
+ qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
+ Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
+! Calculating the derivatives of Constraint energy with respect to Q
+ 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
+! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
+! & qinfrag(i,iset))
+! write(iout,*) "harmonicnum frag", hmnum
+! Calculating the derivatives of Q with respect to cartesian coordinates
+ call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
+! write(iout,*) "dqwol "
+! do ii=1,nres
+! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
+! enddo
+! write(iout,*) "dxqwol "
+! do ii=1,nres
+! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
+! enddo
+! Calculating numerical gradients of dU/dQi and dQi/dxi
+! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
+! & ,idummy,idummy)
+! The gradients of Uconst in Cs
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
+ enddo
+ enddo
+ enddo
+ do i=1,npair
+ kstart=ifrag(1,ipair(1,i,iset),iset)
+ kend=ifrag(2,ipair(1,i,iset),iset)
+ lstart=ifrag(1,ipair(2,i,iset),iset)
+ lend=ifrag(2,ipair(2,i,iset),iset)
+ qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
+ Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
+! 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
+! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
+! & qinpair(i,iset))
+! write(iout,*) "harmonicnum pair ", hmnum
+! Calculating dQ/dXi
+ call qwolynes_prim(kstart,kend,.false.,&
+ lstart,lend)
+! write(iout,*) "dqwol "
+! do ii=1,nres
+! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
+! enddo
+! write(iout,*) "dxqwol "
+! do ii=1,nres
+! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
+! enddo
+! Calculating numerical gradients
+! call qwol_num(kstart,kend,.false.
+! & ,lstart,lend)
+! The gradients of Uconst in Cs
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
+ enddo
+ enddo
+ enddo
+! write(iout,*) "Uconst inside subroutine ", Uconst
+! Transforming the gradients from Cs to dCs for the backbone
+ do i=0,nres
+ do j=i+1,nres
+ do k=1,3
+ dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
+ enddo
+ enddo
+ enddo
+! Transforming the gradients from Cs to dCs for the side chains
+ do i=1,nres
+ do j=1,3
+ dudxconst(j,i)=duxconst(j,i)
+ enddo
+ enddo
+! write(iout,*) "dU/ddc backbone "
+! do ii=0,nres
+! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
+! enddo
+! write(iout,*) "dU/ddX side chain "
+! do ii=1,nres
+! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
+! enddo
+! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
+! call dEconstrQ_num
+ return
+ end subroutine EconstrQ
+!-----------------------------------------------------------------------------
+ subroutine dEconstrQ_num
+! Calculating numerical dUconst/ddc and dUconst/ddx
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.CONTROL'
+! include 'COMMON.VAR'
+! include 'COMMON.MD'
+ use MD_data
+!#ifndef LANG0
+! include 'COMMON.LANGEVIN'
+!#else
+! include 'COMMON.LANGEVIN.lang0'
+!#endif
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.NAMES'
+! include 'COMMON.TIME1'
+ real(kind=8) :: uzap1,uzap2
+ real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
+ integer :: kstart,kend,lstart,lend,idummy
+ real(kind=8) :: delta=1.0d-7
+!el local variables
+ integer :: i,ii,j
+! real(kind=8) ::
+! For the backbone
+ do i=0,nres-1
+ do j=1,3
+ dUcartan(j,i)=0.0d0
+ cdummy(j,i)=dc(j,i)
+ dc(j,i)=dc(j,i)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ ducartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
+ enddo
+! Calculating numerical gradients for dU/ddx
+ do i=0,nres-1
+ duxcartan(j,i)=0.0d0
+ do j=1,3
+ cdummy(j,i)=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i+nres)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
+ ifrag(2,ii,iset),.true.,idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ duxcartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
+ enddo
+ write(iout,*) "Numerical dUconst/ddc backbone "
+ do ii=0,nres
+ write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
+ enddo
+! write(iout,*) "Numerical dUconst/ddx side-chain "
+! do ii=1,nres
+! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
+! enddo
+ return
+ end subroutine dEconstrQ_num
+!-----------------------------------------------------------------------------
+! ssMD.F
+!-----------------------------------------------------------------------------
+ subroutine check_energies
+
+! use random, only: ran_number
+
+! implicit none
+! Includes
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.VAR'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.LOCAL'
+! include 'COMMON.GEO'
+
+! External functions
+!EL double precision ran_number
+!EL external ran_number
+
+! Local variables
+ integer :: i,j,k,l,lmax,p,pmax,countss
+ real(kind=8) :: rmin,rmax
+ real(kind=8) :: eij
+
+ real(kind=8) :: d
+ real(kind=8) :: wi,rij,tj,pj
+! return
+ countss=1
+ i=5
+ j=14
+
+ d=dsc(1)
+ rmin=2.0D0
+ rmax=12.0D0
+
+ lmax=10000
+ pmax=1
+
+ do k=1,3
+ c(k,i)=0.0D0
+ c(k,j)=0.0D0
+ c(k,nres+i)=0.0D0
+ c(k,nres+j)=0.0D0
+ enddo
+
+ do l=1,lmax
+
+!t wi=ran_number(0.0D0,pi)
+! wi=ran_number(0.0D0,pi/6.0D0)
+! wi=0.0D0
+!t tj=ran_number(0.0D0,pi)
+!t pj=ran_number(0.0D0,pi)
+! pj=ran_number(0.0D0,pi/6.0D0)
+! pj=0.0D0
+
+ do p=1,pmax
+!t rij=ran_number(rmin,rmax)
+
+ c(1,j)=d*sin(pj)*cos(tj)
+ c(2,j)=d*sin(pj)*sin(tj)
+ c(3,j)=d*cos(pj)
+
+ c(3,nres+i)=-rij
+
+ c(1,i)=d*sin(wi)
+ c(3,i)=-rij-d*cos(wi)
+
+ do k=1,3
+ dc(k,nres+i)=c(k,nres+i)-c(k,i)
+ dc_norm(k,nres+i)=dc(k,nres+i)/d
+ dc(k,nres+j)=c(k,nres+j)-c(k,j)
+ dc_norm(k,nres+j)=dc(k,nres+j)/d
+ enddo
+
+ call dyn_ssbond_ene(i,j,eij,countss)
+ enddo
+ enddo
+ call exit(1)
+ return
+ end subroutine check_energies
+!-----------------------------------------------------------------------------
+ subroutine dyn_ssbond_ene(resi,resj,eij,countss)
+! 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
+! External functions
+!EL double precision h_base
+!EL external h_base
+
+! Input arguments
+ integer :: resi,resj
+
+! Output arguments
+ real(kind=8) :: eij
+
+! Local variables
+ logical :: havebond
+ integer itypi,itypj,countss
+ real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
+ real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
+ real(kind=8),dimension(3) :: dcosom1,dcosom2
+ real(kind=8) :: ed
+ real(kind=8) :: pom1,pom2
+ real(kind=8) :: ljA,ljB,ljXs
+ real(kind=8),dimension(1:3) :: d_ljB
+ real(kind=8) :: ssA,ssB,ssC,ssXs
+ real(kind=8) :: ssxm,ljxm,ssm,ljm
+ real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
+ real(kind=8) :: f1,f2,h1,h2,hd1,hd2
+ real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
+!-------FIRST METHOD
+ real(kind=8) :: xm
+ real(kind=8),dimension(1:3) :: d_xm
+!-------END FIRST METHOD
+!-------SECOND METHOD
+!$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
+!-------END SECOND METHOD
+
+!-------TESTING CODE
+!el logical :: checkstop,transgrad
+!el common /sschecks/ checkstop,transgrad
+
+ integer :: icheck,nicheck,jcheck,njcheck
+ real(kind=8),dimension(-1:1) :: echeck
+ real(kind=8) :: deps,ssx0,ljx0
+!-------END TESTING CODE
+
+ eij=0.0d0
+ i=resi
+ j=resj
+
+!el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
+!el allocate(dyn_ssbond_ij(0:nres+4,nres))
+
+ 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,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)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ dscj_inv=vbld_inv(j+nres)
+
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
+! The following are set in sc_angular
+! 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
+ rij=1.0D0/rij ! Reset this so it makes sense
+
+ sig0ij=sigma(itypi,itypj)
+ sig=sig0ij*dsqrt(1.0D0/sigsq)
+
+ ljXs=sig-sig0ij
+ ljA=eps1*eps2rt**2*eps3rt**2
+ 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
+ deltat2=1.0d0+om2
+ deltat12=om2-om1+2.0d0
+ cosphi=om12-om1*om2
+ ssA=akcm
+ ssB=akct*deltat12
+ ssC=ss_depth &
+ +akth*(deltat1*deltat1+deltat2*deltat2) &
+ +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
+ ssxm=ssXs-0.5D0*ssB/ssA
+
+!-------TESTING CODE
+!$$$c Some extra output
+!$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
+!$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
+!$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
+!$$$ if (ssx0.gt.0.0d0) then
+!$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
+!$$$ else
+!$$$ ssx0=ssxm
+!$$$ endif
+!$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+!$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
+!$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
+!$$$ return
+!-------END TESTING CODE
+
+!-------TESTING CODE
+! Stop and plot energy and derivative as a function of distance
+ if (checkstop) then
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ if (ssm.lt.ljm .and. &
+ dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
+ nicheck=1000
+ njcheck=1
+ deps=0.5d-7
+ else
+ checkstop=.false.
+ endif
+ endif
+ if (.not.checkstop) then
+ nicheck=0
+ njcheck=-1
+ endif
+
+ do icheck=0,nicheck
+ do jcheck=-1,njcheck
+ if (checkstop) rij=(ssxm-1.0d0)+ &
+ ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
+!-------END TESTING CODE
+
+ if (rij.gt.ljxm) then
+ havebond=.false.
+ ljd=rij-ljXs
+ fac=(1.0D0/ljd)**expon
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ eij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=eij*eps3rt
+ eps3der=eij*eps2rt
+ eij=eij*eps2rt*eps3rt
+
+ sigder=-sig/sigsq
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ ed=-expon*(e1+eij)/ljd
+ sigder=ed*sigder
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
+ eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12
+ else if (rij.lt.ssxm) then
+ havebond=.true.
+ ssd=rij-ssXs
+ eij=ssA*ssd*ssd+ssB*ssd+ssC
+
+ ed=2*akcm*ssd+akct*deltat12
+ pom1=akct*ssd
+ pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
+ eom1=-2*akth*deltat1-pom1-om2*pom2
+ eom2= 2*akth*deltat2+pom1-om1*pom2
+ eom12=pom2
+ else
+ omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
+
+ d_ssxm(1)=0.5D0*akct/ssA
+ d_ssxm(2)=-d_ssxm(1)
+ d_ssxm(3)=0.0D0
+
+ d_ljxm(1)=sig0ij/sqrt(sigsq**3)
+ d_ljxm(2)=d_ljxm(1)*sigsq_om2
+ d_ljxm(3)=d_ljxm(1)*sigsq_om12
+ d_ljxm(1)=d_ljxm(1)*sigsq_om1
+
+!-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
+ xm=0.5d0*(ssxm+ljxm)
+ do k=1,3
+ d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
+ enddo
+ if (rij.lt.xm) then
+ havebond=.true.
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ d_ssm(1)=0.5D0*akct*ssB/ssA
+ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+ d_ssm(3)=omega
+ f1=(rij-xm)/(ssxm-xm)
+ f2=(rij-ssxm)/(xm-ssxm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=ssm*h1+Ht*h2
+ delta_inv=1.0d0/(xm-ssxm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=ssm*hd1-Ht*hd2
+ fac1=deltasq_inv*fac*(xm-rij)
+ fac2=deltasq_inv*fac*(rij-ssxm)
+ ed=delta_inv*(Ht*hd2-ssm*hd1)
+ eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
+ eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
+ eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
+ else
+ havebond=.false.
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
+ d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
+ d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
+ alf12/eps3rt)
+ d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
+ f1=(rij-ljxm)/(xm-ljxm)
+ f2=(rij-xm)/(ljxm-xm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=Ht*h1+ljm*h2
+ delta_inv=1.0d0/(ljxm-xm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=Ht*hd1-ljm*hd2
+ fac1=deltasq_inv*fac*(ljxm-rij)
+ fac2=deltasq_inv*fac*(rij-xm)
+ ed=delta_inv*(ljm*hd2-Ht*hd1)
+ eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
+ eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
+ eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
+ endif
+!-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
+
+!-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
+!$$$ ssd=rij-ssXs
+!$$$ ljd=rij-ljXs
+!$$$ fac1=rij-ljxm
+!$$$ fac2=rij-ssxm
+!$$$
+!$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
+!$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
+!$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
+!$$$
+!$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
+!$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
+!$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+!$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+!$$$ d_ssm(3)=omega
+!$$$
+!$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
+!$$$ do k=1,3
+!$$$ d_ljm(k)=ljm*d_ljB(k)
+!$$$ enddo
+!$$$ ljm=ljm*ljB
+!$$$
+!$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
+!$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
+!$$$ d_ss(2)=akct*ssd
+!$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
+!$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
+!$$$ d_ss(3)=omega
+!$$$
+!$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
+!$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
+!$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
+!$$$ do k=1,3
+!$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
+!$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
+!$$$ enddo
+!$$$ ljf=ljm+ljf*ljB*fac1*fac1
+!$$$
+!$$$ f1=(rij-ljxm)/(ssxm-ljxm)
+!$$$ f2=(rij-ssxm)/(ljxm-ssxm)
+!$$$ h1=h_base(f1,hd1)
+!$$$ h2=h_base(f2,hd2)
+!$$$ eij=ss*h1+ljf*h2
+!$$$ delta_inv=1.0d0/(ljxm-ssxm)
+!$$$ deltasq_inv=delta_inv*delta_inv
+!$$$ fac=ljf*hd2-ss*hd1
+!$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
+!$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
+!$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
+!$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
+!$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
+!$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
+!$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
+!$$$
+!$$$ havebond=.false.
+!$$$ if (ed.gt.0.0d0) havebond=.true.
+!-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
+
+ endif
+
+ if (havebond) then
+!#ifndef CLUST
+!#ifndef WHAM
+! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
+! write(iout,'(a15,f12.2,f8.1,2i5)')
+! & "SSBOND_E_FORM",totT,t_bath,i,j
+! endif
+!#endif
+!#endif
+ dyn_ssbond_ij(countss)=eij
+ else if (.not.havebond .and. dyn_ssbond_ij(countss).lt.1.0d300) then
+ dyn_ssbond_ij(countss)=1.0d300
+!#ifndef CLUST
+!#ifndef WHAM
+! write(iout,'(a15,f12.2,f8.1,2i5)')
+! & "SSBOND_E_BREAK",totT,t_bath,i,j
+!#endif
+!#endif
+ endif
+
+!-------TESTING CODE
+!el if (checkstop) then
+ if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
+ "CHECKSTOP",rij,eij,ed
+ echeck(jcheck)=eij
+!el endif
+ enddo
+ if (checkstop) then
+ write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
+ endif
+ enddo
+ if (checkstop) then
+ transgrad=.true.
+ checkstop=.false.
+ endif
+!-------END TESTING CODE
+
+ do k=1,3
+ dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
+ dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
+ enddo
+ do k=1,3
+ gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ enddo
+ do k=1,3
+ gvdwx(k,i)=gvdwx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)=gvdwx(k,j)+gg(k) &
+ +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ enddo
+!grad do k=i,j-1
+!grad do l=1,3
+!grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
+!grad enddo
+!grad enddo
+
+ do l=1,3
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ enddo
+
+ 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)
+ call to_box(xi,yi,zi)
+ itypj=itype(j,1)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ 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)
+ call to_box(xk,yk,zk)
+ 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]
+! It should NOT be called outside range [0,1], it will not work there.
+ implicit none
+
+! Input arguments
+ real(kind=8) :: x
+
+! Output arguments
+ real(kind=8) :: deriv
+
+! Local variables
+ real(kind=8) :: xsq
+
+
+! Two parabolas put together. First derivative zero at extrema
+!$$$ if (x.lt.0.5D0) then
+!$$$ h_base=2.0D0*x*x
+!$$$ deriv=4.0D0*x
+!$$$ else
+!$$$ deriv=1.0D0-x
+!$$$ h_base=1.0D0-2.0D0*deriv*deriv
+!$$$ deriv=4.0D0*deriv
+!$$$ endif
+
+! Third degree polynomial. First derivative zero at extrema
+ h_base=x*x*(3.0d0-2.0d0*x)
+ deriv=6.0d0*x*(1.0d0-x)
+
+! Fifth degree polynomial. First and second derivatives zero at extrema
+!$$$ xsq=x*x
+!$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
+!$$$ deriv=x-1.0d0
+!$$$ deriv=deriv*deriv
+!$$$ deriv=30.0d0*xsq*deriv
+
+ return
+ end function h_base
+!-----------------------------------------------------------------------------
+ subroutine dyn_set_nss
+! Adjust nss and other relevant variables based on dyn_ssbond_ij
+! implicit none
+ use MD_data, only: totT,t_bath
+! Includes
+! include 'DIMENSIONS'
+#ifdef MPI
+ include "mpif.h"
+#endif
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.CHAIN'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.SETUP'
+! include 'COMMON.MD'
+! Local variables
+ real(kind=8) :: emin
+ integer :: i,j,imin,ierr,k
+ integer :: diff,allnss,newnss
+ integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+ newihpb,newjhpb,aliass
+ logical :: found
+ integer,dimension(0:nfgtasks) :: i_newnss
+ integer,dimension(0:nfgtasks) :: displ
+ integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+ integer :: g_newnss
+
+ allnss=0
+ k=0
+ do i=1,nres-1
+ do j=i+1,nres
+ if ((itype(i,1).eq.1).and.(itype(j,1).eq.1)) then
+ k=k+1
+ if (dyn_ssbond_ij(k).lt.1.0d300) then
+ allnss=allnss+1
+ allflag(allnss)=0
+ allihpb(allnss)=i
+ alljhpb(allnss)=j
+ aliass(allnss)=k
+ endif
+ endif
+ enddo
+ enddo
+
+!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+
+ 1 emin=1.0d300
+ do i=1,allnss
+ if (allflag(i).eq.0 .and. &
+ dyn_ssbond_ij(aliass(allnss)).lt.emin) then
+ emin=dyn_ssbond_ij(aliass(allnss))
+ imin=i
+ endif
+ enddo
+ if (emin.lt.1.0d300) then
+ allflag(imin)=1
+ do i=1,allnss
+ if (allflag(i).eq.0 .and. &
+ (allihpb(i).eq.allihpb(imin) .or. &
+ alljhpb(i).eq.allihpb(imin) .or. &
+ allihpb(i).eq.alljhpb(imin) .or. &
+ alljhpb(i).eq.alljhpb(imin))) then
+ allflag(i)=-1
+ endif
+ enddo
+ goto 1
+ endif
+
+!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+
+ newnss=0
+ do i=1,allnss
+ if (allflag(i).eq.1) then
+ newnss=newnss+1
+ newihpb(newnss)=allihpb(i)
+ newjhpb(newnss)=alljhpb(i)
+ endif
+ enddo
+
+#ifdef MPI
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(newnss,g_newnss,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Gather(newnss,1,MPI_INTEGER,&
+ i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_newnss(i-1)+displ(i-1)
+ enddo
+ call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
+ g_newihpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
+ g_newjhpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ if(fg_rank.eq.0) then
+! print *,'g_newnss',g_newnss
+! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
+! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
+ newnss=g_newnss
+ do i=1,newnss
+ newihpb(i)=g_newihpb(i)
+ newjhpb(i)=g_newjhpb(i)
+ enddo
+ endif
+ endif
+#endif
+
+ 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
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
+! write(iout,*) "found",found,i,j
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
+#endif
+ enddo
+
+ 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
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
+! write(iout,*) "found",found,i,j
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
+#endif
+ enddo
+!#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
+ nss=newnss
+ do i=1,nss
+ idssb(i)=newihpb(i)
+ jdssb(i)=newjhpb(i)
+ enddo
+!#else
+! nss=0
+!#endif
+
+ return
+ end subroutine dyn_set_nss
+! 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
+
+ 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
+
+ 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)
+ use MD_data, only:totTafm
+ real(kind=8),dimension(3) :: vectube,cm
+
+ 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,tubezcenter,xi,yi,zi!,&
+! vecsim,vectrue
+ real(kind=8) :: eps,sig,aa_tub_lip,bb_tub_lip
+ integer:: i,j,iti,r,ilol,ityp
+! totTafm=2.0
+ Etube=0.0d0
+ call to_box(tubecenter(1),tubecenter(2),tubecenter(3))
+! 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
+
+! do j=-1,1
+ xi=(c(1,i)+c(1,i+1))/2.0d0
+ yi=(c(2,i)+c(2,i+1))/2.0d0
+ zi=((c(3,i)+c(3,i+1))/2.0d0)
+ call to_box(xi,yi,zi)
+! tubezcenter=totTafm*velNANOconst+tubecenter(3)
+
+ vectube(1)=boxshift(xi-tubecenter(1),boxxsize)
+ vectube(2)=boxshift(yi-tubecenter(2),boxysize)
+ vectube(3)=boxshift(zi-tubecenter(3),boxzsize)
+
+!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,*),"ETUBE_PEP",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
+ xi=c(1,i+nres)
+ yi=c(2,i+nres)
+ zi=c(3,i+nres)
+ call to_box(xi,yi,zi)
+ tubezcenter=totTafm*velNANOconst+tubecenter(3)
+
+ vectube(1)=boxshift(xi-tubecenter(1),boxxsize)
+ vectube(2)=boxshift(yi-tubecenter(2),boxysize)
+ vectube(3)=boxshift(zi-tubecenter(3),boxzsize)
+
+
+!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,*),"ETUBE",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=ilipbond_start_tub,ilipbond_end_tub
+ ityp=itype(i,4)
+! print *,"ilipbond_start",ilipbond_start,i,ityp
+ if (ityp.gt.ntyp_molec(4)) cycle
+!C now calculate distance from center of tube and direction vectors
+ eps=lip_sig(ityp,18)*4.0d0
+ sig=lip_sig(ityp,18)
+ aa_tub_lip=eps/(sig**12)
+ bb_tub_lip=eps/(sig**6)
+! do j=-1,1
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
+ call to_box(xi,yi,zi)
+! tubezcenter=totTafm*velNANOconst+tubecenter(3)
+
+ vectube(1)=boxshift(xi-tubecenter(1),boxxsize)
+ vectube(2)=boxshift(yi-tubecenter(2),boxysize)
+ vectube(3)=boxshift(zi-tubecenter(3),boxzsize)
+
+!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)=aa_tub_lip/rdiff6**2.0d0+bb_tub_lip/rdiff6
+ Etube=Etube+enetube(i)
+!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*aa_tub_lip/rdiff6- &
+ 6.0d0*bb_tub_lip)/rdiff6/rdiff
+ do j=1,3
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ if (energy_dec) write(iout,*) "ETUBLIP",i,rdiff,enetube(i+nres)
+ enddo
+
+
+!-----------------------------------------------------------------------
+ if (fg_rank.eq.0) then
+ if (velNANOconst.ne.0) then
+ do j=1,3
+ cm(j)=0.0d0
+ enddo
+ do i=1,inanomove
+ ilol=inanotab(i)
+ do j=1,3
+ cm(j)=cm(j)+c(j,ilol)
+ enddo
+ enddo
+ do j=1,3
+ cm(j)=cm(j)/inanomove
+ enddo
+ vecsim=velNANOconst*totTafm+distnanoinit
+ vectrue=cm(3)-tubecenter(3)
+ etube=etube+0.5d0*forcenanoconst*( vectrue-vecsim)**2
+ fac=forcenanoconst*(vectrue-vecsim)/inanomove
+ do i=1,inanomove
+ ilol=inanotab(i)
+ gg_tube(3,ilol-1)=gg_tube(3,ilol-1)+fac
+ enddo
+ endif
+ endif
+! 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
+ ishield_list(i)=0
+ do j=1,3
+ grad_shield(j,i)=0.0d0
+ enddo
+ enddo
+ do i=ivec_start,ivec_end
+!C do i=1,nres-1
+!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,cbeg,cend
+ real(kind=8) :: afmdist,Eafmforce
+ integer :: i,j
+!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
+ cbeg=0.0d0
+ cend=0.0d0
+ if (afmbeg.eq.-1) then
+ do i=1,nbegafmmat
+ do j=1,3
+ cbeg(j)=cbeg(j)+c(j,afmbegcentr(i))/nbegafmmat
+ enddo
+ enddo
+ else
+ do j=1,3
+ cbeg(j)=c(j,afmend)
+ enddo
+ endif
+ if (afmend.eq.-1) then
+ do i=1,nendafmmat
+ do j=1,3
+ cend(j)=cend(j)+c(j,afmendcentr(i))/nendafmmat
+ enddo
+ enddo
+ else
+ cend(j)=c(j,afmend)
+ endif
+
+ do i=1,3
+ diffafm(i)=cend(i)-cbeg(i)
+ 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)
+ if (afmend.eq.-1) then
+ do i=1,nendafmmat
+ do j=1,3
+ gradafm(j,afmendcentr(i)-1)=-forceAFMconst* &
+ (distafminit+totTafm*velAFMconst-afmdist) &
+ *diffafm(j)/afmdist/nendafmmat
+ enddo
+ enddo
+ else
+ do i=1,3
+ gradafm(i,afmend-1)=-forceAFMconst* &
+ (distafminit+totTafm*velAFMconst-afmdist) &
+ *diffafm(i)/afmdist
+ enddo
+ endif
+ if (afmbeg.eq.-1) then
+ do i=1,nbegafmmat
+ do j=1,3
+ gradafm(i,afmbegcentr(i)-1)=forceAFMconst* &
+ (distafminit+totTafm*velAFMconst-afmdist) &
+ *diffafm(i)/afmdist
+ enddo
+ enddo
+ else
+ do i=1,3
+ gradafm(i,afmbeg-1)=forceAFMconst* &
+ (distafminit+totTafm*velAFMconst-afmdist) &
+ *diffafm(i)/afmdist
+ enddo
+ endif
+! 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=10*nres
+ elseif(nres.lt.200) then
+ maxconts=10*nres ! Max. number of contacts per residue
+ else
+ maxconts=10*nres ! (maxconts=maxres/4)
+ endif
+ maxcont=100*nres ! Max. number of SC contacts
+ maxvar=6*nres ! Max. number of variables
+!el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
+ maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
+!----------------------
+! arrays in subroutine init_int_table
+!el#ifdef MPI
+!el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
+!el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
+!el#endif
+ allocate(nint_gr(nres))
+ allocate(nscp_gr(nres))
+ allocate(ielstart(nres))
+ allocate(ielend(nres))
+!(maxres)
+ allocate(istart(nres,maxint_gr))
+ allocate(iend(nres,maxint_gr))
+!(maxres,maxint_gr)
+ allocate(iscpstart(nres,maxint_gr))
+ allocate(iscpend(nres,maxint_gr))
+!(maxres,maxint_gr)
+ 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)
+!----------------------
+! commom.contacts
+! common /contacts/
+ if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
+ allocate(icont(2,maxcont))
+!(2,maxcont)
+! common /contacts1/
+ allocate(num_cont(0:nres+4))
+!(maxres)
+#ifndef NEWCORR
+ allocate(jcont(maxconts,nres))
+!(maxconts,maxres)
+ allocate(facont(maxconts,nres))
+!(maxconts,maxres)
+ allocate(gacont(3,maxconts,nres))
+!(3,maxconts,maxres)
+! common /contacts_hb/
+ allocate(gacontp_hb1(3,maxconts,nres))
+ allocate(gacontp_hb2(3,maxconts,nres))
+ allocate(gacontp_hb3(3,maxconts,nres))
+ allocate(gacontm_hb1(3,maxconts,nres))
+ allocate(gacontm_hb2(3,maxconts,nres))
+ allocate(gacontm_hb3(3,maxconts,nres))
+ allocate(gacont_hbr(3,maxconts,nres))
+ 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)
+!(maxres)
+ allocate(jcont_hb(maxconts,nres))
+#endif
+ allocate(num_cont_hb(nres))
+!(maxconts,maxres)
+! common /rotat/
+ allocate(Ug(2,2,nres))
+ allocate(Ugder(2,2,nres))
+ allocate(Ug2(2,2,nres))
+ allocate(Ug2der(2,2,nres))
+!(2,2,maxres)
+ allocate(obrot(2,nres))
+ allocate(obrot2(2,nres))
+ allocate(obrot_der(2,nres))
+ allocate(obrot2_der(2,nres))
+!(2,maxres)
+! common /precomp1/
+ allocate(mu(2,nres))
+ allocate(muder(2,nres))
+ allocate(Ub2(2,nres))
+ Ub2(1,:)=0.0d0
+ Ub2(2,:)=0.0d0
+ allocate(Ub2der(2,nres))
+ allocate(Ctobr(2,nres))
+ allocate(Ctobrder(2,nres))
+ allocate(Dtobr2(2,nres))
+ allocate(Dtobr2der(2,nres))
+!(2,maxres)
+ allocate(EUg(2,2,nres))
+ allocate(EUgder(2,2,nres))
+ allocate(CUg(2,2,nres))
+ allocate(CUgder(2,2,nres))
+ allocate(DUg(2,2,nres))
+ allocate(Dugder(2,2,nres))
+ allocate(DtUg2(2,2,nres))
+ allocate(DtUg2der(2,2,nres))
+!(2,2,maxres)
+! common /precomp2/
+ allocate(Ug2Db1t(2,nres))
+ allocate(Ug2Db1tder(2,nres))
+ allocate(CUgb2(2,nres))
+ allocate(CUgb2der(2,nres))
+!(2,maxres)
+ allocate(EUgC(2,2,nres))
+ allocate(EUgCder(2,2,nres))
+ allocate(EUgD(2,2,nres))
+ allocate(EUgDder(2,2,nres))
+ allocate(DtUg2EUg(2,2,nres))
+ allocate(Ug2DtEUg(2,2,nres))
+!(2,2,maxres)
+ allocate(Ug2DtEUgder(2,2,2,nres))
+ allocate(DtUg2EUgder(2,2,2,nres))
+!(2,2,2,maxres)
+ allocate(b1(2,nres)) !(2,-maxtor:maxtor)
+ allocate(b2(2,nres)) !(2,-maxtor:maxtor)
+ allocate(b1tilde(2,nres)) !(2,-maxtor:maxtor)
+ allocate(b2tilde(2,nres)) !(2,-maxtor:maxtor)
+
+ allocate(ctilde(2,2,nres))
+ allocate(dtilde(2,2,nres)) !(2,2,-maxtor:maxtor)
+ allocate(gtb1(2,nres))
+ allocate(gtb2(2,nres))
+ allocate(cc(2,2,nres))
+ allocate(dd(2,2,nres))
+ allocate(ee(2,2,nres))
+ allocate(gtcc(2,2,nres))
+ allocate(gtdd(2,2,nres))
+ allocate(gtee(2,2,nres))
+ allocate(gUb2(2,nres))
+ allocate(gteUg(2,2,nres))
+
+! common /rotat_old/
+ allocate(costab(nres))
+ allocate(sintab(nres))
+ allocate(costab2(nres))
+ allocate(sintab2(nres))
+!(maxres)
+! common /dipmat/
+! allocate(a_chuj(2,2,maxconts,nres))
+!(2,2,maxconts,maxres)(maxconts=maxres/4)
+! allocate(a_chuj_der(2,2,3,5,maxconts,nres))
+!(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
+! common /contdistrib/
+ allocate(ncont_sent(nres))
+ allocate(ncont_recv(nres))
+
+ allocate(iat_sent(nres))
+!(maxres)
+#ifndef NEWCORR
+ print *,"before iint_sent allocate"
+ allocate(iint_sent(4,nres,nres))
+ allocate(iint_sent_local(4,nres,nres))
+ print *,"after iint_sent allocate"
+#endif
+!(4,maxres,maxres)
+ allocate(iturn3_sent(4,0:nres+4))
+ allocate(iturn4_sent(4,0:nres+4))
+ allocate(iturn3_sent_local(4,nres))
+ allocate(iturn4_sent_local(4,nres))
+!(4,maxres)
+ allocate(itask_cont_from(0:nfgtasks-1))
+ allocate(itask_cont_to(0:nfgtasks-1))
+!(0:max_fg_procs-1)
+
+
+
+!----------------------
+! commom.deriv;
+! common /derivat/
+#ifdef NEWCORR
+ print *,"before dcdv allocate"
+ allocate(dcdv(6,nres+2))
+ allocate(dxdv(6,nres+2))
+#else
+ print *,"before dcdv allocate"
+ allocate(dcdv(6,maxdim))
+ allocate(dxdv(6,maxdim))
+#endif
+!(6,maxdim)
+ allocate(dxds(6,nres))
+!(6,maxres)
+ allocate(gradx(3,-1:nres,0:2))
+ allocate(gradc(3,-1:nres,0:2))
+!(3,maxres,2)
+ 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(gradpepmart(3,-1:nres))
+ allocate(gradpepmartx(3,-1:nres))
+ allocate(gradcatcat(3,-1:nres))
+ allocate(gradnuclcat(3,-1:nres))
+ allocate(gradnuclcatx(3,-1:nres))
+ allocate(gradlipbond(3,-1:nres))
+ allocate(gradlipang(3,-1:nres))
+ allocate(gradliplj(3,-1:nres))
+ allocate(gradlipelec(3,-1:nres))
+ allocate(gradcattranc(3,-1:nres))
+ allocate(gradcattranx(3,-1:nres))
+ allocate(gradcatangx(3,-1:nres))
+ allocate(gradcatangc(3,-1:nres))
+!(3,maxres)
+ allocate(grad_shield_side(3,maxcontsshi,-1:nres))
+ allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
+! grad for shielding surroing
+ allocate(gloc(0:maxvar,0:2))
+ allocate(gloc_x(0:maxvar,2))
+!(maxvar,2)
+ 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(gel_loc_turn4(maxvar))
+ allocate(gel_loc_turn6(maxvar))
+ allocate(gcorr_loc(maxvar))
+ allocate(g_corr5_loc(maxvar))
+ allocate(g_corr6_loc(maxvar))
+!(maxvar)
+ allocate(gsccorc(3,-1:nres))
+ allocate(gsccorx(3,-1:nres))
+!(3,maxres)
+ allocate(gsccor_loc(-1:nres))
+!(maxres)
+ 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,-1:nres))
+ allocate(gsclocx(3,-1:nres))
+!(3,maxres)
+ 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))
+ allocate(dYY_C1tab(3,nres))
+ allocate(dZZ_C1tab(3,nres))
+ allocate(dXX_Ctab(3,nres))
+ allocate(dYY_Ctab(3,nres))
+ allocate(dZZ_Ctab(3,nres))
+ allocate(dXX_XYZtab(3,nres))
+ allocate(dYY_XYZtab(3,nres))
+ allocate(dZZ_XYZtab(3,nres))
+!(3,maxres)
+! common /mpgrad/
+ allocate(jgrad_start(nres))
+ allocate(jgrad_end(nres))
+!(maxres)
+!----------------------
+
+! common /indices/
+ allocate(ibond_displ(0:nfgtasks-1))
+ allocate(ibond_count(0:nfgtasks-1))
+ allocate(ithet_displ(0:nfgtasks-1))
+ allocate(ithet_count(0:nfgtasks-1))
+ allocate(iphi_displ(0:nfgtasks-1))
+ allocate(iphi_count(0:nfgtasks-1))
+ allocate(iphi1_displ(0:nfgtasks-1))
+ allocate(iphi1_count(0:nfgtasks-1))
+ allocate(ivec_displ(0:nfgtasks-1))
+ allocate(ivec_count(0:nfgtasks-1))
+ allocate(iset_displ(0:nfgtasks-1))
+ allocate(iset_count(0:nfgtasks-1))
+ allocate(iint_count(0:nfgtasks-1))
+ allocate(iint_displ(0:nfgtasks-1))
+!(0:max_fg_procs-1)
+!----------------------
+! common.MD
+! common /mdgrad/
+ allocate(gcart(3,-1:nres))
+ allocate(gxcart(3,-1:nres))
+!(3,0:MAXRES)
+ 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)
+ allocate(dutheta(nres))
+ allocate(dugamma(nres))
+!(maxres)
+ allocate(duscdiff(3,-1:nres))
+ allocate(duscdiffx(3,-1:nres))
+!(3,maxres)
+!el i io:read_fragments
+! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
+! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
+! common /qmeas/
+! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
+! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
+ allocate(mset(0:nprocs)) !(maxprocs/20)
+ mset(:)=0
+! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
+! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
+ allocate(dUdconst(3,0:nres))
+ allocate(dUdxconst(3,0:nres))
+ allocate(dqwol(3,0:nres))
+ allocate(dxqwol(3,0:nres))
+!(3,0:MAXRES)
+!----------------------
+! common.sbridge
+! common /sbridge/ in io_common: read_bridge
+!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
+! common /dyn_ssbond/
+! and side-chain vectors in theta or phi.
+ allocate(dyn_ssbond_ij(10000))
+!(maxres,maxres)
+! do i=1,nres
+! do j=i+1,nres
+ dyn_ssbond_ij(:)=1.0d300
+! enddo
+! enddo
+
+! if (nss.gt.0) then
+ allocate(idssb(maxdim),jdssb(maxdim))
+! allocate(newihpb(nss),newjhpb(nss))
+!(maxdim)
+! endif
+ allocate(ishield_list(-1:nres))
+ allocate(shield_list(maxcontsshi,-1:nres))
+ allocate(dyn_ss_mask(nres))
+ allocate(fac_shield(-1:nres))
+ allocate(enetube(nres*2))
+ allocate(enecavtube(nres*2))
+
+!(maxres)
+ dyn_ss_mask(:)=.false.
+!----------------------
+! common.sccor
+! Parameters of the SCCOR term
+! common/sccor/
+!el in io_conf: parmread
+! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
+! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
+! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
+! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
+! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
+! 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(gloc_sc(3,0:2*nres,0:10))
+!(3,0:maxres2,10)maxres2=2*maxres
+ allocate(dcostau(3,3,3,2*nres))
+ allocate(dsintau(3,3,3,2*nres))
+ allocate(dtauangle(3,3,3,2*nres))
+ allocate(dcosomicron(3,3,3,2*nres))
+ allocate(domicron(3,3,3,2*nres))
+!(3,3,3,maxres2)maxres2=2*maxres
+!----------------------
+! common.var
+! common /restr/
+ allocate(varall(maxvar))
+!(maxvar)(maxvar=6*maxres)
+ allocate(mask_theta(nres))
+ allocate(mask_phi(nres))
+ allocate(mask_side(nres))
+!(maxres)
+!----------------------
+! common.vectors
+! common /vectors/
+ allocate(uy(3,nres))
+ allocate(uz(3,nres))
+!(3,maxres)
+ allocate(uygrad(3,3,2,nres))
+ allocate(uzgrad(3,3,2,nres))
+!(3,3,2,maxres)
+ print *,"before all 300"
+! allocateion of lists JPRDLA
+ allocate(newcontlistppi(300*nres))
+ allocate(newcontlistscpi(350*nres))
+ allocate(newcontlisti(300*nres))
+ allocate(newcontlistppj(300*nres))
+ allocate(newcontlistscpj(350*nres))
+ allocate(newcontlistj(300*nres))
+ allocate(newcontlistmartpi(300*nres))
+ allocate(newcontlistmartpj(300*nres))
+ allocate(newcontlistmartsci(300*nres))
+ allocate(newcontlistmartscj(300*nres))
+
+ allocate(newcontlistcatsctrani(300*nres))
+ allocate(newcontlistcatsctranj(300*nres))
+ allocate(newcontlistcatptrani(300*nres))
+ allocate(newcontlistcatptranj(300*nres))
+ allocate(newcontlistcatscnormi(300*nres))
+ allocate(newcontlistcatscnormj(300*nres))
+ allocate(newcontlistcatpnormi(300*nres))
+ allocate(newcontlistcatpnormj(300*nres))
+ allocate(newcontlistcatcatnormi(900*nres))
+ allocate(newcontlistcatcatnormj(900*nres))
+
+ allocate(newcontlistcatscangi(300*nres))
+ allocate(newcontlistcatscangj(300*nres))
+ allocate(newcontlistcatscangfi(300*nres))
+ allocate(newcontlistcatscangfj(300*nres))
+ allocate(newcontlistcatscangfk(300*nres))
+ allocate(newcontlistcatscangti(300*nres))
+ allocate(newcontlistcatscangtj(300*nres))
+ allocate(newcontlistcatscangtk(300*nres))
+ allocate(newcontlistcatscangtl(300*nres))
+
+
+ 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)&
+ .and.itype(i,2).eq.ntyp1_molec(2)) cycle
+ if (itype(i-1,2).eq.ntyp1_molec(2)&
+ .or. itype(i,2).eq.ntyp1_molec(2)) 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) &
+!C *dc(j,i-1)/vbld(i)
+!C enddo
+!C if (energy_dec) write(iout,*) &
+!C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
+ diff = vbld(i)-vbldpDUM
+ else
+ diff = vbld(i)-vbldp0_nucl
endif
-! write (iout,*),"Processor",myrank," BROADCAST weights"
- call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST c"
- call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST dc"
- call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
- call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST theta"
- call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST phi"
- call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST alph"
- call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST omeg"
- call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
-! write (iout,*) "Processor",myrank," BROADCAST vbld"
- call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
- king,FG_COMM,IERR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
-! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
- endif
-! write (iout,*) 'Processor',myrank,
-! & ' calling etotal_short ipot=',ipot
-! call flush(iout)
-! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
-#endif
-! call int_from_cart1(.false.)
-!
-! Compute the side-chain and electrostatic interaction energy
-!
- goto (101,102,103,104,105,106) ipot
-! Lennard-Jones potential.
- 101 call elj_short(evdw)
-!d print '(a)','Exit ELJ'
- goto 107
-! Lennard-Jones-Kihara potential (shifted).
- 102 call eljk_short(evdw)
- goto 107
-! Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp_short(evdw)
- goto 107
-! Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb_short(evdw)
- goto 107
-! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv_short(evdw)
- goto 107
-! Soft-sphere potential - already dealt with in the long-range part
- 106 evdw=0.0d0
-! 106 call e_softsphere_short(evdw)
-!
-! Calculate electrostatic (H-bonding) energy of the main chain.
-!
- 107 continue
-!
-! Calculate the short-range part of Evdwpp
-!
- call evdwpp_short(evdw1)
-!
-! Calculate the short-range part of ESCp
-!
- if (ipot.lt.6) then
- call escp_short(evdw2,evdw2_14)
- endif
-!
-! Calculate the bond-stretching energy
-!
- call ebond(estr)
-!
-! Calculate the disulfide-bridge and other energy and the contributions
-! from other distance constraints.
- call edis(ehpb)
-!
-! Calculate the virtual-bond-angle energy.
-!
- call ebend(ebe,ethetacnstr)
-!
-! Calculate the SC local energy.
-!
- call vec_and_deriv
- call esc(escloc)
-!
-! Calculate the virtual-bond torsional energy.
-!
- call etor(etors,edihcnstr)
-!
-! 6/23/01 Calculate double-torsional energy
-!
- call etor_d(etors_d)
-!
-! 21/5/07 Calculate local sicdechain correlation energy
-!
- if (wsccor.gt.0.0d0) then
- call eback_sc_corr(esccor)
- else
- esccor=0.0d0
+! 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)
+
+ 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
-!
-! Put energy components into an array
-!
- do i=1,n_ene
- energia(i)=0.0d0
enddo
- energia(1)=evdw
-#ifdef SCP14
- energia(2)=evdw2-evdw2_14
- energia(18)=evdw2_14
+!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
- energia(2)=evdw2
- energia(18)=0.0d0
+ phii=phi(i)
#endif
-#ifdef SPLITELE
- energia(16)=evdw1
+ 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
- energia(3)=evdw1
+ phii1=phi(i+1)
#endif
- energia(11)=ebe
- energia(12)=escloc
- energia(13)=etors
- energia(14)=etors_d
- energia(15)=ehpb
- energia(17)=estr
- energia(19)=edihcnstr
- energia(21)=esccor
-! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
- call flush(iout)
- call sum_energy(energia,.true.)
-! write (iout,*) "Exit ETOTAL_SHORT"
- call flush(iout)
+ 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(kind=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,bbbi,sslipi,ssgradlipi, &
+ sslipj,ssgradlipj,faclipij2
+ real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
+ dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
+ dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
+ 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
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+
+ do j=ielstart_nucl(i),ielend_nucl(i)
+ if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
+ ind=ind+1
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+! xj=c(1,j)+0.5D0*dxj-xmedi
+! yj=c(2,j)+0.5D0*dyj-ymedi
+! zj=c(3,j)+0.5D0*dzj-zmedi
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ rij=xj*xj+yj*yj+zj*zj
+!c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
+ fac=(r0pp**2/rij)**3
+ ev1=epspp*fac*fac
+ ev2=epspp*fac
+ evdw1ij=ev1-2*ev2
+ fac=(-ev1-evdw1ij)/rij
+! 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))
+ call to_box(xi,yi,zi)
+
+ do iint=1,nscp_gr_nucl(i)
+
+ do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
+ itypj=itype(j,2)
+ if (itypj.eq.ntyp1_molec(2)) cycle
+!C Uncomment following three lines for SC-p interactions
+!c xj=c(1,nres+j)-xi
+!c yj=c(2,nres+j)-yi
+!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)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=xj**2+yj**2+zj**2
+
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ fac=rrij**expon2
+ e1=fac*fac*aad_nucl(itypj)
+ e2=fac*bad_nucl(itypj)
+ if (iabs(j-i) .le. 2) then
+ e1=scal14*e1
+ e2=scal14*e2
+ endif
+ evdwij=e1+e2
+ evdwpsb=evdwpsb+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
+ 'evdw2',i,j,evdwij,"tu4"
+!C
+!C Calculate contributions to the gradient in the virtual-bond and SC vectors.
+!C
+ fac=-(evdwij+e1)*rrij
+ ggg(1)=xj*fac
+ ggg(2)=yj*fac
+ ggg(3)=zj*fac
+ do k=1,3
+ gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
+ gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
+ enddo
+ 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)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+!C
+!C Calculate SC interaction energy.
+!C
+ do iint=1,nint_gr_nucl(i)
+! 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)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+!C Calculate angle-dependent terms of energy and contributions to their
+!C derivatives.
+ erij(1)=xj*rij
+ erij(2)=yj*rij
+ erij(3)=zj*rij
+ om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
+ om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
+ om12=dxi*dxj+dyi*dyj+dzi*dzj
+ call sc_angular_nucl
+ sigsq=1.0D0/sigsq
+ sig=sig0ij*dsqrt(sigsq)
+ rij_shift=1.0D0/rij-sig+sig0ij
+! 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 etotal_short
-!-----------------------------------------------------------------------------
-! gnmr1.f
-!-----------------------------------------------------------------------------
- real(kind=8) function gnmr1(y,ymin,ymax)
-! implicit none
- real(kind=8) :: y,ymin,ymax
- real(kind=8) :: wykl=4.0d0
- if (y.lt.ymin) then
- gnmr1=(ymin-y)**wykl/wykl
- else if (y.gt.ymax) then
- gnmr1=(y-ymax)**wykl/wykl
+ 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
- gnmr1=0.0d0
+ cosa=om12
+ cosb=om1
+ cosg=om2
endif
- return
- end function gnmr1
-!-----------------------------------------------------------------------------
- real(kind=8) function gnmr1prim(y,ymin,ymax)
-! implicit none
- real(kind=8) :: y,ymin,ymax
- real(kind=8) :: wykl=4.0d0
- if (y.lt.ymin) then
- gnmr1prim=-(ymin-y)**(wykl-1)
- else if (y.gt.ymax) then
- gnmr1prim=(y-ymax)**(wykl-1)
- else
- gnmr1prim=0.0d0
+ 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
- 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
+
+!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.maxcont) THEN
+!C
+!C Calculate the contact function. The ith column of the array JCONT will
+!C contain the numbers of atoms that make contacts with the atom I (of numbers
+!C greater than I). The arrays FACONT and GACONT will contain the values of
+!C the contact function and its derivative.
+ r0ij=2.20D0*sigma_nucl(itypi,itypj)
+!c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
+ call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
+!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.',maxconts
+ else
+ jcont_hb(num_conti,i)=j
+!c write (iout,*) "num_conti",num_conti,
+!c & " jcont_hb",jcont_hb(num_conti,i)
+!C Calculate contact energies
+ cosa4=4.0D0*cosa
+ wij=cosa-3.0D0*cosb*cosg
+ cosbg1=cosb+cosg
+ cosbg2=cosb-cosg
+ fac3=dsqrt(-ael6i)*r3ij
+!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 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
+ 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 function rlornmr1prim
+ 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
- real(kind=8) function harmonic(y,ymax)
-! implicit none
- real(kind=8) :: y,ymax
- real(kind=8) :: wykl=2.0d0
- harmonic=(y-ymax)**wykl
+ 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 function harmonic
-!-----------------------------------------------------------------------------
- real(kind=8) function harmonicprim(y,ymax)
- real(kind=8) :: y,ymin,ymax
- real(kind=8) :: wykl=2.0d0
- harmonicprim=(y-ymax)*wykl
+ 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 harmonicprim
-!-----------------------------------------------------------------------------
-! gradient_p.F
+ end function enesc_nucl
!-----------------------------------------------------------------------------
- subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
-
- use io_base, only:intout,briefout
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.VAR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MD'
-! include 'COMMON.IOUNITS'
- real(kind=8),external :: ufparm
- integer :: uiparm(1)
- real(kind=8) :: urparm(1)
- real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
- real(kind=8) :: f,gthetai,gphii,galphai,gomegai
- integer :: n,nf,ind,ind1,i,k,j
-!
-! This subroutine calculates total internal coordinate gradient.
-! Depending on the number of function evaluations, either whole energy
-! is evaluated beforehand, Cartesian coordinates and their derivatives in
-! internal coordinates are reevaluated or only the cartesian-in-internal
-! coordinate derivatives are evaluated. The subroutine was designed to work
-! with SUMSL.
-!
-!
- icg=mod(nf,2)+1
+ 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))
-!d print *,'grad',nf,icg
- if (nf-nfl+1) 20,30,40
- 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
-! write (iout,*) 'grad 20'
- if (nf.eq.0) return
- goto 40
- 30 call var_to_geom(n,x)
- call chainbuild
-! write (iout,*) 'grad 30'
-!
-! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-!
- 40 call cartder
-! write (iout,*) 'grad 40'
-! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
-!
-! Convert the Cartesian gradient into internal-coordinate gradient.
-!
- ind=0
- ind1=0
- do i=1,nres-2
- 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
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- enddo
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- enddo
- enddo
- do j=i+1,nres-1
- ind1=ind1+1
-! 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)
- enddo
- enddo
- if (i.gt.1) g(i-1)=gphii
- if (n.gt.nphi) g(nphi+i)=gthetai
+ 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
- if (n.le.nphi+ntheta) goto 10
- do i=2,nres-1
- 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)
- enddo
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ialph(i,1))=galphai
- g(ialph(i,1)+nside)=gomegai
- endif
+ 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
-!
-! Add the components corresponding to local energy terms.
-!
+ enddo
+ mm=mod(fg_rank,2)
+!c write (*,*) 'MyRank',MyRank,' mm',mm
+ if (mm) 20,20,10
10 continue
- do i=1,nvar
-!d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
- g(i)=g(i)+gloc(i,icg)
+!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
-! Uncomment following three lines for diagnostics.
-!d call intout
-!elwrite(iout,*) "in gradient after calling intout"
-!d call briefout(0,0.0d0)
-!d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
+!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 gradient
-!-----------------------------------------------------------------------------
- subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
-
- use comm_chu
-! implicit real*8 (a-h,o-z)
+ end subroutine multibody_hb_nucl
+!-----------------------------------------------------------
+ real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.DERIV'
! include 'COMMON.IOUNITS'
-! include 'COMMON.GEO'
- integer :: n,nf
-!el integer :: jjj
-!el common /chuju/ jjj
- real(kind=8) :: energia(0:n_ene)
- integer :: uiparm(1)
- 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)
-! if (jjj.gt.0) then
-! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
-! endif
- nfl=nf
- icg=mod(nf,2)+1
-!d print *,'func',nf,nfl,icg
- call var_to_geom(n,x)
- call zerograd
- call chainbuild
-!d write (iout,*) 'ETOTAL called from FUNC'
- call etotal(energia)
- call sum_gradient
- f=energia(0)
-! if (jjj.gt.0) then
-! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
-! write (iout,*) 'f=',etot
-! jjj=0
-! endif
+! 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 subroutine func
-!-----------------------------------------------------------------------------
- subroutine cartgrad
-! implicit real*8 (a-h,o-z)
+ end function ehbcorr_nucl
+!-------------------------------------------------------------------------
+
+ real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
- use energy_data
- use MD_data, only: totT,usampl,eq_time
-#ifdef MPI
- include 'mpif.h'
-#endif
-! include 'COMMON.CHAIN'
+! include 'COMMON.IOUNITS'
! include 'COMMON.DERIV'
-! include 'COMMON.VAR'
! include 'COMMON.INTERACT'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MD'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.TIME1'
-!
- integer :: i,j
+! 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
-! This subrouting calculates total Cartesian coordinate gradient.
-! The subroutine chainbuild_cart and energy MUST be called beforehand.
-!
-!#define DEBUG
-#ifdef TIMING
- time00=MPI_Wtime()
-#endif
- icg=1
- call sum_gradient
-#ifdef TIMING
-#endif
-!#define DEBUG
-!el write (iout,*) "After sum_gradient"
-#ifdef DEBUG
-!el write (iout,*) "After sum_gradient"
- do i=1,nres-1
- write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
- write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
+ 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
-#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
- do j=1,3
- gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
- gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
- enddo
- enddo
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+dugamma(i)
- enddo
- do i=1,nres-2
- gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
- enddo
- endif
-!elwrite (iout,*) "After sum_gradient"
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call intcartderiv
-!elwrite (iout,*) "After sum_gradient"
-#ifdef TIMING
- time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
-#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=0,nct
+ 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
- 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),&
- (gxcart(j,i),j=1,3),gloc(i,icg)
+ 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)
+ use MD_data, only: t_bath
+ integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj,irdiff,&
+ ii
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
+ r7,r4,ecationcation,k0,rcal,aa,bb,sslipi,ssgradlipi,sslipj,ssgradlipj
+ real(kind=8) :: xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
+ real(kind=8) :: awat,bwat,cwat,dwat,sss2min2,sss2mingrad2,rdiff,ewater
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r
+
+ ecationcation=0.0d0
+ if (nres_molec(5).le.1) 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",g_listcatcatnorm_start, g_listcatcatnorm_end
+! do i=itmp+1,itmp+nres_molec(5)-1
+ do ii=g_listcatcatnorm_start, g_listcatcatnorm_end
+ i=newcontlistcatcatnormi(ii)
+ j=newcontlistcatcatnormj(ii)
+
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
+! write (iout,*) i,"TUTUT",c(1,i)
+ itypi=itype(i,5)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+! do j=i+1,itmp+nres_molec(5)
+ itypj=itype(j,5)
+! print *,i,j,itypi,itypj
+ k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
+! print *,i,j,'catcat'
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ rcal =xj**2+yj**2+zj**2
+ ract=sqrt(rcal)
+ if ((itypi.gt.1).or.(itypj.gt.1)) then
+ if (sss2min2.eq.0.0d0) cycle
+ sss2min2=sscale2(ract,12.0d0,1.0d0)
+ sss2mingrad2=sscagrad2(ract,12.0d0,1.0d0)
+! 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
-#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)
+ do k=1,3
+ gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
+ gradcatcat(k,i)=gradcatcat(k,i)-(gg(k)*sss2min2+(Evan1cat+Evan2cat+Eeleccat)*sss2mingrad2)
+ gradcatcat(k,j)=gradcatcat(k,j)+gg(k)*sss2min2+(Evan1cat+Evan2cat+Eeleccat)*sss2mingrad2
+ enddo
+ if (energy_dec) write (iout,*) "ecatcat",i,j,Evan1cat,Evan2cat,Eeleccat,&
+ r012,rcal**6,ichargecat(itypi)*ichargecat(itypj)
+! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
+ ecationcation=ecationcation+(Evan1cat+Evan2cat+Eeleccat)*sss2min2
+ else !this is water part and other non standard molecules
+
+ sss2min2=sscale2(ract,10.0d0,1.0d0)! cutoff for water interaction is 15A
+ if (sss2min2.eq.0.0d0) cycle
+ sss2mingrad2=sscagrad2(ract,10.0d0,1.0d0)
+ irdiff=int((ract-2.06d0)*50.0d0)+1
+
+ rdiff=ract-((irdiff-1)*0.02d0+2.06d0)
+ if (irdiff.le.0) then
+ irdiff=0
+ rdiff=ract
+ endif
+! print *,rdiff,ract,irdiff,sss2mingrad2
+ awat=awaterenta(irdiff)-awaterentro(irdiff)*t_bath/1000.0d0
+ bwat=bwaterenta(irdiff)-bwaterentro(irdiff)*t_bath/1000.0d0
+ cwat=cwaterenta(irdiff)-cwaterentro(irdiff)*t_bath/1000.0d0
+ dwat=dwaterenta(irdiff)-dwaterentro(irdiff)*t_bath/1000.0d0
+ r(1)=xj
+ r(2)=yj
+ r(3)=zj
+
+ ewater=awat+bwat*rdiff+cwat*rdiff*rdiff+dwat*rdiff*rdiff*rdiff
+ ecationcation=ecationcation+ewater*sss2min2
+ do k=1,3
+ gg(k)=(bwat+2.0d0*cwat*rdiff+dwat*3.0d0*rdiff*rdiff)*r(k)/ract
+ gradcatcat(k,i)=gradcatcat(k,i)-gg(k)*sss2min2-sss2mingrad2*ewater*r(k)/ract
+ gradcatcat(k,j)=gradcatcat(k,j)+gg(k)*sss2min2+sss2mingrad2*ewater*r(k)/ract
+ enddo
+ if (energy_dec) write(iout,'(2f8.2,f10.2,2i5)') rdiff,ract,ecationcation,i,j
+ endif ! end water
+ enddo
+! enddo
+ return
+ end subroutine ecatcat
+!---------------------------------------------------------------------------
+! new for K+
+ subroutine ecats_prot_amber(evdw)
+! subroutine ecat_prot2(ecation_prot)
+ use calc_data
+ use comm_momo
-#ifdef TIMING
- 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
-#endif
-!#undef DEBUG
-#ifdef CARGRAD
-#ifdef DEBUG
- write (iout,*) "CARGRAD"
-#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
-#endif
-!#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)
+ logical :: lprn
+!el local variables
+ integer :: iint,itypi1,subchap,isel,itmp
+ real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
+ real(kind=8) :: evdw,aa,bb
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
+ integer :: ii,ki
+ real(kind=8) :: fracinbuf
+ real (kind=8) :: escpho
+ real (kind=8),dimension(4):: ener
+ real(kind=8) :: b1,b2,egb
+ real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
+ Lambf,&
+ Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
+ ecations_prot_amber,dFdOM2,dFdL,dFdOM12,&
+ federmaus,&
+ d1i,d1j
+! real(kind=8),dimension(3,2)::erhead_tail
+! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
+ real(kind=8) :: facd4, adler, Fgb, facd3
+ integer troll,jj,istate
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ real(kind=8) ::locbox(3)
+ locbox(1)=boxxsize
+ locbox(2)=boxysize
+ locbox(3)=boxzsize
- ! 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)
+ evdw=0.0D0
+ if (nres_molec(5).eq.0) return
+ eps_out=80.0d0
+! sss_ele_cut=1.0d0
- ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! go to 17
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+! do i=ibond_start,ibond_end
+ do ki=g_listcatscnorm_start,g_listcatscnorm_end
+ i=newcontlistcatscnormi(ki)
+ j=newcontlistcatscnormj(ki)
- ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
- ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
+! print *,"I am in EVDW",i
+ itypi=iabs(itype(i,1))
+
+! if (i.ne.47) cycle
+ if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+! do j=itmp+1,itmp+nres_molec(5)
- ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
- ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
+! Calculate SC interaction energy.
+ itypj=iabs(itype(j,5))
+ if ((itypj.eq.ntyp1)) cycle
+ CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+
+ call to_box(xj,yj,zj)
+! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
+
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+! write(iout,*) "xj,yj,zj", xj,yj,zj,boxxsize
+
+ dxj=0.0
+ dyj=0.0
+ dzj=0.0
+! dxj = dc_norm( 1, nres+j )
+! dyj = dc_norm( 2, nres+j )
+! dzj = dc_norm( 3, nres+j )
+
+ itypi = itype(i,1)
+ itypj = itype(j,5)
+! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
+! sampling performed with amber package
+! alf1 = 0.0d0
+! alf2 = 0.0d0
+! alf12 = 0.0d0
+! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ chi1 = chi1cat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
+ chip1 = chipp1cat(itypi,itypj)
+! chi1=0.0d0
+! chis1=0.0d0
+! chip1=0.0d0
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
+! chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2=0.0d0
+! sig2 = sigmap2(itypi,itypj)
+! alpha factors from Fcav/Gcav
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+
+! b1cav=0.0d0
+! b2cav=0.0d0
+! b3cav=0.0d0
+! b4cav=0.0d0
+
+! used to determine whether we want to do quadrupole calculations
+ eps_in = epsintabcat(itypi,itypj)
+ if (eps_in.eq.0.0) eps_in=1.0
- ! 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)
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+! Rtail = 0.0d0
+
+ DO k = 1, 3
+ ctail(k,1)=c(k,i+nres)
+ ctail(k,2)=c(k,j)
+ END DO
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+! tail location and distance calculations
+! dhead1
+ d1 = dheadcat(1, 1, itypi, itypj)
+! d2 = dhead(2, 1, itypi, itypj)
+ DO k = 1,3
+! location of polar head is computed by taking hydrophobic centre
+! and moving by a d1 * dc_norm vector
+! see unres publications for very informative images
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
+ enddo
+ call to_box(chead(1,1),chead(2,1),chead(3,1))
+ call to_box(chead(1,2),chead(2,2),chead(3,2))
+! write(iout,*) "TEST",chead(1,1),chead(2,1),chead(3,1),dc_norm(k, i+nres),d1
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ do k=1,3
+ Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
+ END DO
+! pitagoras (root of sum of squares)
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+!-------------------------------------------------------------------
+! zero everything that should be zero'ed
+ evdwij = 0.0d0
+ ECL = 0.0d0
+ Elj = 0.0d0
+ Equad = 0.0d0
+ Epol = 0.0d0
+ Fcav=0.0d0
+ eheadtail = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+ Fcav = 0.0d0
+ Fisocav=0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
+! print *,i,j,dscj_inv,dsci_inv
+! rij holds 1/(distance of Calpha atoms)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+! print *,sss_ele_cut,sss_ele_grad,&
+! 1.0d0/(rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ CALL sc_angular
+! this should be in elgrad_init but om's are calculated by sc_angular
+! which in turn is used by older potentials
+! om = omega, sqom = om^2
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
+! now we calculate EGB - Gey-Berne
+! It will be summed up in evdwij and saved in evdw
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+! rij_shift = 1.0D0 / rij - sig + sig0ij
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ if (evdw.gt.1.0d6) then
+ write (*,'(2(1x,a3,i3),7f7.2)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij,sigsq
+ write(*,*) facsig,faceps1_inv,om1,chiom1,chi1
+ write(*,*) "ANISO?!",chi1
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+ endif
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_cat(itypi,itypj)
+! print *,"ADAM",aa_aq(itypi,itypj)
- ! 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)
-
-
+! c1 = 0.0d0
+ c2 = fac * bb_aq_cat(itypi,itypj)
+! c2 = 0.0d0
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
+! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
+!#ifdef TSCSC
+! IF (bb_aq(itypi,itypj).gt.0) THEN
+! evdw_p = evdw_p + evdwij
+! ELSE
+! evdw_m = evdw_m + evdwij
+! END IF
+!#else
+ evdw = evdw &
+ + evdwij*sss_ele_cut
+!#endif
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
+! Calculate distance derivative
+ gg(1) = fac*sss_ele_cut+evdwij*sss_ele_grad
+ gg(2) = fac*sss_ele_cut+evdwij*sss_ele_grad
+ gg(3) = fac*sss_ele_cut+evdwij*sss_ele_grad
+! print *,"GG(1),distance grad",gg(1)
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Chif = Rtail * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+
+ dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
+ dbot = 12.0d0 * b4cav * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut+&
+ Fcav*sss_ele_grad
+ Fcav=Fcav*sss_ele_cut
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ DO k= 1, 3
+ ertail(k) = Rtail_distance(k)/Rtail
+ END DO
+ erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
+ erdxj = scalar( ertail(1), dC_norm(1,j) )
+ facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j)
+ DO k = 1, 3
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j))
+! gvdwx(k,j) = gvdwx(k,j) &
+! + (( dFdR + gg(k) ) * pom)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
+ gg(k) = 0.0d0
+ ENDDO
+!c! Compute head-head and head-tail energies for each state
+!! if (.false.) then ! turn off electrostatic
+ if (itype(j,5).gt.0) then ! the normal cation case
+ isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
+! print *,i,itype(i,1),isel
+ IF (isel.eq.0) THEN
+ eheadtail = 0.0d0
+ ELSE IF (isel.eq.1) THEN
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ CALL enq_cat(epol)
+ eheadtail = epol
+ ELSE IF (isel.eq.3) THEN
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ CALL edq_cat(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+ ELSE IF ((isel.eq.2)) THEN
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
+ END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
+ else ! here is water and other molecules
+ isel = iabs(Qi)+2
+! isel=2
+! if (isel.eq.4) isel=2
+ if (isel.eq.2) then
+ eheadtail = 0.0d0
+ else if (isel.eq.3) then
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ call eqd_cat(ecl,elj,epol)
+ eheadtail = ECL + elj + epol
+ else if (isel.eq.4) then
+ call edd_cat(ecl)
+ eheadtail = ECL
+ endif
+! write(iout,*) "not yet implemented",j,itype(j,5)
+ endif
+!! endif ! turn off electrostatic
+ evdw = evdw + Fcav + eheadtail
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+
+ IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
+! evdw = evdw + Fcav + eheadtail
+ if (energy_dec) write(iout,*) "FCAV", &
+ sig1,sig2,b1cav,b2cav,b3cav,b4cav
+! print *,"before sc_grad_cat", i,j, gradpepcat(1,j)
+! iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad_cat
+! print *,"after sc_grad_cat", i,j, gradpepcat(1,j)
+
+! END IF
+!c!-------------------------------------------------------------------
+!c! NAPISY KONCOWE
+ END DO ! j
+! END DO ! i
+!c write (iout,*) "Number of loop steps in EGB:",ind
+!c energy_dec=.false.
+! print *,"EVDW KURW",evdw,nres
+!!! return
+ 17 continue
+! go to 23
+! do i=ibond_start,ibond_end
+
+ do ki=g_listcatpnorm_start,g_listcatpnorm_end
+ i=newcontlistcatpnormi(ki)
+ j=newcontlistcatpnormj(ki)
+
+! print *,"I am in EVDW",i
+ itypi=10 ! the peptide group parameters are for glicine
+
+! if (i.ne.47) cycle
+ if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+ dxi=dc_norm(1,i)
+ dyi=dc_norm(2,i)
+ dzi=dc_norm(3,i)
+ dsci_inv=vbld_inv(i+1)/2.0
+! do j=itmp+1,itmp+nres_molec(5)
+
+! Calculate SC interaction energy.
+ itypj=iabs(itype(j,5))
+ if ((itypj.eq.ntyp1)) cycle
+ CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+
+ dxj = 0.0d0! dc_norm( 1, nres+j )
+ dyj = 0.0d0!dc_norm( 2, nres+j )
+ dzj = 0.0d0! dc_norm( 3, nres+j )
+
+ itypi = 10
+ itypj = itype(j,5)
+! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
+! sampling performed with amber package
+! alf1 = 0.0d0
+! alf2 = 0.0d0
+! alf12 = 0.0d0
+! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ chi1 = chi1cat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
+ chip1 = chipp1cat(itypi,itypj)
+! chi1=0.0d0
+! chis1=0.0d0
+! chip1=0.0d0
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
+! chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2=0.0
+! sig2 = sigmap2(itypi,itypj)
+! alpha factors from Fcav/Gcav
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+
+! used to determine whether we want to do quadrupole calculations
+ eps_in = epsintabcat(itypi,itypj)
+ if (eps_in.eq.0.0) eps_in=1.0
- ! gradc(j,i,icg)=0.0d0
- ! gradx(j,i,icg)=0.0d0
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+! Rtail = 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 k = 1, 3
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0
+ ctail(k,2)=c(k,j)
+ END DO
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
- !
- ! 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)
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+! tail location and distance calculations
+! dhead1
+ d1 = dheadcat(1, 1, itypi, itypj)
+! print *,"d1",d1
+! d1=0.0d0
+! d2 = dhead(2, 1, itypi, itypj)
+ DO k = 1,3
+! location of polar head is computed by taking hydrophobic centre
+! and moving by a d1 * dc_norm vector
+! see unres publications for very informative images
+ chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
+ chead(k,2) = c(k, j)
+ ENDDO
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ call to_box(chead(1,1),chead(2,1),chead(3,1))
+ call to_box(chead(1,2),chead(2,2),chead(3,2))
- 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'
-#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
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ do k=1,3
+ Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
+ END DO
- !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))
+! 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 = 0.0d0 ! 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)
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+! print *,sss_ele_cut,sss_ele_grad,&
+! 1.0d0/(rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ 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
+ om2=0.0d0
+ om12=0.0d0
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
- !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))
+! now we calculate EGB - Gey-Berne
+! It will be summed up in evdwij and saved in evdw
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+! rij_shift = 1.0D0 / rij - sig + sig0ij
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),6f6.2)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_cat(itypi,itypj)
+! print *,"ADAM",aa_aq(itypi,itypj)
+! c1 = 0.0d0
+ c2 = fac * bb_aq_cat(itypi,itypj)
+! c2 = 0.0d0
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
+! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
+!#ifdef TSCSC
+! IF (bb_aq(itypi,itypj).gt.0) THEN
+! evdw_p = evdw_p + evdwij
+! ELSE
+! evdw_m = evdw_m + evdwij
+! END IF
+!#else
+ evdw = evdw &
+ + evdwij*sss_ele_cut
+!#endif
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
+! Calculate distance derivative
+ gg(1) = fac*sss_ele_cut+evdwij*sss_ele_grad
+ gg(2) = fac*sss_ele_cut+evdwij*sss_ele_grad
+ gg(3) = fac*sss_ele_cut+evdwij*sss_ele_grad
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
+
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+! print *,"TUT2",fac,chis1,sqom1,pom
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Chif = Rtail * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
-#if defined(MPI) && defined(PARINTDER)
- 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
+ dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
+ dbot = 12.0d0 * b4cav * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut+&
+ Fcav*sss_ele_grad
+ Fcav=Fcav*sss_ele_cut
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+! dCAVdOM2 = dFdL * ( dFdOM2 )
+! dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM2=0.0d0
+ dCAVdOM12=0.0d0
- ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
- ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
+ DO k= 1, 3
+ ertail(k) = Rtail_distance(k)/Rtail
+ END DO
+ erdxi = scalar( ertail(1), dC_norm(1,i) )
+ erdxj = scalar( ertail(1), dC_norm(1,j) )
+ facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i)
+ facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres)
+ DO k = 1, 3
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i))
+! gradpepcatx(k,i) = gradpepcatx(k,i) &
+! - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+! gvdwx(k,j) = gvdwx(k,j) &
+! + (( dFdR + gg(k) ) * pom)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0
+ gradpepcat(k,i+1) = gradpepcat(k,i+1) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
+ gg(k) = 0.0d0
+ ENDDO
+ if (itype(j,5).gt.0) then
+!c! Compute head-head and head-tail energies for each state
+ isel = 3
+!c! Dipole-charge interactions
+ CALL edq_cat_pep(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+! print *,"i,",i,eheadtail
+! eheadtail = 0.0d0
+ else
+!HERE WATER and other types of molecules solvents will be added
+! write(iout,*) "not yet implemented"
+ CALL edd_cat_pep(ecl)
+ eheadtail=ecl
+! CALL edd_cat_pep
+! eheadtail=0.0d0
+ endif
+ evdw = evdw + Fcav + eheadtail
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+ IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
+! evdw = evdw + Fcav + eheadtail
- ! 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
-#else
- do i=3,nres
-#endif
- cost=dcos(theta(i))
- sint=sqrt(1-cost*cost)
- do j=1,3
- dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
- vbld(i-1)
- if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
- dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
- vbld(i)
- if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
- enddo
- enddo
-#if defined(MPI) && defined(PARINTDER)
- ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
-#else
- do i=3,nres
-#endif
- if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
- cost1=dcos(omicron(1,i))
- sint1=sqrt(1-cost1*cost1)
- cost2=dcos(omicron(2,i))
- sint2=sqrt(1-cost2*cost2)
- do j=1,3
- !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
-#else
- do i=4,nres
-#endif
- ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
- ! the conventional case
- sint=dsin(theta(i))
- sint1=dsin(theta(i-1))
- sing=dsin(phi(i))
- cost=dcos(theta(i))
- cost1=dcos(theta(i-1))
- cosg=dcos(phi(i))
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
- ! 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
-#else
- do i=3,nres
- !elwrite(iout,*) " vecpr",i,nres
-#endif
- if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
- ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).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
-#else
- do i=4,nres
-#endif
- if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
- (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
- ! 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 (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad_cat_pep
+! END IF
+!c!-------------------------------------------------------------------
+!c! NAPISY KONCOWE
+ END DO ! j
+! END DO ! i
+!c write (iout,*) "Number of loop steps in EGB:",ind
+!c energy_dec=.false.
+! print *,"EVDW KURW",evdw,nres
+ 23 continue
+! print *,"before leave sc_grad_cat", i,j, gradpepcat(1,nres-1)
- !CC third case SC...Ca...Ca...SC
-#ifdef PARINTDER
+ return
+ end subroutine ecats_prot_amber
- do i=itau_start,itau_end
-#else
- do i=3,nres
-#endif
- ! the conventional case
- if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
- (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
- sint=dsin(omicron(1,i))
- sint1=dsin(omicron(2,i-1))
- sing=dsin(tauangle(3,i))
- cost=dcos(omicron(1,i))
- cost1=dcos(omicron(2,i-1))
- cosg=dcos(tauangle(3,i))
- do j=1,3
- dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
- ! 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
+!---------------------------------------------------------------------------
+! old for Ca2+
+ subroutine ecat_prot(ecation_prot)
+! use calc_data
+! use comm_momo
+ integer i,j,k,subchap,itmp,inum
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
+ r7,r4
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,ecation_prot,rcal,rocal, &
+ Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
+ catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
+ wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
+ costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
+ Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
+ rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
+ opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
+ opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
+ Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
+ ndiv,ndivi
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
+ dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
+ tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
+ v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
+ dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
+ dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
+ dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
+ dEvan1Cat
+ real(kind=8),dimension(6) :: vcatprm
+ ecation_prot=0.0d0
+! first lets calculate interaction with peptide groups
+ if (nres_molec(5).eq.0) return
+ 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))
+ call to_box(xi,yi,zi)
+
+ do j=itmp+1,itmp+nres_molec(5)
+! print *,"WTF",itmp,j,i
+! all parameters were for Ca2+ to approximate single charge divide by two
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+ wconst=78*ndiv
+ wdip =1.092777950857032D2
+ wdip=wdip/wconst
+ wmodquad=-2.174122713004870D4
+ wmodquad=wmodquad/wconst
+ wquad1 = 3.901232068562804D1
+ wquad1=wquad1/wconst
+ wquad2 = 3
+ wquad2=wquad2/wconst
+ wvan1 = 0.1
+ wvan2 = 6
+! itmp=0
+
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+! 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
+! print *,"ecatprot",i,j,ecation_prot,rcpm
+ dE1dr = -2*costhet*wdip*Irthrp-&
+ (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
+ dE2dr = 3*wquad1*wquad2*Irfourp- &
+ 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
+ dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
+ do k=1,3
+ drdpep(k) = -drcp_norm(k)
+ dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
+ dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
+ dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
+ dEddci(k) = dEdcos*dcosddci(k)
+ enddo
+ do k=1,3
+ gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
+ gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
+ gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
+ enddo
+ enddo ! j
+ enddo ! i
+!------------------------------------------sidechains
+! do i=1,nres_molec(1)
+ do i=ibond_start,ibond_end
+ if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
+! cycle
+! print *,i,ecation_prot
+ xi=(c(1,i+nres))
+ yi=(c(2,i+nres))
+ zi=(c(3,i+nres))
+ call to_box(xi,yi,zi)
+ do k=1,3
+ cm1(k)=dc(k,i+nres)
+ enddo
+ cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
+ do j=itmp+1,itmp+nres_molec(5)
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
-#ifdef CRYST_SC
- ! Derivatives of side-chain angles alpha and omega
-#if defined(MPI) && defined(PARINTDER)
- do i=ibond_start,ibond_end
-#else
- do i=2,nres-1
-#endif
- if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
- fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
- fac6=fac5/vbld(i)
- fac7=fac5*fac5
- fac8=fac5/vbld(i+1)
- fac9=fac5/vbld(i+nres)
- scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
- scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
- cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
- (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
- -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
- sina=sqrt(1-cosa*cosa)
- sino=dsin(omeg(i))
- ! 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
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+! enddo
+! enddo
+! 15- Glu 16-Asp
+ if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
+ ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
+ (itype(i,1).eq.25))) then
+ if(itype(i,1).eq.16) then
+ inum=1
+ else
+ inum=2
+ endif
+ do k=1,6
+ vcatprm(k)=catprm(k,inum)
+ enddo
+ dASGL=catprm(7,inum)
+! do k=1,3
+! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
+ vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
+ vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
+ vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
+
+! valpha(k)=c(k,i)
+! vcat(k)=c(k,j)
+ if (subchap.eq.1) then
+ vcat(1)=xj_temp
+ vcat(2)=yj_temp
+ vcat(3)=zj_temp
else
- do j=1,3
- do k=1,3
- dalpha(k,j,i)=0.0d0
- domega(k,j,i)=0.0d0
- enddo
- enddo
+ vcat(1)=xj_safe
+ vcat(2)=yj_safe
+ vcat(3)=zj_safe
endif
- enddo
-#endif
-#if defined(MPI) && defined(PARINTDER)
- 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
-#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)
-!#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
-#endif
-!#undef DEBUG
- call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
- MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
- !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)
-#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
-#endif
-!#undef DEBUG
- return
- end subroutine intcartderiv
- !-----------------------------------------------------------------------------
- subroutine checkintcartgrad
- ! implicit real*8 (a-h,o-z)
- ! include 'DIMENSIONS'
-#ifdef MPI
- 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.)
- dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
-!el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
-!el (dtheta(j,2,i),j=1,3)
-!el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
-!el (dthetanum(j,2,i),j=1,3)
-!el write (iout,'(5x,3f10.5,5x,3f10.5)') &
-!el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
-!el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
-!el write (iout,*)
- enddo
-! Check gamma gradient
- write (iout,*) &
- "Analytical (upper) and numerical (lower) gradient of gamma"
- do i=4,nres
- do j=1,3
- dcji=dc(j,i-3)
- dc(j,i-3)=dcji+aincr
- call chainbuild_cart
- dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-3)=dcji
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
-!el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
-!el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
-!el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
-!el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
-!el write (iout,'(5x,3(3f10.5,5x))') &
-!el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
-!el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
-!el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
-!el write (iout,*)
- enddo
-! Check alpha gradient
- write (iout,*) &
- "Analytical (upper) and numerical (lower) gradient of alpha"
- do i=2,nres-1
- if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
-!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),&
-!el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
-!el write (iout,'(5x,3(3f10.5,5x))') &
-!el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
-!el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
-!el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
-!el write (iout,*)
+ valpha(1)=xi-c(1,i+nres)+c(1,i)
+ valpha(2)=yi-c(2,i+nres)+c(2,i)
+ valpha(3)=zi-c(3,i+nres)+c(3,i)
+
+! enddo
+ do k=1,3
+ dx(k) = vcat(k)-vcm(k)
enddo
-! Check omega gradient
- write (iout,*) &
- "Analytical (upper) and numerical (lower) gradient of omega"
- do i=2,nres-1
- if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
-!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),&
-!el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
-!el write (iout,'(5x,3(3f10.5,5x))') &
-!el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
-!el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
-!el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
-!el write (iout,*)
+ do k=1,3
+ v1(k)=(vcm(k)-valpha(k))
+ v2(k)=(vcat(k)-valpha(k))
enddo
- return
- end subroutine checkintcartgrad
-!-----------------------------------------------------------------------------
-! q_measure.F
-!-----------------------------------------------------------------------------
- real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.INTERACT'
-! 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) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
- logical :: lprn=.false.
- logical :: flag
-! real(kind=8) :: sigm,x
+ 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)
-!el sigm(x)=0.25d0*x ! local function
- qqmax=1.0d10
- do kkk=1,nperm
- qq = 0.0d0
- nl=0
- if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
- nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
- enddo
- qq = qq/nl
- else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
+! The weights of the energy function calculated from
+!The quantum mechanical GAMESS simulations of calcium with ASP/GLU
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ ndivi=0.5
else
- secseg=seg3
- endif
- do jl=secseg,seg4
- nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
- enddo
- qq = qq/nl
- endif
- if (qqmax.le.qq) qqmax=qq
- enddo
- qwolynes=1.0d0-qqmax
- return
- end function qwolynes
-!-----------------------------------------------------------------------------
- subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.INTERACT'
-! include 'COMMON.VAR'
-! include 'COMMON.MD'
- integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
- integer :: nsep=3, kkk
-!el real(kind=8) :: dist
- real(kind=8) :: dij,d0ij,dijCM,d0ijCM
- logical :: lprn=.false.
- logical :: flag
- real(kind=8) :: sim,dd0,fac,ddqij
-!el sigm(x)=0.25d0*x ! local function
- do kkk=1,nperm
- do i=0,nres
- do j=1,3
- dqwol(j,i)=0.0d0
- dxqwol(j,i)=0.0d0
- enddo
+ ndivi=1.0
+ endif
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ wh2o=78*ndivi*ndiv
+ wc = vcatprm(1)
+ wc=wc/wh2o
+ wdip =vcatprm(2)
+ wdip=wdip/wh2o
+ wquad1 =vcatprm(3)
+ wquad1=wquad1/wh2o
+ wquad2 = vcatprm(4)
+ wquad2=wquad2/wh2o
+ wquad2p = 1.0d0-wquad2
+ wvan1 = vcatprm(5)
+ wvan2 =vcatprm(6)
+ opt = dx(1)**2+dx(2)**2
+ rsecp = opt+dx(3)**2
+ rs = sqrt(rsecp)
+ rthrp = rsecp*rs
+ rfourp = rthrp*rs
+ rsixp = rfourp*rsecp
+ reight=rsixp*rsecp
+ Ir = 1.0d0/rs
+ Irsecp = 1.0d0/rsecp
+ Irthrp = Irsecp/rs
+ Irfourp = Irthrp/rs
+ Irsixp = 1.0d0/rsixp
+ Ireight=1.0d0/reight
+ Irtw=Irsixp*Irsixp
+ Irthir=Irtw/rs
+ Irfourt=Irthir/rs
+ opt1 = (4*rs*dx(3)*wdip)
+ opt2 = 6*rsecp*wquad1*opt
+ opt3 = wquad1*wquad2p*Irsixp
+ opt4 = (wvan1*wvan2**12)
+ opt5 = opt4*12*Irfourt
+ opt6 = 2*wvan1*wvan2**6
+ opt7 = 6*opt6*Ireight
+ opt8 = wdip/v1m
+ opt10 = wdip/v2m
+ opt11 = (rsecp*v2m)**2
+ opt12 = (rsecp*v1m)**2
+ opt14 = (v1m*v2m*rsecp)**2
+ opt15 = -wquad1/v2m**2
+ opt16 = (rthrp*(v1m*v2m)**2)**2
+ opt17 = (v1m**2*rthrp)**2
+ opt18 = -wquad1/rthrp
+ opt19 = (v1m**2*v2m**2)**2
+ Ec = wc*Ir
+ do k=1,3
+ dEcCat(k) = -(dx(k)*wc)*Irthrp
+ dEcCm(k)=(dx(k)*wc)*Irthrp
+ dEcCalp(k)=0.0d0
enddo
- nl=0
- if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
- nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
- sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ 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
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
-
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim = sim*sim
- dd0=dijCM-d0ijCM
- fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
+ dscvec(k) = dc(k,i+nres)
+ dscmag = dscmag+dscvec(k)*dscvec(k)
enddo
- enddo
- else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
- nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
- sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim=sim*sim
- dd0 = dijCM-d0ijCM
- fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
+ 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
- enddo
- endif
- enddo
- do i=0,nres
- do j=1,3
- dqwol(j,i)=dqwol(j,i)/nl
- dxqwol(j,i)=dxqwol(j,i)/nl
- enddo
- enddo
- return
- end subroutine qwolynes_prim
-!-----------------------------------------------------------------------------
- subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.INTERACT'
-! include 'COMMON.VAR'
- integer :: seg1,seg2,seg3,seg4
- logical :: flag
- real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
- real(kind=8),dimension(3,0:2*nres) :: cdummy
- real(kind=8) :: q1,q2
- real(kind=8) :: delta=1.0d-10
- integer :: i,j
+ 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
+ vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
+ vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
+ vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
+ if (subchap.eq.1) then
+ vcat(1)=xj_temp
+ vcat(2)=yj_temp
+ vcat(3)=zj_temp
+ else
+ vcat(1)=xj_safe
+ vcat(2)=yj_safe
+ vcat(3)=zj_safe
+ endif
+ valpha(1)=xi-c(1,i+nres)+c(1,i)
+ valpha(2)=yi-c(2,i+nres)+c(2,i)
+ valpha(3)=zi-c(3,i+nres)+c(3,i)
- do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i)=c(j,i)
- c(j,i)=c(j,i)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolan(j,i)=(q2-q1)/delta
- c(j,i)=cdummy(j,i)
- enddo
+
+ do k=1,3
+ dx(k) = vcat(k)-vcm(k)
enddo
- do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i+nres)=c(j,i+nres)
- c(j,i+nres)=c(j,i+nres)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolxan(j,i)=(q2-q1)/delta
- c(j,i+nres)=cdummy(j,i+nres)
- enddo
- enddo
-! write(iout,*) "Numerical Q carteisan gradients backbone: "
-! do i=0,nct
-! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
-! enddo
-! write(iout,*) "Numerical Q carteisan gradients side-chain: "
-! do i=0,nct
-! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
-! enddo
- return
- end subroutine qwol_num
-!-----------------------------------------------------------------------------
- subroutine EconstrQ
-! MD with umbrella_sampling using Wolyne's distance measure as a constraint
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
-! include 'COMMON.VAR'
-! include 'COMMON.MD'
- use MD_data
-!#ifndef LANG0
-! include 'COMMON.LANGEVIN'
-!#else
-! include 'COMMON.LANGEVIN.lang0'
-!#endif
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.NAMES'
-! include 'COMMON.TIME1'
- real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
- real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
- duconst,duxconst
- integer :: kstart,kend,lstart,lend,idummy
- real(kind=8) :: delta=1.0d-7
- integer :: i,j,k,ii
- do i=0,nres
- do j=1,3
- duconst(j,i)=0.0d0
- dudconst(j,i)=0.0d0
- duxconst(j,i)=0.0d0
- dudxconst(j,i)=0.0d0
- enddo
+ do k=1,3
+ v1(k)=(vcm(k)-valpha(k))
+ v2(k)=(vcat(k)-valpha(k))
enddo
- Uconst=0.0d0
- do i=1,nfrag
- qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
- Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
-! Calculating the derivatives of Constraint energy with respect to Q
- 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
-! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
-! & qinfrag(i,iset))
-! write(iout,*) "harmonicnum frag", hmnum
-! Calculating the derivatives of Q with respect to cartesian coordinates
- call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
-! write(iout,*) "dqwol "
-! do ii=1,nres
-! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
-! enddo
-! write(iout,*) "dxqwol "
-! do ii=1,nres
-! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
-! enddo
-! Calculating numerical gradients of dU/dQi and dQi/dxi
-! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
-! & ,idummy,idummy)
-! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
- enddo
- enddo
- enddo
- do i=1,npair
- kstart=ifrag(1,ipair(1,i,iset),iset)
- kend=ifrag(2,ipair(1,i,iset),iset)
- lstart=ifrag(1,ipair(2,i,iset),iset)
- lend=ifrag(2,ipair(2,i,iset),iset)
- qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
- Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
-! 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
-! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
-! & qinpair(i,iset))
-! write(iout,*) "harmonicnum pair ", hmnum
-! Calculating dQ/dXi
- call qwolynes_prim(kstart,kend,.false.,&
- lstart,lend)
-! write(iout,*) "dqwol "
-! do ii=1,nres
-! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
-! enddo
-! write(iout,*) "dxqwol "
-! do ii=1,nres
-! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
-! enddo
-! Calculating numerical gradients
-! call qwol_num(kstart,kend,.false.
-! & ,lstart,lend)
-! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
- enddo
- enddo
+ 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
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ wh2o=78*ndiv
+ wdip =vcatprm(2)
+ wdip=wdip/wh2o
+ wquad1 =vcatprm(3)
+ wquad1=wquad1/wh2o
+ wquad2 = vcatprm(4)
+ wquad2=wquad2/wh2o
+ wquad2p = 1-wquad2
+ wvan1 = vcatprm(5)
+ wvan2 =vcatprm(6)
+ opt = dx(1)**2+dx(2)**2
+ rsecp = opt+dx(3)**2
+ rs = sqrt(rsecp)
+ rthrp = rsecp*rs
+ rfourp = rthrp*rs
+ rsixp = rfourp*rsecp
+ reight=rsixp*rsecp
+ Ir = 1.0d0/rs
+ Irsecp = 1/rsecp
+ Irthrp = Irsecp/rs
+ Irfourp = Irthrp/rs
+ Irsixp = 1/rsixp
+ Ireight=1/reight
+ Irtw=Irsixp*Irsixp
+ Irthir=Irtw/rs
+ Irfourt=Irthir/rs
+ opt1 = (4*rs*dx(3)*wdip)
+ opt2 = 6*rsecp*wquad1*opt
+ opt3 = wquad1*wquad2p*Irsixp
+ opt4 = (wvan1*wvan2**12)
+ opt5 = opt4*12*Irfourt
+ opt6 = 2*wvan1*wvan2**6
+ opt7 = 6*opt6*Ireight
+ opt8 = wdip/v1m
+ opt10 = wdip/v2m
+ opt11 = (rsecp*v2m)**2
+ opt12 = (rsecp*v1m)**2
+ opt14 = (v1m*v2m*rsecp)**2
+ opt15 = -wquad1/v2m**2
+ opt16 = (rthrp*(v1m*v2m)**2)**2
+ opt17 = (v1m**2*rthrp)**2
+ opt18 = -wquad1/rthrp
+ opt19 = (v1m**2*v2m**2)**2
+ Edip=opt8*(v1dpv2)/(rsecp*v2m)
+ do k=1,3
+ dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
+ *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
+ dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
+ *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
+ dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
+ *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
+ *v1dpv2)/opt14
enddo
-! write(iout,*) "Uconst inside subroutine ", Uconst
-! Transforming the gradients from Cs to dCs for the backbone
- do i=0,nres
- do j=i+1,nres
- do k=1,3
- dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
- enddo
- 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
-! Transforming the gradients from Cs to dCs for the side chains
- do i=1,nres
- do j=1,3
- dudxconst(j,i)=duxconst(j,i)
- enddo
- enddo
-! write(iout,*) "dU/ddc backbone "
-! do ii=0,nres
-! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
-! enddo
-! write(iout,*) "dU/ddX side chain "
-! do ii=1,nres
-! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
-! enddo
-! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
-! call dEconstrQ_num
- return
- end subroutine EconstrQ
+ Equad2=wquad1*wquad2p*Irthrp
+ do k=1,3
+ dEquad2Cat(k)=-3*dx(k)*rs*opt3
+ dEquad2Cm(k)=3*dx(k)*rs*opt3
+ dEquad2Calp(k)=0.0d0
+ enddo
+ Evan1=opt4*Irtw
+ do k=1,3
+ dEvan1Cat(k)=-dx(k)*opt5
+ dEvan1Cm(k)=dx(k)*opt5
+ dEvan1Calp(k)=0.0d0
+ enddo
+ Evan2=-opt6*Irsixp
+ do k=1,3
+ dEvan2Cat(k)=dx(k)*opt7
+ dEvan2Cm(k)=-dx(k)*opt7
+ dEvan2Calp(k)=0.0d0
+ enddo
+ ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
+ do k=1,3
+ dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
+ dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
+ dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
+ dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
+ dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
+ +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
+ enddo
+ dscmag = 0.0d0
+ do k=1,3
+ dscvec(k) = c(k,i+nres)-c(k,i)
+! TU SPRAWDZ???
+! dscvec(1) = xj
+! dscvec(2) = yj
+! dscvec(3) = zj
+
+ dscmag = dscmag+dscvec(k)*dscvec(k)
+ enddo
+ dscmag3 = dscmag
+ dscmag = sqrt(dscmag)
+ dscmag3 = dscmag3*dscmag
+ constA = 1+dASGL/dscmag
+ constB = 0.0d0
+ do k=1,3
+ constB = constB+dscvec(k)*dEtotalCm(k)
+ enddo
+ constB = constB*dASGL/dscmag3
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ constA*dEtotalCm(k)-constB*dscvec(k)
+ gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
+ gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
+ enddo
+ else
+ rcal = 0.0d0
+ do k=1,3
+! r(k) = c(k,j)-c(k,i+nres)
+ r(1) = xj
+ r(2) = yj
+ r(3) = zj
+ rcal = rcal+r(k)*r(k)
+ enddo
+ ract=sqrt(rcal)
+ rocal=1.5
+ epscalc=0.2
+ r0p=0.5*(rocal+sig0(itype(i,1)))
+ r06 = r0p**6
+ r012 = r06*r06
+ Evan1=epscalc*(r012/rcal**6)
+ Evan2=epscalc*2*(r06/rcal**3)
+ r4 = rcal**4
+ r7 = rcal**7
+ do k=1,3
+ dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
+ dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
+ enddo
+ do k=1,3
+ dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
+ enddo
+ ecation_prot = ecation_prot+ Evan1+Evan2
+ do k=1,3
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ dEtotalCm(k)
+ gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
+ gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
+ enddo
+ endif ! 13-16 residues
+ enddo !j
+ enddo !i
+ return
+ end subroutine ecat_prot
+
+!----------------------------------------------------------------------------
+!---------------------------------------------------------------------------
+ subroutine ecat_nucl(ecation_nucl)
+ integer i,j,k,subchap,itmp,inum,itypi,itypj
+ real(kind=8) :: xi,yi,zi,xj,yj,zj
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,ecation_nucl,Evan1,Evan2,Ecav,Egb,wdip1,wdip2, &
+ wvan1,wvan2,wgbsig,wgbeps,wgbchi,wgbchip,wcav1,wcav2,wcav3,wcav4, &
+ wcavsig,wcavchi,v1m,v1dpdx,wh2o,wc,Edip,rcs2,invrcs6,invrcs8,invrcs12, &
+ invrcs14,rcb,rcb2,invrcb,invrcb2,invrcb4,invrcb6,cosinus,cos2,dcosdcatconst, &
+ dcosdcalpconst,dcosdcmconst,rcav,rcav11,rcav12,constcav1,constcav2, &
+ constgb1,constgb2,constdvan1,constdvan2,sgb,sgb6,sgb7,sgb12,sgb13, &
+ cavnum,cavdenom,invcavdenom2,dcavnumdcos,dcavnumdr,dcavdenomdcos, &
+ dcavdenomdr,sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
+ real(kind=8),dimension(3) ::gg,r,dEtotalCm,dEtotalCalp,dEvan1Cm,&
+ dEvan2Cm,cm1,cm,vcat,vsug,v1,v2,dx,vcm,dEdipCm,dEdipCalp, &
+ dEvan1Calp,dEvan2Cat,dEvan2Calp,dEtotalCat,dEdipCat,dEvan1Cat,dcosdcat, &
+ dcosdcalp,dcosdcm,dEgbdCat,dEgbdCalp,dEgbdCm,dEcavdCat,dEcavdCalp, &
+ dEcavdCm,boxik
+ real(kind=8),dimension(14) :: vcatnuclprm
+ ecation_nucl=0.0d0
+ boxik(1)=boxxsize
+ boxik(2)=boxysize
+ boxik(3)=boxzsize
+
+ if (nres_molec(5).eq.0) return
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! print *,nres_molec(2),"nres2"
+ do i=ibond_nucl_start,ibond_nucl_end
+! do i=iatsc_s_nucl,iatsc_e_nucl
+ if ((itype(i,2).eq.ntyp1_molec(2))) cycle ! leave dummy atoms
+ xi=(c(1,i+nres))
+ yi=(c(2,i+nres))
+ zi=(c(3,i+nres))
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do k=1,3
+ cm1(k)=dc(k,i+nres)
+ enddo
+ do j=itmp+1,itmp+nres_molec(5)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! print *,i,j,itmp
+! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+! write(iout,*) 'after shift', xj,yj,zj
+ dist_init=xj**2+yj**2+zj**2
+
+ itypi=itype(i,2)
+ itypj=itype(j,5)
+ do k=1,13
+ vcatnuclprm(k)=catnuclprm(k,itypi,itypj)
+ enddo
+ do k=1,3
+ vcm(k)=c(k,i+nres)
+ vsug(k)=c(k,i)
+ vcat(k)=c(k,j)
+ enddo
+ call to_box(vcm(1),vcm(2),vcm(3))
+ call to_box(vsug(1),vsug(2),vsug(3))
+ call to_box(vcat(1),vcat(2),vcat(3))
+ do k=1,3
+! dx(k) = vcat(k)-vcm(k)
+! enddo
+ dx(k)=boxshift(vcat(k)-vcm(k),boxik(k))
+! do k=1,3
+ v1(k)=dc(k,i+nres)
+ v2(k)=boxshift(vcat(k)-vsug(k),boxik(k))
+ enddo
+ v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
+ v1dpdx = v1(1)*dx(1)+v1(2)*dx(2)+v1(3)*dx(3)
+! The weights of the energy function calculated from
+!The quantum mechanical Gaussian simulations of potassium and sodium with deoxynucleosides
+ wh2o=78
+ wdip1 = vcatnuclprm(1)
+ wdip1 = wdip1/wh2o !w1
+ wdip2 = vcatnuclprm(2)
+ wdip2 = wdip2/wh2o !w2
+ wvan1 = vcatnuclprm(3)
+ wvan2 = vcatnuclprm(4) !pis1
+ wgbsig = vcatnuclprm(5) !sigma0
+ wgbeps = vcatnuclprm(6) !epsi0
+ wgbchi = vcatnuclprm(7) !chi1
+ wgbchip = vcatnuclprm(8) !chip1
+ wcavsig = vcatnuclprm(9) !sig
+ wcav1 = vcatnuclprm(10) !b1
+ wcav2 = vcatnuclprm(11) !b2
+ wcav3 = vcatnuclprm(12) !b3
+ wcav4 = vcatnuclprm(13) !b4
+ wcavchi = vcatnuclprm(14) !chis1
+ rcs2 = v2(1)**2+v2(2)**2+v2(3)**2
+ invrcs6 = 1/rcs2**3
+ invrcs8 = invrcs6/rcs2
+ invrcs12 = invrcs6**2
+ invrcs14 = invrcs12/rcs2
+ rcb2 = dx(1)**2+dx(2)**2+dx(3)**2
+ rcb = sqrt(rcb2)
+ invrcb = 1/rcb
+ invrcb2 = invrcb**2
+ invrcb4 = invrcb2**2
+ invrcb6 = invrcb4*invrcb2
+ cosinus = v1dpdx/(v1m*rcb)
+ cos2 = cosinus**2
+ dcosdcatconst = invrcb2/v1m
+ dcosdcalpconst = invrcb/v1m**2
+ dcosdcmconst = invrcb2/v1m**2
+ do k=1,3
+ dcosdcat(k) = (v1(k)*rcb-dx(k)*v1m*cosinus)*dcosdcatconst
+ dcosdcalp(k) = (v1(k)*rcb*cosinus-dx(k)*v1m)*dcosdcalpconst
+ dcosdcm(k) = ((dx(k)-v1(k))*v1m*rcb+ &
+ cosinus*(dx(k)*v1m**2-v1(k)*rcb2))*dcosdcmconst
+ enddo
+ rcav = rcb/wcavsig
+ rcav11 = rcav**11
+ rcav12 = rcav11*rcav
+ constcav1 = 1-wcavchi*cos2
+ constcav2 = sqrt(constcav1)
+ constgb1 = 1/sqrt(1-wgbchi*cos2)
+ constgb2 = wgbeps*(1-wgbchip*cos2)**2
+ constdvan1 = 12*wvan1*wvan2**12*invrcs14
+ constdvan2 = 6*wvan1*wvan2**6*invrcs8
+!----------------------------------------------------------------------------
+!Gay-Berne term
+!---------------------------------------------------------------------------
+ sgb = 1/(1-constgb1+(rcb/wgbsig))
+ sgb6 = sgb**6
+ sgb7 = sgb6*sgb
+ sgb12 = sgb6**2
+ sgb13 = sgb12*sgb
+ Egb = constgb2*(sgb12-sgb6)
+ do k=1,3
+ dEgbdCat(k) = -constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
+ +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcat(k)
+ dEgbdCm(k) = constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
+ +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcm(k)
+ dEgbdCalp(k) = (constgb1**3*constgb2*wgbchi*cosinus &
+ *(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcalp(k)
+ enddo
+!----------------------------------------------------------------------------
+!cavity term
+!---------------------------------------------------------------------------
+ cavnum = sqrt(rcav*constcav2)+wcav2*rcav*constcav2-wcav3
+ cavdenom = 1+wcav4*rcav12*constcav1**6
+ Ecav = wcav1*cavnum/cavdenom
+ invcavdenom2 = 1/cavdenom**2
+ dcavnumdcos = -wcavchi*cosinus/constcav2 &
+ *(sqrt(rcav/constcav2)/2+wcav2*rcav)
+ dcavnumdr = (0.5*sqrt(constcav2/rcav)+wcav2*constcav2)/wcavsig
+ dcavdenomdcos = -12*wcav4*wcavchi*rcav12*constcav1**5*cosinus
+ dcavdenomdr = 12*wcav4/wcavsig*rcav11*constcav1**6
+ do k=1,3
+ dEcavdCat(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcat(k)+(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
+ dEcavdCm(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcm(k)-(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
+ dEcavdCalp(k) = (dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcalp(k)*wcav1*invcavdenom2
+ enddo
+!----------------------------------------------------------------------------
+!van der Waals and dipole-charge interaction energy
+!---------------------------------------------------------------------------
+ Evan1 = wvan1*wvan2**12*invrcs12
+ do k=1,3
+ dEvan1Cat(k) = -v2(k)*constdvan1
+ dEvan1Cm(k) = 0.0d0
+ dEvan1Calp(k) = v2(k)*constdvan1
+ enddo
+ Evan2 = -wvan1*wvan2**6*invrcs6
+ do k=1,3
+ dEvan2Cat(k) = v2(k)*constdvan2
+ dEvan2Cm(k) = 0.0d0
+ dEvan2Calp(k) = -v2(k)*constdvan2
+ enddo
+ Edip = wdip1*cosinus*invrcb2-wdip2*(1-cos2)*invrcb4
+ do k=1,3
+ dEdipCat(k) = (-2*wdip1*cosinus*invrcb4 &
+ +4*wdip2*(1-cos2)*invrcb6)*dx(k) &
+ +dcosdcat(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
+ dEdipCm(k) = (2*wdip1*cosinus*invrcb4 &
+ -4*wdip2*(1-cos2)*invrcb6)*dx(k) &
+ +dcosdcm(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
+ dEdipCalp(k) = dcosdcalp(k)*(wdip1*invrcb2 &
+ +2*wdip2*cosinus*invrcb4)
+ enddo
+ if (energy_dec) write (iout,'(2i5,4(a6,f7.3))') i,j, &
+ ' E GB ',Egb,' ECav ',Ecav,' Evdw ',Evan1+Evan2,' Edip ',Edip
+ ecation_nucl=ecation_nucl+Ecav+Egb+Edip+Evan1+Evan2
+ do k=1,3
+ dEtotalCat(k) = dEcavdCat(k)+dEvan1Cat(k)+dEvan2Cat(k) &
+ +dEgbdCat(k)+dEdipCat(k)
+ dEtotalCm(k) = dEcavdCm(k)+dEvan1Cm(k)+dEvan2Cm(k) &
+ +dEgbdCm(k)+dEdipCm(k)
+ dEtotalCalp(k) = dEcavdCalp(k)+dEgbdCalp(k)+dEvan1Calp(k) &
+ +dEdipCalp(k)+dEvan2Calp(k)
+ enddo
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradnuclcatx(k,i)=gradnuclcatx(k,i)+dEtotalCm(k)
+ gradnuclcat(k,i)=gradnuclcat(k,i)+gg(k)
+ gradnuclcat(k,j)=gradnuclcat(k,j)+dEtotalCat(k)
+ enddo
+ enddo !j
+ enddo !i
+ return
+ end subroutine ecat_nucl
+
!-----------------------------------------------------------------------------
- subroutine dEconstrQ_num
-! Calculating numerical dUconst/ddc and dUconst/ddx
-! implicit real*8 (a-h,o-z)
+!-----------------------------------------------------------------------------
+ subroutine eprot_sc_base(escbase)
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.CONTROL'
+! include 'COMMON.GEO'
! include 'COMMON.VAR'
-! include 'COMMON.MD'
- use MD_data
-!#ifndef LANG0
-! include 'COMMON.LANGEVIN'
-!#else
-! include 'COMMON.LANGEVIN.lang0'
-!#endif
+! include 'COMMON.LOCAL'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
+! include 'COMMON.NAMES'
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
-! include 'COMMON.NAMES'
-! include 'COMMON.TIME1'
- real(kind=8) :: uzap1,uzap2
- real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
- integer :: kstart,kend,lstart,lend,idummy
- real(kind=8) :: delta=1.0d-7
+! include 'COMMON.CALC'
+! include 'COMMON.CONTROL'
+! include 'COMMON.SBRIDGE'
+ logical :: lprn
!el local variables
- integer :: i,ii,j
-! real(kind=8) ::
-! For the backbone
- do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
-! Calculating numerical gradients for dU/ddx
- do i=0,nres-1
- duxcartan(j,i)=0.0d0
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
- ifrag(2,ii,iset),.true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
- write(iout,*) "Numerical dUconst/ddc backbone "
- do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
+ 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)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
+! print *,i,j,itypi,itypj
+ d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
+ d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
+! d1i=0.0d0
+! d1j=0.0d0
+! BetaT = 1.0d0 / (298.0d0 * Rb)
+! Gay-berne var's
+ sig0ij = sigma_scbase( itypi,itypj )
+ if (sig0ij.lt.0.2) print *,"KURWA",sig0ij,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=dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ if (b1.eq.0.0d0) sparrow=1.0d0
+ sparrow = 1.0d0 / sparrow
+! write (*,*) "sparrow = ", sparrow,sig1,sig2,b1
+ 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
+ if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
+ "escbase:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escbase
+ if (energy_dec) write (iout,*) "evdwij,", evdwij, 1.0/rij, sig, sig0ij
+ call sc_grad_scbase
+ enddo
enddo
-! write(iout,*) "Numerical dUconst/ddx side-chain "
-! do ii=1,nres
-! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
-! enddo
+
return
- end subroutine dEconstrQ_num
-!-----------------------------------------------------------------------------
-! ssMD.F
-!-----------------------------------------------------------------------------
- subroutine check_energies
+ 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
+ call to_box(xi,yi,zi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
+! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
+! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
+
+! Gay-berne var's
+ sig0ij = sigma_pepbase(itypj )
+ chi1 = chi_pepbase(itypj,1 )
+ chi2 = chi_pepbase(itypj,2 )
+! 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
+ if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
+ "epepbase:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,epepbase
+ call sc_grad_pepbase
+ enddo
+ enddo
+ END SUBROUTINE epep_sc_base
+ SUBROUTINE sc_grad_pepbase
+ use calc_data
-! use random, only: ran_number
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ eom1 = &
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
-! implicit none
-! Includes
+ 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(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
+! 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'
-! include 'COMMON.LOCAL'
-! include 'COMMON.GEO'
-
-! External functions
-!EL double precision ran_number
-!EL external ran_number
-
-! Local variables
- integer :: i,j,k,l,lmax,p,pmax
- real(kind=8) :: rmin,rmax
- real(kind=8) :: eij
+ 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,aa,bb
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
+ integer :: ii
+ real(kind=8) :: fracinbuf
+ real (kind=8) :: escpho
+ real (kind=8),dimension(4):: ener
+ real(kind=8) :: b1,b2,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)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj = dc_norm( 1,j )
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)
- real(kind=8) :: d
- real(kind=8) :: wi,rij,tj,pj
-! return
+! 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)
- i=5
- j=14
+ 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
- d=dsc(1)
- rmin=2.0D0
- rmax=12.0D0
+! 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 )
- lmax=10000
- pmax=1
+ 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
- do k=1,3
- c(k,i)=0.0D0
- c(k,j)=0.0D0
- c(k,nres+i)=0.0D0
- c(k,nres+j)=0.0D0
- enddo
+ 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 )
- do l=1,lmax
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
+!c! & - ( dFdR * ertail(k))
-!t wi=ran_number(0.0D0,pi)
-! wi=ran_number(0.0D0,pi/6.0D0)
-! wi=0.0D0
-!t tj=ran_number(0.0D0,pi)
-!t pj=ran_number(0.0D0,pi)
-! pj=ran_number(0.0D0,pi/6.0D0)
-! pj=0.0D0
+ gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
- do p=1,pmax
-!t rij=ran_number(rmin,rmax)
+ gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
- c(1,j)=d*sin(pj)*cos(tj)
- c(2,j)=d*sin(pj)*sin(tj)
- c(3,j)=d*cos(pj)
+!c! & + ( dFdR * ertail(k))
- c(3,nres+i)=-rij
+ 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(1,i)=d*sin(wi)
- c(3,i)=-rij-d*cos(wi)
+!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))
- do k=1,3
- dc(k,nres+i)=c(k,nres+i)-c(k,i)
- dc_norm(k,nres+i)=dc(k,nres+i)/d
- dc(k,nres+j)=c(k,nres+j)-c(k,j)
- dc_norm(k,nres+j)=dc(k,nres+j)/d
- enddo
+!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
- call dyn_ssbond_ene(i,j,eij)
- enddo
- enddo
- call exit(1)
- return
- end subroutine check_energies
-!-----------------------------------------------------------------------------
- subroutine dyn_ssbond_ene(resi,resj,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
-! External functions
-!EL double precision h_base
-!EL external h_base
+!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)
-! Input arguments
- integer :: resi,resj
+ 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)
-! Output arguments
- real(kind=8) :: eij
+ 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
-! Local variables
- logical :: havebond
- integer itypi,itypj
- real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
- real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
- real(kind=8),dimension(3) :: dcosom1,dcosom2
- real(kind=8) :: ed
- real(kind=8) :: pom1,pom2
- real(kind=8) :: ljA,ljB,ljXs
- real(kind=8),dimension(1:3) :: d_ljB
- real(kind=8) :: ssA,ssB,ssC,ssXs
- real(kind=8) :: ssxm,ljxm,ssm,ljm
- real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
- real(kind=8) :: f1,f2,h1,h2,hd1,hd2
- real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
-!-------FIRST METHOD
- real(kind=8) :: xm
- real(kind=8),dimension(1:3) :: d_xm
-!-------END FIRST METHOD
-!-------SECOND METHOD
-!$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
-!-------END SECOND METHOD
+ 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)
-!-------TESTING CODE
-!el logical :: checkstop,transgrad
-!el common /sschecks/ checkstop,transgrad
+ 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))
- integer :: icheck,nicheck,jcheck,njcheck
- real(kind=8),dimension(-1:1) :: echeck
- real(kind=8) :: deps,ssx0,ljx0
-!-------END TESTING CODE
+! 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
- eij=0.0d0
- i=resi
- j=resj
+ 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
-!el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
-!el allocate(dyn_ssbond_ij(0:nres+4,nres))
- 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)
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1)
+! & - dGLJdR * erhead(k)
- 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)
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- dscj_inv=vbld_inv(j+nres)
+ 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
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
+! & + dGLJdR * erhead(k)
+! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
-! The following are set in sc_angular
-! 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
- rij=1.0D0/rij ! Reset this so it makes sense
+ 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
- sig0ij=sigma(itypi,itypj)
- sig=sig0ij*dsqrt(1.0D0/sigsq)
+ enddo
- ljXs=sig-sig0ij
- ljA=eps1*eps2rt**2*eps3rt**2
- 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)
+ return
+ end subroutine eprot_sc_phosphate
+ SUBROUTINE sc_grad_scpho
+ use calc_data
- ssXs=d0cm
- deltat1=1.0d0-om1
- deltat2=1.0d0+om2
- deltat12=om2-om1+2.0d0
- cosphi=om12-om1*om2
- ssA=akcm
- ssB=akct*deltat12
- ssC=ss_depth &
- +akth*(deltat1*deltat1+deltat2*deltat2) &
- +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
- ssxm=ssXs-0.5D0*ssB/ssA
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ eom1 = &
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
-!-------TESTING CODE
-!$$$c Some extra output
-!$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
-!$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
-!$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
-!$$$ if (ssx0.gt.0.0d0) then
-!$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
-!$$$ else
-!$$$ ssx0=ssxm
-!$$$ endif
-!$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-!$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
-!$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
-!$$$ return
-!-------END TESTING CODE
+ eom2 = &
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
-!-------TESTING CODE
-! Stop and plot energy and derivative as a function of distance
- if (checkstop) then
- ssm=ssC-0.25D0*ssB*ssB/ssA
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- if (ssm.lt.ljm .and. &
- dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
- nicheck=1000
- njcheck=1
- deps=0.5d-7
- else
- checkstop=.false.
- endif
- endif
- if (.not.checkstop) then
- nicheck=0
- njcheck=-1
- endif
+ 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(kind=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
+ call to_box(xi,yi,zi)
+
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=xj**2+yj**2+zj**2
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ dxj = dc_norm( 1,j )
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)/2.0
+! Gay-berne var's
+ sig0ij = sigma_peppho
+! 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!-------------------------------------------------------------------
- do icheck=0,nicheck
- do jcheck=-1,njcheck
- if (checkstop) rij=(ssxm-1.0d0)+ &
- ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
-!-------END TESTING CODE
+!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))
- if (rij.gt.ljxm) then
- havebond=.false.
- ljd=rij-ljXs
- fac=(1.0D0/ljd)**expon
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- eij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=eij*eps3rt
- eps3der=eij*eps2rt
- eij=eij*eps2rt*eps3rt
+!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
- sigder=-sig/sigsq
- e1=e1*eps1*eps2rt**2*eps3rt**2
- ed=-expon*(e1+eij)/ljd
- sigder=ed*sigder
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
- -2.0D0*alf12*eps3der+sigder*sigsq_om12
- else if (rij.lt.ssxm) then
- havebond=.true.
- ssd=rij-ssXs
- eij=ssA*ssd*ssd+ssB*ssd+ssC
-
- ed=2*akcm*ssd+akct*deltat12
- pom1=akct*ssd
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
- else
- omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
+ 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
+ if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
+ "epeppho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,epeppho
- d_ssxm(1)=0.5D0*akct/ssA
- d_ssxm(2)=-d_ssxm(1)
- d_ssxm(3)=0.0D0
+ 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(kind=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,countss
+ real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
+ real(kind=8) :: evdw,aa,bb
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
+ integer :: ii,icont
+ 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)
+ evdw=0.0d0
+ eps_out=80.0d0
+ sss_ele_cut=1.0d0
+ countss=0
+! print *,"EVDW KURW",evdw,nres
+! do i=iatsc_s,iatsc_e
+! print *,"I am in EVDW",i
+ do icont=g_listscsc_start,g_listscsc_end
+ i=newcontlisti(icont)
+ j=newcontlistj(icont)
- d_ljxm(1)=sig0ij/sqrt(sigsq**3)
- d_ljxm(2)=d_ljxm(1)*sigsq_om2
- d_ljxm(3)=d_ljxm(1)*sigsq_om12
- d_ljxm(1)=d_ljxm(1)*sigsq_om1
+ 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)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+! endif
+! print *, sslipi,ssgradlipi
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+! 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,countss)
+ 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
-!-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
- xm=0.5d0*(ssxm+ljxm)
- do k=1,3
- d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
- enddo
- if (rij.lt.xm) then
- havebond=.true.
- ssm=ssC-0.25D0*ssB*ssB/ssA
- d_ssm(1)=0.5D0*akct*ssB/ssA
- d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
- d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
- d_ssm(3)=omega
- f1=(rij-xm)/(ssxm-xm)
- f2=(rij-ssxm)/(xm-ssxm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=ssm*h1+Ht*h2
- delta_inv=1.0d0/(xm-ssxm)
- deltasq_inv=delta_inv*delta_inv
- fac=ssm*hd1-Ht*hd2
- fac1=deltasq_inv*fac*(xm-rij)
- fac2=deltasq_inv*fac*(rij-ssxm)
- ed=delta_inv*(Ht*hd2-ssm*hd1)
- eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
- eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
- eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
- else
- havebond=.false.
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
- d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
- d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
- alf12/eps3rt)
- d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
- f1=(rij-ljxm)/(xm-ljxm)
- f2=(rij-xm)/(ljxm-xm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=Ht*h1+ljm*h2
- delta_inv=1.0d0/(ljxm-xm)
- deltasq_inv=delta_inv*delta_inv
- fac=Ht*hd1-ljm*hd2
- fac1=deltasq_inv*fac*(ljxm-rij)
- fac2=deltasq_inv*fac*(rij-xm)
- ed=delta_inv*(ljm*hd2-Ht*hd1)
- eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
- eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
- eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
- endif
-!-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
+!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
-!-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
-!$$$ ssd=rij-ssXs
-!$$$ ljd=rij-ljXs
-!$$$ fac1=rij-ljxm
-!$$$ fac2=rij-ssxm
-!$$$
-!$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
-!$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
-!$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
-!$$$
-!$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
-!$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
-!$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
-!$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
-!$$$ d_ssm(3)=omega
-!$$$
-!$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
-!$$$ do k=1,3
-!$$$ d_ljm(k)=ljm*d_ljB(k)
-!$$$ enddo
-!$$$ ljm=ljm*ljB
-!$$$
-!$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
-!$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
-!$$$ d_ss(2)=akct*ssd
-!$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
-!$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
-!$$$ d_ss(3)=omega
-!$$$
-!$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
-!$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
-!$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
-!$$$ do k=1,3
-!$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
-!$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
-!$$$ enddo
-!$$$ ljf=ljm+ljf*ljB*fac1*fac1
-!$$$
-!$$$ f1=(rij-ljxm)/(ssxm-ljxm)
-!$$$ f2=(rij-ssxm)/(ljxm-ssxm)
-!$$$ h1=h_base(f1,hd1)
-!$$$ h2=h_base(f2,hd2)
-!$$$ eij=ss*h1+ljf*h2
-!$$$ delta_inv=1.0d0/(ljxm-ssxm)
-!$$$ deltasq_inv=delta_inv*delta_inv
-!$$$ fac=ljf*hd2-ss*hd1
-!$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
-!$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
-!$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
-!$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
-!$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
-!$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
-!$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
-!$$$
-!$$$ havebond=.false.
-!$$$ if (ed.gt.0.0d0) havebond=.true.
-!-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
+!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)
- endif
+! 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)
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! write(iout,*) "KRUWA", i,j
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ Rreal(1)=xj
+ Rreal(2)=yj
+ Rreal(3)=zj
+ 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
- if (havebond) then
-!#ifndef CLUST
-!#ifndef WHAM
-! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
-! write(iout,'(a15,f12.2,f8.1,2i5)')
-! & "SSBOND_E_FORM",totT,t_bath,i,j
-! endif
-!#endif
-!#endif
- dyn_ssbond_ij(i,j)=eij
- else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
- dyn_ssbond_ij(i,j)=1.0d300
-!#ifndef CLUST
-!#ifndef WHAM
-! write(iout,'(a15,f12.2,f8.1,2i5)')
-! & "SSBOND_E_BREAK",totT,t_bath,i,j
-!#endif
-!#endif
- endif
+ 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
+ call to_box (ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box (ctail(1,2),ctail(2,2),ctail(3,2))
-!-------TESTING CODE
-!el if (checkstop) then
- if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
- "CHECKSTOP",rij,eij,ed
- echeck(jcheck)=eij
-!el endif
- enddo
- if (checkstop) then
- write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
- endif
- enddo
- if (checkstop) then
- transgrad=.true.
- checkstop=.false.
- endif
-!-------END TESTING CODE
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail_distance(1)=boxshift(ctail( 1, 2 ) - ctail( 1,1 ),boxxsize)
+ Rtail_distance(2)=boxshift(ctail( 2, 2 ) - ctail( 2,1 ),boxysize)
+ Rtail_distance(3)=boxshift(ctail( 3, 2 ) - ctail( 3,1 ),boxzsize)
+ 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
- dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
- dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
- enddo
- do k=1,3
- gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k) &
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k) &
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ 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
enddo
-!grad do k=i,j-1
-!grad do l=1,3
-!grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-!grad enddo
-!grad enddo
+ if (energy_dec) write(iout,*) "before",chead(1,1),chead(2,1),chead(3,1)
+ if (energy_dec) write(iout,*) "before",chead(1,2),chead(2,2),chead(3,2)
+ call to_box (chead(1,1),chead(2,1),chead(3,1))
+ call to_box (chead(1,2),chead(2,2),chead(3,2))
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
- enddo
+!c! head distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ if (energy_dec) write(iout,*) "after",chead(1,1),chead(2,1),chead(3,1)
+ if (energy_dec) write(iout,*) "after",chead(1,2),chead(2,2),chead(3,2)
- 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
+ Rhead_distance(1)=boxshift(chead( 1, 2 ) - chead( 1,1 ),boxxsize)
+ Rhead_distance(2)=boxshift(chead( 2, 2 ) - chead( 2,1 ),boxysize)
+ Rhead_distance(3)=boxshift(chead( 3, 2 ) - chead( 3,1 ),boxzsize)
+ if (energy_dec) write(iout,*) "after,rdi",(Rhead_distance(k),k=1,3)
+! 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)
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+! sss_ele_cut=1.0d0
+! sss_ele_grad=0.0d0
+! print *,sss_ele_cut,sss_ele_grad,&
+! 1.0d0/(rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
-!c Input arguments
- integer resi,resj,resk,m,itypi,itypj,itypk
+!----------------------------
+ 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
-!c Output arguments
- double precision eij,eij1,eij2,eij3
+! 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)
-!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)
+! 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*sss_ele_cut
+!#endif
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- dscj_inv=vbld_inv(j+nres)
- itypk=itype(k,1)
- xk=c(1,nres+k)
- yk=c(2,nres+k)
- zk=c(3,nres+k)
+ 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*sss_ele_cut
+ gg(2) = fac*sss_ele_cut
+ gg(3) = fac*sss_ele_cut
+! 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
- 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
+ dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
+ dbot = 12.0d0 * b4cav * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut
+ 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 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
+ 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)&
+ -sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij)
+!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) &
+ +sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij)
+!c! & + ( dFdR * pom )
+ gvdwc(k,i) = gvdwc(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k)) &
+ -sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij)
-!-----------------------------------------------------------------------------
- real(kind=8) function h_base(x,deriv)
-! A smooth function going 0->1 in range [0,1]
-! It should NOT be called outside range [0,1], it will not work there.
- implicit none
+!c! & - ( dFdR * ertail(k))
-! Input arguments
- real(kind=8) :: x
+ gvdwc(k,j) = gvdwc(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k)) &
+ +sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij)
+
+!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
-! Output arguments
- real(kind=8) :: deriv
+ isel = iabs(Qi) + iabs(Qj)
+! double charge for Phophorylated! itype - 25,27,27
+! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
+! Qi=Qi*2
+! Qij=Qij*2
+! endif
+! if ((itype(j).eq.27).or.(itype(j).eq.26).or.(itype(j).eq.25)) then
+! Qj=Qj*2
+! Qij=Qij*2
+! endif
-! Local variables
- real(kind=8) :: xsq
+! isel=0
+! if (isel.eq.2) isel=0
+! if (isel.eq.3) isel=0
+! if (iabs(Qj).eq.1) isel=0
+! nstate(itypi,itypj)=1
+ 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
-! Two parabolas put together. First derivative zero at extrema
-!$$$ if (x.lt.0.5D0) then
-!$$$ h_base=2.0D0*x*x
-!$$$ deriv=4.0D0*x
-!$$$ else
-!$$$ deriv=1.0D0-x
-!$$$ h_base=1.0D0-2.0D0*deriv*deriv
-!$$$ deriv=4.0D0*deriv
-!$$$ endif
+ ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
+!c! Charge-nonpolar interactions
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
-! Third degree polynomial. First derivative zero at extrema
- h_base=x*x*(3.0d0-2.0d0*x)
- deriv=6.0d0*x*(1.0d0-x)
+ CALL eqn(epol)
+ eheadtail = epol
+! eheadtail = 0.0d0
-! Fifth degree polynomial. First and second derivatives zero at extrema
-!$$$ xsq=x*x
-!$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
-!$$$ deriv=x-1.0d0
-!$$$ deriv=deriv*deriv
-!$$$ deriv=30.0d0*xsq*deriv
+ ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
+!c! Nonpolar-charge interactions
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
- return
- end function h_base
-!-----------------------------------------------------------------------------
- subroutine dyn_set_nss
-! Adjust nss and other relevant variables based on dyn_ssbond_ij
-! implicit none
- use MD_data, only: totT,t_bath
-! Includes
-! include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.SETUP'
-! include 'COMMON.MD'
-! Local variables
- real(kind=8) :: emin
- integer :: i,j,imin,ierr
- integer :: diff,allnss,newnss
- integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
- newihpb,newjhpb
- logical :: found
- integer,dimension(0:nfgtasks) :: i_newnss
- integer,dimension(0:nfgtasks) :: displ
- integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
- integer :: g_newnss
+ CALL enq(epol)
+ eheadtail = epol
+! eheadtail = 0.0d0
- allnss=0
- do i=1,nres-1
- do j=i+1,nres
- if (dyn_ssbond_ij(i,j).lt.1.0d300) then
- allnss=allnss+1
- allflag(allnss)=0
- allihpb(allnss)=i
- alljhpb(allnss)=j
- endif
- enddo
- enddo
+ ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
+!c! Charge-dipole interactions
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
-!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+ CALL eqd(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+! eheadtail = 0.0d0
- 1 emin=1.0d300
- do i=1,allnss
- if (allflag(i).eq.0 .and. &
- dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
- emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
- imin=i
- endif
- enddo
- if (emin.lt.1.0d300) then
- allflag(imin)=1
- do i=1,allnss
- if (allflag(i).eq.0 .and. &
- (allihpb(i).eq.allihpb(imin) .or. &
- alljhpb(i).eq.allihpb(imin) .or. &
- allihpb(i).eq.alljhpb(imin) .or. &
- alljhpb(i).eq.alljhpb(imin))) then
- allflag(i)=-1
- endif
- enddo
- goto 1
- endif
+ ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
+!c! Dipole-charge interactions
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+ CALL edq(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+! eheadtail = 0.0d0
-!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
+ ELSE IF ((isel.eq.2.and. &
+ iabs(Qi).eq.1).and. &
+ nstate(itypi,itypj).eq.1) THEN
+!c! Same charge-charge interaction ( +/+ or -/- )
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
- newnss=0
- do i=1,allnss
- if (allflag(i).eq.1) then
- newnss=newnss+1
- newihpb(newnss)=allihpb(i)
- newjhpb(newnss)=alljhpb(i)
- endif
- enddo
+ CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
+! eheadtail = 0.0d0
-#ifdef MPI
- if (nfgtasks.gt.1)then
+ ELSE IF ((isel.eq.2.and. &
+ iabs(Qi).eq.1).and. &
+ nstate(itypi,itypj).ne.1) THEN
+!c! Different charge-charge interaction ( +/- or -/+ )
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
- call MPI_Reduce(newnss,g_newnss,1,&
- MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Gather(newnss,1,MPI_INTEGER,&
- i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
- displ(0)=0
- do i=1,nfgtasks-1,1
- displ(i)=i_newnss(i-1)+displ(i-1)
- enddo
- call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
- g_newihpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
- g_newjhpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- if(fg_rank.eq.0) then
-! print *,'g_newnss',g_newnss
-! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
-! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
- newnss=g_newnss
- do i=1,newnss
- newihpb(i)=g_newihpb(i)
- newjhpb(i)=g_newjhpb(i)
- enddo
- endif
- endif
-#endif
+ CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
+ END IF
+ END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
+ evdw = evdw + Fcav*sss_ele_cut + eheadtail*sss_ele_cut
- diff=newnss-nss
+ 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
-!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)
-#endif
-#endif
- enddo
+ 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
- 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)
-#endif
-#endif
- enddo
+ 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,debkap,sgrad
+! 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)
- nss=newnss
- do i=1,nss
- idssb(i)=newihpb(i)
- jdssb(i)=newjhpb(i)
- enddo
+!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))
- return
- end subroutine dyn_set_nss
-! 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
+!c!-------------------------------------------------------------------
+!c! Coulomb electrostatic interaction
+ Ecl = (332.0d0 * Qij) / Rhead
+!c! derivative of Ecl is Gcl...
+ dGCLdR = (-332.0d0 * Qij ) / Rhead_sq*sss_ele_cut
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ debkap=debaykap(itypi,itypj)
+ Egb = -(332.0d0 * Qij *&
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
+! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
+!c! Derivative of Egb is Ggb...
+ dGGBdFGB = -(-332.0d0 * Qij * &
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
+ -(332.0d0 * Qij *&
+ (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
+ dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
+ dGGBdR = dGGBdFGB * dFGBdR*sss_ele_cut
+!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*sss_ele_cut
+!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*sss_ele_cut
+!c! dPOLdR1 = 0.0d0
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
+!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)))*sss_ele_cut
+!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
- 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
+ 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 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! 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)))
+ sgrad=(Ecl+Egb+Epol+Fisocav+Elj)*sss_ele_grad*rreal(k)*rij
+ 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-sgrad
-!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)
+ 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+sgrad
+
+ 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)-sgrad
+
+ 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)+sgrad
-!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"
+ END DO
+ RETURN
+ END SUBROUTINE eqq
+
+ SUBROUTINE eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
+ use calc_data
+ use comm_momo
+ real (kind=8) :: facd3, facd4, federmaus, adler,&
+ Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
+! integer :: k
+!c! Epol and Gpol analytical parameters
+ alphapol1 = alphapolcat(itypi,itypj)
+ alphapol2 = alphapolcat2(itypj,itypi)
+!c! Fisocav and Gisocav analytical parameters
+ al1 = alphisocat(1,itypi,itypj)
+ al2 = alphisocat(2,itypi,itypj)
+ al3 = alphisocat(3,itypi,itypj)
+ al4 = alphisocat(4,itypi,itypj)
+ csig = (1.0d0 &
+ / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 &
+ + sigiso2cat(itypi,itypj)**2.0d0))
+!c!
+ pis = sig0headcat(itypi,itypj)
+ eps_head = epsheadcat(itypi,itypj)
+ Rhead_sq = Rhead * Rhead
+!c! R1 - distance between head of ith side chain and tail of jth sidechain
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ 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))
- 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!-------------------------------------------------------------------
+!c! Coulomb electrostatic interaction
+ Ecl = (332.0d0 * Qij) / Rhead
+!c! derivative of Ecl is Gcl...
+ dGCLdR = (-332.0d0 * Qij ) / Rhead_sq*sss_ele_cut+ECL*sss_ele_grad
+ ECL=ECL*sss_ele_cut
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ debkap=debaykapcat(itypi,itypj)
+ if (energy_dec) write(iout,*) "egb",Qij,debkap,Fgb,a12sq,ee0
+ Egb = -(332.0d0 * Qij *&
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
+! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
+!c! Derivative of Egb is Ggb...
+ dGGBdFGB = -(-332.0d0 * Qij * &
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
+ -(332.0d0 * Qij *&
+ (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
+ dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
+ dGGBdR = dGGBdFGB * dFGBdR*sss_ele_cut+Egb*sss_ele_grad
+ Egb=Egb*sss_ele_grad
+!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*sss_ele_cut&
+ +FisoCav*sss_ele_grad
+ FisoCav=FisoCav*sss_ele_cut
+!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!*sss_ele_cut+epol*sss_ele_grad
+!c! dPOLdR1 = 0.0d0
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2!*sss_ele_cut+epol*sss_ele_grad
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.0d0
+ dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+! epol=epol*sss_ele_cut
+!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)))*sss_ele_cut&
+ +(Elj+epol)*sss_ele_grad
+ Elj=Elj*sss_ele_cut
+ epol=epol*sss_ele_cut
+!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
-!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
+ 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) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ facd4 = dtailcat(2,itypi,itypj) * vbld_inv(j)
-!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! 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)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom&
+ - dGGBdR * pom&
+ - dGCVdR * pom&
+ - dPOLdR1 * hawk&
+ - dPOLdR2 * (erhead_tail(k,2)&
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
+ - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepcatx(k,j) = gradpepcatx(k,j)+ dGCLdR * pom&
+! + dGGBdR * pom+ dGCVdR * pom&
+! + dPOLdR1 * (erhead_tail(k,1)&
+! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))&
+! + dPOLdR2 * condor + dGLJdR * pom
+
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k)
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2)&
+ + dGLJdR * erhead(k)
+ END DO
+ RETURN
+ END SUBROUTINE eqq_cat
+!c!-------------------------------------------------------------------
+ SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
+ use comm_momo
+ use calc_data
-!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
+ 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,sgrad
+ 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)*sss_ele_cut &
+ + (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)*sss_ele_cut &
+ + (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
+!c! this acts on Calpha
+ gvdwc(k,i)=gvdwc(k,i)-gg(k)*sss_ele_cut
+ gvdwc(k,j)=gvdwc(k,j)+gg(k)*sss_ele_cut
+ 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)
+! distance
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
+ call to_box (chead(1,1),chead(2,1),chead(3,1))
+ call to_box (chead(1,2),chead(2,2),chead(3,2))
-!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
+!c! head distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
- 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
+ Rhead_distance(1)=boxshift(chead( 1, 2 ) - chead( 1,1 ),boxxsize)
+ Rhead_distance(2)=boxshift(chead( 2, 2 ) - chead( 2,1 ),boxysize)
+ Rhead_distance(3)=boxshift(chead( 3, 2 ) - chead( 3,1 ),boxzsize)
+! 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)))
+
+! 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
- 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
+!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))
- 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)
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+!c! this acts on hydrophobic center of interaction
+! sgrad=sss_ele_grad*(Ecl+Egb+FisoCav+epol+Elj)*rij*rreal(k)
+ 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*sss_ele_cut
- 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
+ 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*sss_ele_cut
- 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
-
- 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
+!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
- Etube=0.0d0
-! print *,itube_start,itube_end,"poczatek"
- do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ 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)*sss_ele_cut
+ gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)*sss_ele_cut
+ gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)*sss_ele_cut
+ gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)*sss_ele_cut
+ DO l = 1, 4
+ gheadtail(k,l,1) = 0.0d0
+ gheadtail(k,l,2) = 0.0d0
+ END DO
+ END DO
+ eheadtail = (-dlog(eheadtail)) / betaT
+ do k=1,3
+ gvdwx(k,i) = gvdwx(k,i) - eheadtail*sss_ele_grad*rreal(k)*rij
+ gvdwx(k,j) = gvdwx(k,j) + eheadtail*sss_ele_grad*rreal(k)*rij
+ gvdwc(k,i) = gvdwc(k,i) - eheadtail*sss_ele_grad*rreal(k)*rij
+ gvdwc(k,j) = gvdwc(k,j) + eheadtail*sss_ele_grad*rreal(k)*rij
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
+ 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)
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
+!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*sss_ele_cut
+! epol=epol*sss_ele_cut
+!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)
- 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
+ DO k = 1, 3
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- vectube(1)=vectube(1)-tubecenter(1)
- vectube(2)=vectube(2)-tubecenter(2)
- vectube(3)=vectube(3)-tubecenter(3)
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR1 * hawk-epol*sss_ele_grad*rreal(k)*rij
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR1 * (erhead_tail(k,1) &
+ -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
+ +epol*sss_ele_grad*rreal(k)*rij
-!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
+ gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)&
+ -epol*sss_ele_grad*rreal(k)*rij
+ gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)&
+ +epol*sss_ele_grad*rreal(k)*rij
- 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
+ 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 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! 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*sss_ele_cut
+! epol=epol*sss_ele_cut
+!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)))
-!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
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
+ -epol*sss_ele_grad*rreal(k)*rij
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR2 * condor+epol*sss_ele_grad*rreal(k)*rij
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dPOLdR2 * erhead_tail(k,2)-epol*sss_ele_grad*rreal(k)*rij
- 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
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dPOLdR2 * erhead_tail(k,2)+epol*sss_ele_grad*rreal(k)*rij
-! 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
+ END DO
+ RETURN
+ END SUBROUTINE enq
- 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
- ishield_list(i)=0
- do j=1,3
- grad_shield(j,i)=0.0d0
- enddo
- enddo
- do i=ivec_start,ivec_end
-!C do i=1,nres-1
-!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
+ SUBROUTINE enq_cat(Epol)
+ use calc_data
+ use comm_momo
+ double precision facd3, adler,epol
+ alphapol2 = alphapolcat(itypi,itypj)
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ R2 = dsqrt(R2)
-!C 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)
+!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*sss_ele_cut+epol*sss_ele_grad
+ epol=epol*sss_ele_cut
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
- 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
+!c!-------------------------------------------------------------------
+!c! Return the results
+!c! (See comments in Eqq)
+ DO k = 1, 3
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd2 = d2 * vbld_inv(j+nres)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ DO k = 1, 3
+ condor = (erhead_tail(k,2) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
-!-----------------------------------------------------------------------------
-#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
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
+! gradpepcatx(k,j) = gradpepcatx(k,j) &
+! + dPOLdR2 * condor
- 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
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dPOLdR2 * erhead_tail(k,2)
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dPOLdR2 * erhead_tail(k,2)
- 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
+ END DO
+ RETURN
+ END SUBROUTINE enq_cat
- 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
-!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
-!----------------------
-! arrays in subroutine init_int_table
-!el#ifdef MPI
-!el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
-!el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
-!el#endif
- allocate(nint_gr(nres))
- allocate(nscp_gr(nres))
- allocate(ielstart(nres))
- allocate(ielend(nres))
-!(maxres)
- allocate(istart(nres,maxint_gr))
- allocate(iend(nres,maxint_gr))
-!(maxres,maxint_gr)
- allocate(iscpstart(nres,maxint_gr))
- allocate(iscpend(nres,maxint_gr))
-!(maxres,maxint_gr)
- 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))
+ SUBROUTINE eqd(Ecl,Elj,Epol)
+ use calc_data
+ use comm_momo
+ double precision facd4, federmaus,ecl,elj,epol,sgrad
+ 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)
- allocate(lentyp(0:nfgtasks-1))
-!(0:maxprocs-1)
-!----------------------
-! commom.contacts
-! common /contacts/
- if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
- allocate(icont(2,maxcont))
-!(2,maxcont)
-! common /contacts1/
- allocate(num_cont(0:nres+4))
-!(maxres)
- allocate(jcont(maxconts,nres))
-!(maxconts,maxres)
- allocate(facont(maxconts,nres))
-!(maxconts,maxres)
- allocate(gacont(3,maxconts,nres))
-!(3,maxconts,maxres)
-! common /contacts_hb/
- allocate(gacontp_hb1(3,maxconts,nres))
- allocate(gacontp_hb2(3,maxconts,nres))
- allocate(gacontp_hb3(3,maxconts,nres))
- allocate(gacontm_hb1(3,maxconts,nres))
- allocate(gacontm_hb2(3,maxconts,nres))
- allocate(gacontm_hb3(3,maxconts,nres))
- allocate(gacont_hbr(3,maxconts,nres))
- 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)
- allocate(jcont_hb(maxconts,nres))
-!(maxconts,maxres)
-! common /rotat/
- allocate(Ug(2,2,nres))
- allocate(Ugder(2,2,nres))
- allocate(Ug2(2,2,nres))
- allocate(Ug2der(2,2,nres))
-!(2,2,maxres)
- allocate(obrot(2,nres))
- allocate(obrot2(2,nres))
- allocate(obrot_der(2,nres))
- allocate(obrot2_der(2,nres))
-!(2,maxres)
-! common /precomp1/
- allocate(mu(2,nres))
- allocate(muder(2,nres))
- allocate(Ub2(2,nres))
- Ub2(1,:)=0.0d0
- Ub2(2,:)=0.0d0
- allocate(Ub2der(2,nres))
- allocate(Ctobr(2,nres))
- allocate(Ctobrder(2,nres))
- allocate(Dtobr2(2,nres))
- allocate(Dtobr2der(2,nres))
-!(2,maxres)
- allocate(EUg(2,2,nres))
- allocate(EUgder(2,2,nres))
- allocate(CUg(2,2,nres))
- allocate(CUgder(2,2,nres))
- allocate(DUg(2,2,nres))
- allocate(Dugder(2,2,nres))
- allocate(DtUg2(2,2,nres))
- allocate(DtUg2der(2,2,nres))
-!(2,2,maxres)
-! common /precomp2/
- allocate(Ug2Db1t(2,nres))
- allocate(Ug2Db1tder(2,nres))
- allocate(CUgb2(2,nres))
- allocate(CUgb2der(2,nres))
-!(2,maxres)
- allocate(EUgC(2,2,nres))
- allocate(EUgCder(2,2,nres))
- allocate(EUgD(2,2,nres))
- allocate(EUgDder(2,2,nres))
- allocate(DtUg2EUg(2,2,nres))
- allocate(Ug2DtEUg(2,2,nres))
-!(2,2,maxres)
- allocate(Ug2DtEUgder(2,2,2,nres))
- allocate(DtUg2EUgder(2,2,2,nres))
-!(2,2,2,maxres)
-! common /rotat_old/
- allocate(costab(nres))
- allocate(sintab(nres))
- allocate(costab2(nres))
- allocate(sintab2(nres))
-!(maxres)
-! common /dipmat/
- allocate(a_chuj(2,2,maxconts,nres))
-!(2,2,maxconts,maxres)(maxconts=maxres/4)
- allocate(a_chuj_der(2,2,3,5,maxconts,nres))
-!(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
-! common /contdistrib/
- allocate(ncont_sent(nres))
- allocate(ncont_recv(nres))
+!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)*sss_ele_cut
+!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*sss_ele_cut
+!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)))*sss_ele_cut
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ END DO
- allocate(iat_sent(nres))
-!(maxres)
- allocate(iint_sent(4,nres,nres))
- allocate(iint_sent_local(4,nres,nres))
-!(4,maxres,maxres)
- allocate(iturn3_sent(4,0:nres+4))
- allocate(iturn4_sent(4,0:nres+4))
- allocate(iturn3_sent_local(4,nres))
- allocate(iturn4_sent_local(4,nres))
-!(4,maxres)
- allocate(itask_cont_from(0:nfgtasks-1))
- allocate(itask_cont_to(0:nfgtasks-1))
-!(0:max_fg_procs-1)
+ 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)))
+ sgrad=(epol+elj+ecl)*sss_ele_grad*rreal(k)*rij
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dGCLdR * pom&
+ - dPOLdR1 * hawk &
+ - dGLJdR * pom &
+ -sgrad
+
+ 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+sgrad
-!----------------------
-! commom.deriv;
-! common /derivat/
- allocate(dcdv(6,maxdim))
- allocate(dxdv(6,maxdim))
-!(6,maxdim)
- allocate(dxds(6,nres))
-!(6,maxres)
- allocate(gradx(3,-1:nres,0:2))
- allocate(gradc(3,-1:nres,0:2))
-!(3,maxres,2)
- 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,maxcontsshi,-1:nres))
- allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
-! grad for shielding surroing
- allocate(gloc(0:maxvar,0:2))
- allocate(gloc_x(0:maxvar,2))
-!(maxvar,2)
- 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(gel_loc_turn4(maxvar))
- allocate(gel_loc_turn6(maxvar))
- allocate(gcorr_loc(maxvar))
- allocate(g_corr5_loc(maxvar))
- allocate(g_corr6_loc(maxvar))
-!(maxvar)
- allocate(gsccorc(3,-1:nres))
- allocate(gsccorx(3,-1:nres))
-!(3,maxres)
- allocate(gsccor_loc(-1:nres))
-!(maxres)
- 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))
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1) &
+ - dGLJdR * erhead(k)-sgrad
- allocate(dtheta(3,2,-1:nres))
-!(3,2,maxres)
- allocate(gscloc(3,-1:nres))
- allocate(gsclocx(3,-1:nres))
-!(3,maxres)
- 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))
- allocate(dYY_C1tab(3,nres))
- allocate(dZZ_C1tab(3,nres))
- allocate(dXX_Ctab(3,nres))
- allocate(dYY_Ctab(3,nres))
- allocate(dZZ_Ctab(3,nres))
- allocate(dXX_XYZtab(3,nres))
- allocate(dYY_XYZtab(3,nres))
- allocate(dZZ_XYZtab(3,nres))
-!(3,maxres)
-! common /mpgrad/
- allocate(jgrad_start(nres))
- allocate(jgrad_end(nres))
-!(maxres)
-!----------------------
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dGLJdR * erhead(k)+sgrad
-! common /indices/
- allocate(ibond_displ(0:nfgtasks-1))
- allocate(ibond_count(0:nfgtasks-1))
- allocate(ithet_displ(0:nfgtasks-1))
- allocate(ithet_count(0:nfgtasks-1))
- allocate(iphi_displ(0:nfgtasks-1))
- allocate(iphi_count(0:nfgtasks-1))
- allocate(iphi1_displ(0:nfgtasks-1))
- allocate(iphi1_count(0:nfgtasks-1))
- allocate(ivec_displ(0:nfgtasks-1))
- allocate(ivec_count(0:nfgtasks-1))
- allocate(iset_displ(0:nfgtasks-1))
- allocate(iset_count(0:nfgtasks-1))
- allocate(iint_count(0:nfgtasks-1))
- allocate(iint_displ(0:nfgtasks-1))
-!(0:max_fg_procs-1)
-!----------------------
-! common.MD
-! common /mdgrad/
- allocate(gcart(3,-1:nres))
- allocate(gxcart(3,-1:nres))
-!(3,0:MAXRES)
- 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)
- allocate(dutheta(nres))
- allocate(dugamma(nres))
-!(maxres)
- allocate(duscdiff(3,nres))
- allocate(duscdiffx(3,nres))
-!(3,maxres)
-!el i io:read_fragments
-! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
-! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
-! common /qmeas/
-! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
-! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
- allocate(mset(0:nprocs)) !(maxprocs/20)
- mset(:)=0
-! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
-! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
- allocate(dUdconst(3,0:nres))
- allocate(dUdxconst(3,0:nres))
- allocate(dqwol(3,0:nres))
- allocate(dxqwol(3,0:nres))
-!(3,0:MAXRES)
-!----------------------
-! common.sbridge
-! common /sbridge/ in io_common: read_bridge
-!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
-! common /dyn_ssbond/
-! and side-chain vectors in theta or phi.
- allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
-!(maxres,maxres)
-! do i=1,nres
-! do j=i+1,nres
- dyn_ssbond_ij(:,:)=1.0d300
-! enddo
-! enddo
+ END DO
+ RETURN
+ END SUBROUTINE eqd
+
+ SUBROUTINE eqd_cat(Ecl,Elj,Epol)
+ use calc_data
+ use comm_momo
+ double precision facd4, federmaus,ecl,elj,epol
+ alphapol1 = alphapolcat(itypi,itypj)
+ w1 = wqdipcat(1,itypi,itypj)
+ w2 = wqdipcat(2,itypi,itypj)
+ pis = sig0headcat(itypi,itypj)
+ eps_head = epsheadcat(itypi,itypj)
+! eps_head=0.0d0
+! w2=0.0d0
+! alphapol1=0.0d0
+!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 =sss_ele_cut*(-2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0)+sss_ele_grad*ECL
+ ECL=ECL*sss_ele_cut
+!c! dF/dom1
+ dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = 0.0d0 !
+
+!(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 = 0.0d0 ! as om2 is 0
+! (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
+! * (2.0d0 - 0.5d0 * ee1) ) &
+! / (2.0d0 * fgb1)
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut+epol*sss_ele_grad
+!c! dPOLdR1 = 0.0d0
+ dPOLdOM1 = 0.0d0
+! dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+ dPOLdOM2 = 0.0d0
+ epol=epol*sss_ele_cut
+!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*sss_ele_cut &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))+Elj*sss_ele_grad
+ Elj=Elj*sss_ele_cut
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ END DO
-! if (nss.gt.0) then
- allocate(idssb(maxdim),jdssb(maxdim))
-! allocate(newihpb(nss),newjhpb(nss))
-!(maxdim)
-! endif
- allocate(ishield_list(-1:nres))
- allocate(shield_list(maxcontsshi,-1:nres))
- allocate(dyn_ss_mask(nres))
- allocate(fac_shield(-1:nres))
- allocate(enetube(nres*2))
- allocate(enecavtube(nres*2))
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
-!(maxres)
- dyn_ss_mask(:)=.false.
-!----------------------
-! common.sccor
-! Parameters of the SCCOR term
-! common/sccor/
-!el in io_conf: parmread
-! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
-! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
-! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
-! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
-! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
-! 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(gloc_sc(3,0:2*nres,0:10))
-!(3,0:maxres2,10)maxres2=2*maxres
- allocate(dcostau(3,3,3,2*nres))
- allocate(dsintau(3,3,3,2*nres))
- allocate(dtauangle(3,3,3,2*nres))
- allocate(dcosomicron(3,3,3,2*nres))
- allocate(domicron(3,3,3,2*nres))
-!(3,3,3,maxres2)maxres2=2*maxres
-!----------------------
-! common.var
-! common /restr/
- allocate(varall(maxvar))
-!(maxvar)(maxvar=6*maxres)
- allocate(mask_theta(nres))
- allocate(mask_phi(nres))
- allocate(mask_side(nres))
-!(maxres)
-!----------------------
-! common.vectors
-! common /vectors/
- allocate(uy(3,nres))
- allocate(uz(3,nres))
-!(3,maxres)
- allocate(uygrad(3,3,2,nres))
- allocate(uzgrad(3,3,2,nres))
-!(3,3,2,maxres)
+ DO k = 1, 3
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- 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)
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom&
+ - dPOLdR1 * hawk &
+ - dGLJdR * pom
- 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
+! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+! gradpepcatx(k,j) = gradpepcatx(k,j) &
+! + dGCLdR * pom &
+! + dPOLdR1 * (erhead_tail(k,1) &
+! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
+! + dGLJdR * pom
- 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)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1) &
+ - dGLJdR * erhead(k)
- 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
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dGLJdR * erhead(k)
-!-----------------------------------------------------------------------------
- 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
+ END DO
+ RETURN
+ END SUBROUTINE eqd_cat
+
+ SUBROUTINE edq(Ecl,Elj,Epol)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
+
+ double precision facd3, adler,ecl,elj,epol,sgrad
+ alphapol2 = alphapol(itypj,itypi)
+ w1 = wqdip(1,itypi,itypj)
+ w2 = wqdip(2,itypi,itypj)
+ pis = sig0head(itypi,itypj)
+ eps_head = epshead(itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ R2 = dsqrt(R2)
+
+!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
+!c! & +dhead(1,1,itypi,itypj))**2))
+!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
+!c! & +dhead(2,1,itypi,itypj))**2))
+
+
+!c!-------------------------------------------------------------------
+!c! ecl
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+ ECL = sparrow / Rhead**2.0d0 &
+ - hawk / Rhead**4.0d0
+!c!-------------------------------------------------------------------
+!c! derivative of ecl is Gcl
+!c! dF/dr part
+ dGCLdR =sss_ele_cut*(- 2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0)
+!c! dF/dom1
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
+!c Polarization energy
+!c Epol
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR2 = R2 * R2 / MomoFac2
+ ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
+ fgb2 = sqrt(RR2 + a12sq * ee2)
+ epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
+ / (fgb2 ** 5.0d0)
+ dFGBdR2 = ( (R2 / MomoFac2) &
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
+!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)))*sss_ele_cut
+!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)))
+ sgrad=(epol+elj+ecl)*sss_ele_grad*rreal(k)*rij
+ 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-sgrad
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR2 * condor &
+ + dGLJdR * pom+sgrad
- 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
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k)-sgrad
+
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)+sgrad
+
+ END DO
+ RETURN
+ END SUBROUTINE edq
+
+ SUBROUTINE edq_cat(Ecl,Elj,Epol)
+ use comm_momo
+ use calc_data
+
+ double precision facd3, adler,ecl,elj,epol
+ alphapol2 = alphapolcat(itypi,itypj)
+ w1 = wqdipcat(1,itypi,itypj)
+ w2 = wqdipcat(2,itypi,itypj)
+ pis = sig0headcat(itypi,itypj)
+ eps_head = epsheadcat(itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ 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))
-!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)
+!c!-------------------------------------------------------------------
+!c! ecl
+! write(iout,*) "KURWA2",Rhead
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+ ECL = sparrow / Rhead**2.0d0 &
+ - hawk / Rhead**4.0d0
+!c!-------------------------------------------------------------------
+!c! derivative of ecl is Gcl
+!c! dF/dr part
+ dGCLdR =( - 2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0)*sss_ele_cut+ECL*sss_ele_grad
+!c! dF/dom1
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+ ECL=ECL*sss_ele_cut
+!c--------------------------------------------------------------------
+!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*sss_ele_cut+epol*sss_ele_grad
+!c! dPOLdR2 = 0.0d0
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+!c! dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+ epol=epol*sss_ele_cut
+!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)))*sss_ele_cut+&
+ Elj*sss_ele_grad
+ Elj=Elj*sss_ele_cut
+!c!-------------------------------------------------------------------
- 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
+!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) )
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ DO k = 1, 3
+ condor = (erhead_tail(k,2) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
- 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
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
+ - dGLJdR * pom
- 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
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepcatx(k,j) = gradpepcatx(k,j) &
+! + dGCLdR * pom &
+! + dPOLdR2 * condor &
+! + dGLJdR * pom
-!------------------------------------------------------
- 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
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k)
- 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
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)
- if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
- 'evdw',i,j,evdwij,"tu3"
+ END DO
+ RETURN
+ END SUBROUTINE edq_cat
+ SUBROUTINE edq_cat_pep(Ecl,Elj,Epol)
+ use comm_momo
+ use calc_data
-!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
+ double precision facd3, adler,ecl,elj,epol
+ alphapol2 = alphapolcat(itypi,itypj)
+ w1 = wqdipcat(1,itypi,itypj)
+ w2 = wqdipcat(2,itypi,itypj)
+ pis = sig0headcat(itypi,itypj)
+ eps_head = epsheadcat(itypi,itypj)
+!c!-------------------------------------------------------------------
+!c! R2 - distance between head of jth side chain and tail of ith sidechain
+ R2 = 0.0d0
+ DO k = 1, 3
+!c! Calculate head-to-tail distances
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ R2 = dsqrt(R2)
+
+!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
+!c! & +dhead(1,1,itypi,itypj))**2))
+!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
+!c! & +dhead(2,1,itypi,itypj))**2))
+
+
+!c!-------------------------------------------------------------------
+!c! ecl
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+! print *,"CO2", itypi,itypj
+! print *,"CO?!.", w1,w2,Qj,om1
+ 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)*sss_ele_cut+&
+ ECL*sss_ele_grad
+ ECL=ECL*sss_ele_cut
+!c! dF/dom1
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
+!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*sss_ele_cut+epol*sss_ele_grad
+ epol=epol*sss_ele_grad
+!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*sss_ele_cut &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))+Elj*sss_ele_grad
+ Elj=Elj*sss_ele_cut
+!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) )
+ erdxj = scalar( erhead(1), dC_norm(1,j) )
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i) )
+ facd1 = d1 * vbld_inv(i+1)/2.0
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+1)/2.0
+ DO k = 1, 3
+ condor = (erhead_tail(k,2) &
+ + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i))
+! gradpepcatx(k,i) = gradpepcatx(k,i) &
+! - dGCLdR * pom &
+! - dPOLdR2 * (erhead_tail(k,2) &
+! -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
+! - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepcatx(k,j) = gradpepcatx(k,j) &
+! + dGCLdR * pom &
+! + dPOLdR2 * condor &
+! + dGLJdR * pom
+
+
+ gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))
+ gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))
+
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)
+
+ END DO
+ RETURN
+ END SUBROUTINE edq_cat_pep
+
+ SUBROUTINE edd(ECL)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
-!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
+ 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)*sss_ele_cut!+ECL*sss_ele_grad
+!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
- 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
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i)- dGCLdR * pom-(ecl*sss_ele_grad*Rreal(k)*rij)
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom+(ecl*sss_ele_grad*Rreal(k)*rij)
-!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
+ gvdwc(k,i) = gvdwc(k,i)- dGCLdR * erhead(k)-(ecl*sss_ele_grad*Rreal(k)*rij)
+ gvdwc(k,j) = gvdwc(k,j)+ dGCLdR * erhead(k)+(ecl*sss_ele_grad*Rreal(k)*rij)
+ END DO
+ RETURN
+ END SUBROUTINE edd
+ SUBROUTINE edd_cat(ECL)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
- 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
+ double precision ecl
+!c! csig = sigiso(itypi,itypj)
+ w1 = wqdipcat(1,itypi,itypj)
+ w2 = wqdipcat(2,itypi,itypj)
+! w2=0.0d0
+!c!-------------------------------------------------------------------
+!c! ECL
+! print *,"om1",om1,om2,om12
+ fac = - 3.0d0 * om1 !after integer and simplify
+ c1 = (w1 / (Rhead**3.0d0)) * fac
+ c2 = (w2 / Rhead ** 6.0d0) &
+ * (4.0d0 + 6.0d0*sqom1 ) !after integration and simplification
+ ECL = c1 - c2
+!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 + 6.0d0*sqom1)
+ dGCLdR = (c1 - c2)*sss_ele_cut+ECL*sss_ele_grad
+!c! dECL/dom1
+ c1 = (-3.0d0 * w1) / (Rhead**3.0d0)
+ c2 = (12.0d0 * w2*om1) / (Rhead**6.0d0)
+ dGCLdOM1 = c1 - c2
+!c! dECL/dom2
+! c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
+ c1=0.0 ! this is because om2 is 0
+! c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
+! * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ c2=0.0 !om is 0
+ dGCLdOM2 = c1 - c2
+!c! dECL/dom12
+! c1 = w1 / (Rhead ** 3.0d0)
+ c1=0.0d0 ! this is because om12 is 0
+! c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
+ c2=0.0d0 !om12 is 0
+ 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
-!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
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) - dGCLdR * pom
+! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+! gradpepcatx(k,j) = gradpepcatx(k,j) + dGCLdR * pom
- 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
+ gradpepcat(k,i) = gradpepcat(k,i) - dGCLdR * erhead(k)
+ gradpepcat(k,j) = gradpepcat(k,j) + dGCLdR * erhead(k)
+ END DO
+ RETURN
+ END SUBROUTINE edd_cat
+ SUBROUTINE edd_cat_pep(ECL)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
- 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
+ double precision ecl
+!c! csig = sigiso(itypi,itypj)
+ w1 = wqdipcat(1,itypi,itypj)
+ w2 = wqdipcat(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! 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)*sss_ele_cut+ECL*sss_ele_grad
+ ECL=ECL*sss_ele_cut
+!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
+ dGCLdOM2=0.0d0 ! this is because om2=0
+!c! dECL/dom12
+ c1 = w1 / (Rhead ** 3.0d0)
+ c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
+ dGCLdOM12 = c1 - c2
+ dGCLdOM12=0.0d0 !this is because om12=0.0
+!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) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ facd1 = d1 * vbld_inv(i)
+ facd2 = d2 * vbld_inv(j+nres)
+ DO k = 1, 3
- 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)
+ pom = facd1*(erhead(k)-erdxi*dC_norm(k,i))
+ gradpepcat(k,i) = gradpepcat(k,i) + dGCLdR * pom
+ gradpepcat(k,i+1) = gradpepcat(k,i+1) - dGCLdR * pom
+! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+! gradpepcatx(k,j) = gradpepcatx(k,j) + dGCLdR * pom
+
+ gradpepcat(k,i) = gradpepcat(k,i) - dGCLdR * erhead(k)*0.5d0
+ gradpepcat(k,i+1) = gradpepcat(k,i+1)- dGCLdR * erhead(k)*0.5d0
+ gradpepcat(k,j) = gradpepcat(k,j) + dGCLdR * erhead(k)
+ END DO
+ RETURN
+ END SUBROUTINE edd_cat_pep
+
+ 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)
-!C to check gradient call subroutine check_grad
+ 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
- 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
+ SUBROUTINE elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ use comm_momo
+ use calc_data
+ real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
+ eps_out=80.0d0
+ itypi = itype(i,1)
+ itypj = itype(j,5)
+!c! 1/(Gas Constant * Thermostate temperature) = BetaT
+!c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
+!c! t_bath = 300
+!c! BetaT = 1.0d0 / (t_bath * Rb)i
+ Rb=0.001986d0
+ BetaT = 1.0d0 / (298.0d0 * Rb)
+!c! Gay-berne var's
+ sig0ij = sigmacat( itypi,itypj )
+ chi1 = chi1cat( itypi, itypj )
+ chi2 = 0.0d0
+ chi12 = 0.0d0
+ chip1 = chipp1cat( itypi, itypj )
+ chip2 = 0.0d0
+ chip12 = 0.0d0
+!c! not used by momo potential, but needed by sc_angular which is shared
+!c! by all energy_potential subroutines
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ dxj = 0.0d0 !dc_norm( 1, nres+j )
+ dyj = 0.0d0 !dc_norm( 2, nres+j )
+ dzj = 0.0d0 !dc_norm( 3, nres+j )
+!c! distance from center of chain(?) to polar/charged head
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
+!c! ai*aj from Fgb
+ a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
+!c! a12sq = a12sq * a12sq
+!c! charge of amino acid itypi is...
+ Qi = icharge(itypi)
+ Qj = ichargecat(itypj)
+ Qij = Qi * Qj
+!c! chis1,2,12
+ chis1 = chis1cat(itypi,itypj)
+ chis2 = 0.0d0
+ chis12 = 0.0d0
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2 = sigmap2cat(itypi,itypj)
+!c! alpha factors from Fcav/Gcav
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+ wqd = wquadcat(itypi, itypj)
+!c! used by Fgb
+ eps_in = epsintabcat(itypi,itypj)
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+!c!-------------------------------------------------------------------
+!c! tail location and distance calculations
+ Rtail = 0.0d0
+ DO k = 1, 3
+ ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
+ END DO
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
+ Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
+ Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+!c!-------------------------------------------------------------------
+!c! Calculate location and distance between polar heads
+!c! distance between heads
+!c! for each one of our three dimensional space...
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
- 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
-!-------------------------------------------------------------------------
+ DO k = 1,3
+!c! location of polar head is computed by taking hydrophobic centre
+!c! and moving by a d1 * dc_norm vector
+!c! see unres publications for very informative images
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
+!c! distance
+!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
+ END DO
+!c! pitagoras (root of sum of squares)
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+!c!-------------------------------------------------------------------
+!c! zero everything that should be zero'ed
+ Egb = 0.0d0
+ ECL = 0.0d0
+ Elj = 0.0d0
+ Equad = 0.0d0
+ Epol = 0.0d0
+ eheadtail = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+ dPOLdOM1 = 0.0d0
+ dPOLdOM2 = 0.0d0
+ RETURN
+ END SUBROUTINE elgrad_init_cat
- 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
+ SUBROUTINE elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ use comm_momo
+ use calc_data
+ real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
+ eps_out=80.0d0
+ itypi = 10
+ itypj = itype(j,5)
+!c! 1/(Gas Constant * Thermostate temperature) = BetaT
+!c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
+!c! t_bath = 300
+!c! BetaT = 1.0d0 / (t_bath * Rb)i
+ Rb=0.001986d0
+ BetaT = 1.0d0 / (298.0d0 * Rb)
+!c! Gay-berne var's
+ sig0ij = sigmacat( itypi,itypj )
+ chi1 = chi1cat( itypi, itypj )
+ chi2 = 0.0d0
+ chi12 = 0.0d0
+ chip1 = chipp1cat( itypi, itypj )
+ chip2 = 0.0d0
+ chip12 = 0.0d0
+!c! not used by momo potential, but needed by sc_angular which is shared
+!c! by all energy_potential subroutines
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ dxj = 0.0d0 !dc_norm( 1, nres+j )
+ dyj = 0.0d0 !dc_norm( 2, nres+j )
+ dzj = 0.0d0 !dc_norm( 3, nres+j )
+!c! distance from center of chain(?) to polar/charged head
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
+!c! ai*aj from Fgb
+ a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
+!c! a12sq = a12sq * a12sq
+!c! charge of amino acid itypi is...
+ Qi = 0
+ Qj = ichargecat(itypj)
+! Qij = Qi * Qj
+!c! chis1,2,12
+ chis1 = chis1cat(itypi,itypj)
+ chis2 = 0.0d0
+ chis12 = 0.0d0
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2 = sigmap2cat(itypi,itypj)
+!c! alpha factors from Fcav/Gcav
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+ wqd = wquadcat(itypi, itypj)
+!c! used by Fgb
+ eps_in = epsintabcat(itypi,itypj)
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+!c!-------------------------------------------------------------------
+!c! tail location and distance calculations
+ Rtail = 0.0d0
+ DO k = 1, 3
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i)
+ ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
+ END DO
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
+ Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
+ Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+!c!-------------------------------------------------------------------
+!c! Calculate location and distance between polar heads
+!c! distance between heads
+!c! for each one of our three dimensional space...
+ d1 = dheadcat(1, 1, itypi, itypj)
+ d2 = dheadcat(2, 1, itypi, itypj)
- 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
+ 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)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
+ chead(k,2) = c(k, j)
+!c! distance
+!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
+ 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_cat_pep
-! 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
+ double precision function tschebyshev(m,n,x,y)
+ implicit none
+ integer i,m,n
+ double precision x(n),y,yy(0:maxvar),aux
+!c Tschebyshev polynomial. Note that the first term is omitted
+!c m=0: the constant term is included
+!c m=1: the constant term is not included
+ yy(0)=1.0d0
+ yy(1)=y
+ do i=2,n
+ yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
+ enddo
+ aux=0.0d0
+ do i=m,n
+ aux=aux+x(i)*yy(i)
+ enddo
+ tschebyshev=aux
+ return
+ end function tschebyshev
+!C--------------------------------------------------------------------------
+ double precision function gradtschebyshev(m,n,x,y)
+ implicit none
+ integer i,m,n
+ double precision x(n+1),y,yy(0:maxvar),aux
+!c Tschebyshev polynomial. Note that the first term is omitted
+!c m=0: the constant term is included
+!c m=1: the constant term is not included
+ yy(0)=1.0d0
+ yy(1)=2.0d0*y
+ do i=2,n
+ yy(i)=2*y*yy(i-1)-yy(i-2)
+ enddo
+ aux=0.0d0
+ do i=m,n
+ aux=aux+x(i+1)*yy(i)*(i+1)
+!C print *, x(i+1),yy(i),i
+ enddo
+ gradtschebyshev=aux
+ return
+ end function gradtschebyshev
+!!!!!!!!!--------------------------------------------------------------
+ subroutine lipid_bond(elipbond)
+ real(kind=8) :: elipbond,fac,dist_sub,sumdist
+ real(kind=8), dimension(3):: dist
+ integer(kind=8) :: i,j,k,ibra,ityp,jtyp,ityp1
+ elipbond=0.0d0
+! print *,"before",ilipbond_start,ilipbond_end
+ do i=ilipbond_start,ilipbond_end
+! print *,i,i+1,"i,i+1"
+ ityp=itype(i,4)
+ ityp1=itype(i+1,4)
+! print *,ityp,ityp1,"itype"
+ j=i+1
+ if (ityp.eq.12) ibra=i
+ if ((ityp.eq.ntyp1_molec(4)).or.(ityp1.ge.ntyp1_molec(4)-1)) cycle
+ if (ityp.eq.(ntyp1_molec(4)-1)) then
+ !cofniecie do ostatnie GL1
+! i=ibra
+ j=ibra
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
+ j=i
+ endif
+ jtyp=itype(j,4)
do k=1,3
- dcmag=dcmag+dc(k,i)**2
+ dist(k)=c(k,j)-c(k,i+1)
enddo
- dcmag=dsqrt(dcmag)
+ sumdist=0.0d0
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
+ sumdist=sumdist+dist(k)**2
enddo
+ dist_sub=sqrt(sumdist)
+! print *,"before",i,j,ityp1,ityp,jtyp
+ elipbond=elipbond+kbondlip*((dist_sub-lip_bond(jtyp,ityp1))**2)
+ fac=kbondlip*(dist_sub-lip_bond(jtyp,ityp1))
+ do k=1,3
+ gradlipbond(k,i+1)= gradlipbond(k,i+1)-fac*dist(k)/dist_sub
+ gradlipbond(k,j)=gradlipbond(k,j)+fac*dist(k)/dist_sub
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)
- vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
- vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
- vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
+ if (energy_dec) write(iout,*) "lipbond",j,i+1,dist_sub,lip_bond(jtyp,ityp1),kbondlip,fac
+ enddo
+ elipbond=elipbond*0.5d0
+ return
+ end subroutine lipid_bond
+!---------------------------------------------------------------------------------------
+ subroutine lipid_angle(elipang)
+ real(kind=8) :: elipang,alfa,xa(3),xb(3),alfaact,alfa0,force,fac,&
+ scalara,vnorm,wnorm,sss,sss_grad,eangle
+ integer :: i,j,k,l,m,ibra,ityp1,itypm1,itypp1
+ elipang=0.0d0
+! print *,"ilipang_start,ilipang_end",ilipang_start,ilipang_end
+ do i=ilipang_start,ilipang_end
+! do i=4,4
+
+! the loop is centered on the central residue
+ itypm1=itype(i-1,4)
+ ityp1=itype(i,4)
+ itypp1=itype(i+1,4)
+! print *,i,i,j,"processor",fg_rank
+ j=i-1
+ k=i
+ l=i+1
+ if (ityp1.eq.12) ibra=i
+ if ((itypm1.eq.ntyp1_molec(4)).or.(ityp1.eq.ntyp1_molec(4))&
+ .or.(itypp1.eq.ntyp1_molec(4))) cycle !cycle if any of the angles is dummy
+ if ((itypm1.eq.ntyp1_molec(4)-1).or.(itypp1.eq.ntyp1_molec(4)-1)) cycle
+ ! branching is only to one angle
+ if (ityp1.eq.ntyp1_molec(4)-1) then
+ k=ibra
+ j=ibra-1
+ endif
+ itypm1=itype(j,4)
+ ityp1=itype(k,4)
+ do m=1,3
+ xa(m)=c(m,j)-c(m,k)
+ xb(m)=c(m,l)-c(m,k)
+! xb(m)=1.0d0
+ enddo
+ vnorm=dsqrt(xa(1)*xa(1)+xa(2)*xa(2)+xa(3)*xa(3))
+ wnorm=dsqrt(xb(1)*xb(1)+xb(2)*xb(2)+xb(3)*xb(3))
+ scalara=(xa(1)*xb(1)+xa(2)*xb(2)+xa(3)*xb(3))/(vnorm*wnorm)
+! if (((scalar*scalar).gt.0.99999999d0).and.(alfa0.eq.180.0d0)) cycle
+
+ alfaact=scalara
+! sss=sscale_martini_angle(alfaact)
+! sss_grad=sscale_grad_martini_angle(alfaact)
+! print *,sss_grad,"sss_grad",sss
+! if (sss.le.0.0) cycle
+! if (sss_grad.ne.0.0) print *,sss_grad,"sss_grad"
+ force=lip_angle_force(itypm1,ityp1,itypp1)
+ alfa0=lip_angle_angle(itypm1,ityp1,itypp1)
+ eangle=force*(alfaact-dcos(alfa0))*(alfaact-dcos(alfa0))*0.5d0
+ elipang=elipang+eangle!*(1001.0d0-1000.0d0*sss)
+ fac=force*(alfaact-dcos(alfa0))!*(1001.0d0-1000.0d0*sss)-sss_grad*eangle*1000.0d0
+ do m=1,3
+ gradlipang(m,j)=gradlipang(m,j)+(fac &!/dsqrt(1.0d0-scalar*scalar)&
+ *(xb(m)-scalara*wnorm*xa(m)/vnorm)&
+ /(vnorm*wnorm))!-sss_grad*eangle*xa(m)/vnorm
-! valpha(k)=c(k,i)
-! vcat(k)=c(k,j)
- if (subchap.eq.1) then
- vcat(1)=xj_temp
- vcat(2)=yj_temp
- vcat(3)=zj_temp
- else
- vcat(1)=xj_safe
- vcat(2)=yj_safe
- vcat(3)=zj_safe
- endif
- valpha(1)=xi-c(1,i+nres)+c(1,i)
- valpha(2)=yi-c(2,i+nres)+c(2,i)
- valpha(3)=zi-c(3,i+nres)+c(3,i)
+ gradlipang(m,l)=gradlipang(m,l)+(fac & !/dsqrt(1.0d0-scalar*scalar)&
+ *(xa(m)-scalara*vnorm*xb(m)/wnorm)&
+ /(vnorm*wnorm))!+sss_grad*eangle*xb(m)/wnorm
-! 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)
+ gradlipang(m,k)=gradlipang(m,k)-(fac)& !/dsqrt(1.0d0-scalar*scalar)&
+ *(xb(m)-scalara*wnorm*xa(m)/vnorm)&
+ /((vnorm*wnorm))-(fac & !/dsqrt(1.0d0-scalar*scalar)&
+ *(xa(m)-scalara*vnorm*xb(m)/wnorm)&
+ /(vnorm*wnorm))!-sss_grad*eangle*xa(m)/vnorm&
+ !-sss_grad*eangle*xb(m)/wnorm
-! 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.0d0-wquad2
- wvan1 = vcatprm(5)
- wvan2 =vcatprm(6)
- opt = dx(1)**2+dx(2)**2
- rsecp = opt+dx(3)**2
- rs = sqrt(rsecp)
- rthrp = rsecp*rs
- rfourp = rthrp*rs
- rsixp = rfourp*rsecp
- reight=rsixp*rsecp
- Ir = 1.0d0/rs
- Irsecp = 1.0d0/rsecp
- Irthrp = Irsecp/rs
- Irfourp = Irthrp/rs
- Irsixp = 1.0d0/rsixp
- Ireight=1.0d0/reight
- Irtw=Irsixp*Irsixp
- Irthir=Irtw/rs
- Irfourt=Irthir/rs
- opt1 = (4*rs*dx(3)*wdip)
- opt2 = 6*rsecp*wquad1*opt
- opt3 = wquad1*wquad2p*Irsixp
- opt4 = (wvan1*wvan2**12)
- opt5 = opt4*12*Irfourt
- opt6 = 2*wvan1*wvan2**6
- opt7 = 6*opt6*Ireight
- opt8 = wdip/v1m
- opt10 = wdip/v2m
- opt11 = (rsecp*v2m)**2
- opt12 = (rsecp*v1m)**2
- opt14 = (v1m*v2m*rsecp)**2
- opt15 = -wquad1/v2m**2
- opt16 = (rthrp*(v1m*v2m)**2)**2
- opt17 = (v1m**2*rthrp)**2
- opt18 = -wquad1/rthrp
- opt19 = (v1m**2*v2m**2)**2
- Ec = wc*Ir
- do k=1,3
- dEcCat(k) = -(dx(k)*wc)*Irthrp
- dEcCm(k)=(dx(k)*wc)*Irthrp
- dEcCalp(k)=0.0d0
- enddo
- Edip=opt8*(v1dpv2)/(rsecp*v2m)
- do k=1,3
- dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
- *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
- dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
- *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
- dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
- *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
- *v1dpv2)/opt14
- enddo
- Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
- do k=1,3
- dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
- (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
- v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
- dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
- (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
- v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
- dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
- v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
- v1dpv2**2)/opt19
- enddo
- Equad2=wquad1*wquad2p*Irthrp
- do k=1,3
- dEquad2Cat(k)=-3*dx(k)*rs*opt3
- dEquad2Cm(k)=3*dx(k)*rs*opt3
- dEquad2Calp(k)=0.0d0
- enddo
- Evan1=opt4*Irtw
- do k=1,3
- dEvan1Cat(k)=-dx(k)*opt5
- dEvan1Cm(k)=dx(k)*opt5
- dEvan1Calp(k)=0.0d0
- enddo
- Evan2=-opt6*Irsixp
- do k=1,3
- dEvan2Cat(k)=dx(k)*opt7
- dEvan2Cm(k)=-dx(k)*opt7
- dEvan2Calp(k)=0.0d0
+
+! *(xb(m)*vnorm*wnorm)&
+
+!-xa(m)*xa(m)*xb(m)*wnorm/vnorm)&
+ enddo
+ if (energy_dec) write(iout,*) "elipang",j,k,l,force,alfa0,alfaact,elipang
+ enddo
+ return
+ end subroutine lipid_angle
+!--------------------------------------------------------------------
+ subroutine lipid_lj(eliplj)
+ real(kind=8) :: eliplj,fac,sumdist,dist_sub,LJ1,LJ2,LJ,&
+ xj,yj,zj,xi,yi,zi,sss,sss_grad
+ real(kind=8), dimension(3):: dist
+ integer :: i,j,k,inum,ityp,jtyp
+ eliplj=0.0d0
+ do inum=iliplj_start,iliplj_end
+ i=mlipljlisti(inum)
+ j=mlipljlistj(inum)
+! print *,inum,i,j,"processor",fg_rank
+ ityp=itype(i,4)
+ jtyp=itype(j,4)
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
+ call to_box(xi,yi,zi)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist(1)=xj
+ dist(2)=yj
+ dist(3)=zj
+ ! do k=1,3
+ ! dist(k)=c(k,j)-c(k,i)
+ ! enddo
+ sumdist=0.0d0
+ do k=1,3
+ sumdist=sumdist+dist(k)**2
+ enddo
+
+ dist_sub=sqrt(sumdist)
+ sss=sscale_martini(dist_sub)
+ if (energy_dec) write(iout,*) "LJ LIP bef",i,j,ityp,jtyp,dist_sub
+ if (sss.le.0.0) cycle
+ sss_grad=sscale_grad_martini(dist_sub)
+ LJ1 = (lip_sig(ityp,jtyp)/dist_sub)**6
+ LJ2 = LJ1**2
+ LJ = LJ2 - LJ1
+ LJ = 4.0d0*lip_eps(ityp,jtyp)*LJ
+ eliplj = eliplj + LJ*sss
+ fac=4.0d0*lip_eps(ityp,jtyp)*(-6.0d0*LJ1/dist_sub+12.0d0*LJ2/dist_sub)
+ do k=1,3
+ gradliplj(k,i)=gradliplj(k,i)+fac*dist(k)/dist_sub*sss-sss_grad*LJ*dist(k)/dist_sub
+ gradliplj(k,j)=gradliplj(k,j)-fac*dist(k)/dist_sub*sss+sss_grad*LJ*dist(k)/dist_sub
+ enddo
+ if (energy_dec) write(iout,'(a7,4i5,2f8.3)') "LJ LIP",i,j,ityp,jtyp,LJ,dist_sub
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)
+ return
+ end subroutine lipid_lj
+!--------------------------------------------------------------------------------------
+ subroutine lipid_elec(elipelec)
+ real(kind=8) :: elipelec,fac,sumdist,dist_sub,xj,yj,zj,xi,yi,zi,EQ,&
+ sss,sss_grad
+ real(kind=8), dimension(3):: dist
+ integer :: i,j,k,inum,ityp,jtyp
+ elipelec=0.0d0
+! print *,"processor",fg_rank,ilip_elec_start,ilipelec_end
+ do inum=ilip_elec_start,ilipelec_end
+ i=mlipeleclisti(inum)
+ j=mlipeleclistj(inum)
+! print *,inum,i,j,"processor",fg_rank
+ ityp=itype(i,4)
+ jtyp=itype(j,4)
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
+ call to_box(xi,yi,zi)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist(1)=xj
+ dist(2)=yj
+ dist(3)=zj
+! do k=1,3
+! dist(k)=c(k,j)-c(k,i)
+! enddo
+ sumdist=0.0d0
+ do k=1,3
+ sumdist=sumdist+dist(k)**2
+ enddo
+ dist_sub=sqrt(sumdist)
+ sss=sscale_martini(dist_sub)
+! print *,sss,dist_sub
+ if (energy_dec) write(iout,*) "EQ LIP",sss,dist_sub,i,j
+ if (sss.le.0.0) cycle
+ sss_grad=sscale_grad_martini(dist_sub)
+! print *,"sss",sss,sss_grad
+ EQ=k_coulomb_lip*(ichargelipid(ityp)*ichargelipid(jtyp)/dist_sub)
+ elipelec=elipelec+EQ*sss
+ fac=k_coulomb_lip*(ichargelipid(ityp)*ichargelipid(jtyp)/sumdist)*sss
+ do k=1,3
+ gradlipelec(k,i)=gradlipelec(k,i)+fac*dist(k)/dist_sub&
+ -sss_grad*EQ*dist(k)/dist_sub
+ gradlipelec(k,j)=gradlipelec(k,j)-fac*dist(k)/dist_sub&
+ +sss_grad*EQ*dist(k)/dist_sub
+ enddo
+ if (energy_dec) write(iout,*) "EQ LIP",i,j,ityp,jtyp,EQ,dist_sub,elipelec
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
+ return
+ end subroutine lipid_elec
+!-------------------------------------------------------------------------
+ subroutine make_SCSC_inter_list
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: dist_init, dist_temp,r_buff_list
+ integer:: contlisti(250*nres),contlistj(250*nres)
+! integer :: newcontlisti(200*nres),newcontlistj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_sc,g_ilist_sc
+ integer displ(0:nprocs),i_ilist_sc(0:nprocs),ierr
+! print *,"START make_SC"
+ r_buff_list=5.0
+ ilist_sc=0
+ do i=iatsc_s,iatsc_e
+ itypi=iabs(itype(i,1))
+ if (itypi.eq.ntyp1) cycle
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ do iint=1,nint_gr(i)
+! print *,"is it wrong", iint,i
+ do j=istart(i,iint),iend(i,iint)
+ itypj=iabs(itype(j,1))
+ if (energy_dec) write(iout,*) "LISTA ZAKRES",istart(i,iint),iend(i,iint),iatsc_s,iatsc_e
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+! dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+! r_buff_list is a read value for a buffer
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_sc=ilist_sc+1
+! this can be substituted by cantor and anti-cantor
+ contlisti(ilist_sc)=i
+ contlistj(ilist_sc)=j
+
+ endif
+ enddo
+ enddo
+ enddo
+! call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+! MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! call MPI_Gather(newnss,1,MPI_INTEGER,&
+! i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_sc
+ do i=1,ilist_sc
+ write (iout,*) i,contlisti(i),contlistj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_sc,1,MPI_INTEGER,&
+ i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_sc(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,&
+ newcontlisti,i_ilist_sc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,&
+ newcontlistj,i_ilist_sc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ else
+ g_ilist_sc=ilist_sc
+
+ do i=1,ilist_sc
+ newcontlisti(i)=contlisti(i)
+ newcontlistj(i)=contlistj(i)
+ enddo
+ endif
+
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_sc
+ do i=1,g_ilist_sc
+ write (iout,*) i,newcontlisti(i),newcontlistj(i)
+ enddo
+#endif
+ call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
+ return
+ end subroutine make_SCSC_inter_list
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ subroutine make_SCp_inter_list
+ use MD_data, only: itime_mat
+
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: dist_init, dist_temp,r_buff_list
+ integer:: contlistscpi(350*nres),contlistscpj(350*nres)
+! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_scp,g_ilist_scp
+ integer displ(0:nprocs),i_ilist_scp(0:nprocs),ierr
+! print *,"START make_SC"
+ r_buff_list=5.0
+ ilist_scp=0
+ do i=iatscp_s,iatscp_e
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ xi=0.5D0*(c(1,i)+c(1,i+1))
+ yi=0.5D0*(c(2,i)+c(2,i+1))
+ zi=0.5D0*(c(3,i)+c(3,i+1))
+ call to_box(xi,yi,zi)
+ do iint=1,nscp_gr(i)
+
+ do j=iscpstart(i,iint),iscpend(i,iint)
+ itypj=iabs(itype(j,1))
+ if (itypj.eq.ntyp1) cycle
+! Uncomment following three lines for SC-p interactions
+! xj=c(1,nres+j)-xi
+! yj=c(2,nres+j)-yi
+! zj=c(3,nres+j)-zi
+! Uncomment following three lines for Ca-p interactions
+! xj=c(1,j)-xi
+! yj=c(2,j)-yi
+! zj=c(3,j)-zi
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+#ifdef DEBUG
+ ! r_buff_list is a read value for a buffer
+ if ((sqrt(dist_init).le.(r_cut_ele)).and.(ifirstrun.eq.0)) then
+! Here the list is created
+ ilist_scp_first=ilist_scp_first+1
+! this can be substituted by cantor and anti-cantor
+ contlistscpi_f(ilist_scp_first)=i
+ contlistscpj_f(ilist_scp_first)=j
endif
- do k=1,6
- vcatprm(k)=catprm(k,inum)
- enddo
- dASGL=catprm(7,inum)
-! do k=1,3
-! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
-! valpha(k)=c(k,i)
-! vcat(k)=c(k,j)
-! enddo
- vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
- vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
- vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
- if (subchap.eq.1) then
- vcat(1)=xj_temp
- vcat(2)=yj_temp
- vcat(3)=zj_temp
- else
- vcat(1)=xj_safe
- vcat(2)=yj_safe
- vcat(3)=zj_safe
- endif
- valpha(1)=xi-c(1,i+nres)+c(1,i)
- valpha(2)=yi-c(2,i+nres)+c(2,i)
- valpha(3)=zi-c(3,i+nres)+c(3,i)
+#endif
+! r_buff_list is a read value for a buffer
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_scp=ilist_scp+1
+! this can be substituted by cantor and anti-cantor
+ contlistscpi(ilist_scp)=i
+ contlistscpj(ilist_scp)=j
+ endif
+ enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_scp
+ do i=1,ilist_scp
+ write (iout,*) i,contlistscpi(i),contlistscpj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+ call MPI_Reduce(ilist_scp,g_ilist_scp,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_scp,1,MPI_INTEGER,&
+ i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_scp(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,&
+ newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,&
+ newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
- 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)
-! TU SPRAWDZ???
-! dscvec(1) = xj
-! dscvec(2) = yj
-! dscvec(3) = zj
+ else
+ g_ilist_scp=ilist_scp
- dscmag = dscmag+dscvec(k)*dscvec(k)
- enddo
- dscmag3 = dscmag
- dscmag = sqrt(dscmag)
- dscmag3 = dscmag3*dscmag
- constA = 1+dASGL/dscmag
- constB = 0.0d0
- do k=1,3
- constB = constB+dscvec(k)*dEtotalCm(k)
- enddo
- constB = constB*dASGL/dscmag3
- do k=1,3
- gg(k) = dEtotalCm(k)+dEtotalCalp(k)
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- constA*dEtotalCm(k)-constB*dscvec(k)
- gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
- gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
- enddo
- else
- rcal = 0.0d0
- do k=1,3
-! r(k) = c(k,j)-c(k,i+nres)
- r(1) = xj
- r(2) = yj
- r(3) = zj
- rcal = rcal+r(k)*r(k)
- enddo
- ract=sqrt(rcal)
- rocal=1.5
- epscalc=0.2
- r0p=0.5*(rocal+sig0(itype(i,1)))
- r06 = r0p**6
- r012 = r06*r06
- Evan1=epscalc*(r012/rcal**6)
- Evan2=epscalc*2*(r06/rcal**3)
- r4 = rcal**4
- r7 = rcal**7
- do k=1,3
- dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
- dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
- enddo
- do k=1,3
- dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
- enddo
- ecation_prot = ecation_prot+ Evan1+Evan2
- do k=1,3
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- dEtotalCm(k)
- gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
- gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
+ do i=1,ilist_scp
+ newcontlistscpi(i)=contlistscpi(i)
+ newcontlistscpj(i)=contlistscpj(i)
+ enddo
+ endif
+
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_scp
+ do i=1,g_ilist_scp
+ write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
+ enddo
+
+! if (ifirstrun.eq.0) ifirstrun=1
+! do i=1,ilist_scp_first
+! do j=1,g_ilist_scp
+! if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
+! (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
+! enddo
+! print *,itime_mat,"ERROR matrix needs updating"
+! print *,contlistscpi_f(i),contlistscpj_f(i)
+! 126 continue
+! enddo
+#endif
+ call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
+
+ return
+ end subroutine make_SCp_inter_list
+
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+
+
+ subroutine make_pp_inter_list
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
+ real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
+ real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ integer:: contlistppi(250*nres),contlistppj(250*nres)
+! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_pp,g_ilist_pp
+ integer displ(0:nprocs),i_ilist_pp(0:nprocs),ierr
+! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list
+ ilist_pp=0
+ r_buff_list=5.0
+ do i=iatel_s,iatel_e
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+! write (iout,*) i,j,itype(i,1),itype(j,1)
+! if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
+
+! 1,j)
+ do j=ielstart(i),ielend(i)
+! write (iout,*) i,j,itype(i,1),itype(j,1)
+ if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+! xj=c(1,j)+0.5D0*dxj-xmedi
+! yj=c(2,j)+0.5D0*dyj-ymedi
+! zj=c(3,j)+0.5D0*dzj-zmedi
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_pp=ilist_pp+1
+! this can be substituted by cantor and anti-cantor
+ contlistppi(ilist_pp)=i
+ contlistppj(ilist_pp)=j
+ endif
+! enddo
enddo
- endif ! 13-16 residues
- enddo !j
- enddo !i
- return
- end subroutine ecat_prot
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_pp
+ do i=1,ilist_pp
+ write (iout,*) i,contlistppi(i),contlistppj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
-!----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
- 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
+ call MPI_Reduce(ilist_pp,g_ilist_pp,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_pp,1,MPI_INTEGER,&
+ i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_pp(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,&
+ newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,&
+ newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
-! 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 )
+ else
+ g_ilist_pp=ilist_pp
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
-!c! & - ( dFdR * ertail(k))
+ do i=1,ilist_pp
+ newcontlistppi(i)=contlistppi(i)
+ newcontlistppj(i)=contlistppj(i)
+ enddo
+ endif
+ call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_pp
+ do i=1,g_ilist_pp
+ write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
+ enddo
+#endif
+ return
+ end subroutine make_pp_inter_list
+!---------------------------------------------------------------------------
+ subroutine make_cat_pep_list
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
+ real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
+ real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ real(kind=8) :: xja,yja,zja
+ integer:: contlistcatpnormi(300*nres),contlistcatpnormj(300*nres)
+ integer:: contlistcatscnormi(250*nres),contlistcatscnormj(250*nres)
+ integer:: contlistcatptrani(250*nres),contlistcatptranj(250*nres)
+ integer:: contlistcatsctrani(250*nres),contlistcatsctranj(250*nres)
+ integer:: contlistcatscangi(250*nres),contlistcatscangj(250*nres)
+ integer:: contlistcatscangfi(250*nres),contlistcatscangfj(250*nres),&
+ contlistcatscangfk(250*nres)
+ integer:: contlistcatscangti(250*nres),contlistcatscangtj(250*nres)
+ integer:: contlistcatscangtk(250*nres),contlistcatscangtl(250*nres)
+
+
+! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_catscnorm,&
+ ilist_catsctran,ilist_catpnorm,ilist_catptran,itmp,ilist_catscang,&
+ ilist_catscangf,ilist_catscangt,k
+ integer displ(0:nprocs),i_ilist_catscnorm(0:nprocs),ierr,&
+ i_ilist_catpnorm(0:nprocs),i_ilist_catsctran(0:nprocs),&
+ i_ilist_catptran(0:nprocs),i_ilist_catscang(0:nprocs),&
+ i_ilist_catscangf(0:nprocs),i_ilist_catscangt(0:nprocs)
+! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list
+ ilist_catpnorm=0
+ ilist_catscnorm=0
+ ilist_catptran=0
+ ilist_catsctran=0
+ ilist_catscang=0
+
+
+ r_buff_list=6.0
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! go to 17
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+ do i=ibond_start,ibond_end
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
-!c! & + ( dFdR * ertail(k))
+! print *,"I am in EVDW",i
+ itypi=iabs(itype(i,1))
- gg(k) = 0.0d0
-!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
-!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- END DO
+! if (i.ne.47) cycle
+ if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
+! itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ dxi=dc_norm(1,i)
+ dyi=dc_norm(2,i)
+ dzi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
-! else
+! dsci_inv=vbld_inv(i+nres)
+ do j=itmp+1,itmp+nres_molec(5)
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xja=boxshift(xj-xmedi,boxxsize)
+ yja=boxshift(yj-ymedi,boxysize)
+ zja=boxshift(zj-zmedi,boxzsize)
+ dist_init=xja**2+yja**2+zja**2
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ if (itype(j,5).le.5) then
+ ilist_catpnorm=ilist_catpnorm+1
+! this can be substituted by cantor and anti-cantor
+ contlistcatpnormi(ilist_catpnorm)=i
+ contlistcatpnormj(ilist_catpnorm)=j
+ else
+ ilist_catptran=ilist_catptran+1
+! this can be substituted by cantor and anti-cantor
+ contlistcatptrani(ilist_catptran)=i
+ contlistcatptranj(ilist_catptran)=j
+ endif
+ endif
+ xja=boxshift(xj-xi,boxxsize)
+ yja=boxshift(yj-yi,boxysize)
+ zja=boxshift(zj-zi,boxzsize)
+ dist_init=xja**2+yja**2+zja**2
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ if (itype(j,5).le.5) then
+ ilist_catscnorm=ilist_catscnorm+1
+! this can be substituted by cantor and anti-cantor
+! write(iout,*) "have contact",i,j,ilist_catscnorm
+ contlistcatscnormi(ilist_catscnorm)=i
+ contlistcatscnormj(ilist_catscnorm)=j
+! write(iout,*) "have contact2",i,j,ilist_catscnorm,&
+! contlistcatscnormi(ilist_catscnorm),contlistcatscnormj(ilist_catscnorm)
-! 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
+ else
+ ilist_catsctran=ilist_catsctran+1
+! this can be substituted by cantor and anti-cantor
+ contlistcatsctrani(ilist_catsctran)=i
+ contlistcatsctranj(ilist_catsctran)=j
+! print *,"KUR**",i,j,itype(i,1)
+ if (((itype(i,1).eq.1).or.(itype(i,1).eq.15).or.&
+ (itype(i,1).eq.16).or.(itype(i,1).eq.17)).and.&
+ ((sqrt(dist_init).le.(r_cut_ang+r_buff_list)))) then
+! print *,"KUR**2",i,j,itype(i,1),ilist_catscang+1
+
+ ilist_catscang=ilist_catscang+1
+ contlistcatscangi(ilist_catscang)=i
+ contlistcatscangj(ilist_catscang)=j
+ endif
+
+ endif
+ endif
+! enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_catsctran,ilist_catptran,&
+ ilist_catscnorm,ilist_catpnorm,ilist_catscang
- 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)
+ do i=1,ilist_catsctran
+ write (iout,*) i,contlistcatsctrani(i),contlistcatsctranj(i),&
+ itype(j,contlistcatsctranj(i))
+ enddo
+ do i=1,ilist_catptran
+ write (iout,*) i,contlistcatptrani(i),contlistcatsctranj(i)
+ enddo
+ do i=1,ilist_catscnorm
+ write (iout,*) i,contlistcatscnormi(i),contlistcatscnormj(i)
+ enddo
+ do i=1,ilist_catpnorm
+ write (iout,*) i,contlistcatpnormi(i),contlistcatscnormj(i)
+ enddo
+ do i=1,ilist_catscang
+ write (iout,*) i,contlistcatscangi(i),contlistcatscangi(i)
+ enddo
-!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
+#endif
+ if (nfgtasks.gt.1)then
- 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)
+ call MPI_Reduce(ilist_catsctran,g_ilist_catsctran,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catsctran,1,MPI_INTEGER,&
+ i_ilist_catsctran,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catsctran(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatsctrani,ilist_catsctran,MPI_INTEGER,&
+ newcontlistcatsctrani,i_ilist_catsctran,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatsctranj,ilist_catsctran,MPI_INTEGER,&
+ newcontlistcatsctranj,i_ilist_catsctran,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_catsctran,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatsctrani,g_ilist_catsctran,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatsctranj,g_ilist_catsctran,MPI_INT,king,FG_COMM,IERR)
+
+
+ call MPI_Reduce(ilist_catptran,g_ilist_catptran,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catptran,1,MPI_INTEGER,&
+ i_ilist_catptran,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catptran(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatptrani,ilist_catptran,MPI_INTEGER,&
+ newcontlistcatptrani,i_ilist_catptran,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatptranj,ilist_catptran,MPI_INTEGER,&
+ newcontlistcatptranj,i_ilist_catptran,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_catptran,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatptrani,g_ilist_catptran,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatptranj,g_ilist_catptran,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ call MPI_Reduce(ilist_catscnorm,g_ilist_catscnorm,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catscnorm,1,MPI_INTEGER,&
+ i_ilist_catscnorm,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catscnorm(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatscnormi,ilist_catscnorm,MPI_INTEGER,&
+ newcontlistcatscnormi,i_ilist_catscnorm,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatscnormj,ilist_catscnorm,MPI_INTEGER,&
+ newcontlistcatscnormj,i_ilist_catscnorm,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_catscnorm,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatscnormi,g_ilist_catscnorm,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatscnormj,g_ilist_catscnorm,MPI_INT,king,FG_COMM,IERR)
- 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
+ call MPI_Reduce(ilist_catpnorm,g_ilist_catpnorm,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catpnorm,1,MPI_INTEGER,&
+ i_ilist_catpnorm,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catpnorm(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatpnormi,ilist_catpnorm,MPI_INTEGER,&
+ newcontlistcatpnormi,i_ilist_catpnorm,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatpnormj,ilist_catpnorm,MPI_INTEGER,&
+ newcontlistcatpnormj,i_ilist_catpnorm,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_catpnorm,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatpnormi,g_ilist_catpnorm,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatpnormj,g_ilist_catpnorm,MPI_INT,king,FG_COMM,IERR)
- 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
+ call MPI_Reduce(ilist_catscang,g_ilist_catscang,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catscang,1,MPI_INTEGER,&
+ i_ilist_catscang,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catscang(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatscangi,ilist_catscang,MPI_INTEGER,&
+ newcontlistcatscangi,i_ilist_catscang,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatscangj,ilist_catscang,MPI_INTEGER,&
+ newcontlistcatscangj,i_ilist_catscang,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_catscang,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatscangi,g_ilist_catscang,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatscangj,g_ilist_catscang,MPI_INT,king,FG_COMM,IERR)
+
+
+ else
+ g_ilist_catscnorm=ilist_catscnorm
+ g_ilist_catsctran=ilist_catsctran
+ g_ilist_catpnorm=ilist_catpnorm
+ g_ilist_catptran=ilist_catptran
+ g_ilist_catscang=ilist_catscang
+
+
+ do i=1,ilist_catscnorm
+ newcontlistcatscnormi(i)=contlistcatscnormi(i)
+ newcontlistcatscnormj(i)=contlistcatscnormj(i)
+ enddo
+ do i=1,ilist_catpnorm
+ newcontlistcatpnormi(i)=contlistcatpnormi(i)
+ newcontlistcatpnormj(i)=contlistcatpnormj(i)
+ enddo
+ do i=1,ilist_catsctran
+ newcontlistcatsctrani(i)=contlistcatsctrani(i)
+ newcontlistcatsctranj(i)=contlistcatsctranj(i)
+ enddo
+ do i=1,ilist_catptran
+ newcontlistcatptrani(i)=contlistcatptrani(i)
+ newcontlistcatptranj(i)=contlistcatptranj(i)
+ enddo
+
+ do i=1,ilist_catscang
+ newcontlistcatscangi(i)=contlistcatscangi(i)
+ newcontlistcatscangj(i)=contlistcatscangj(i)
+ enddo
+
+
+ endif
+ call int_bounds(g_ilist_catsctran,g_listcatsctran_start,g_listcatsctran_end)
+ call int_bounds(g_ilist_catptran,g_listcatptran_start,g_listcatptran_end)
+ call int_bounds(g_ilist_catscnorm,g_listcatscnorm_start,g_listcatscnorm_end)
+ call int_bounds(g_ilist_catpnorm,g_listcatpnorm_start,g_listcatpnorm_end)
+ call int_bounds(g_ilist_catscang,g_listcatscang_start,g_listcatscang_end)
+! make new ang list
+ ilist_catscangf=0
+ do i=g_listcatscang_start,g_listcatscang_end
+ do j=2,g_ilist_catscang
+! print *,"RWA",i,j,contlistcatscangj(i),contlistcatscangj(j)
+ if (j.le.i) cycle
+ if (newcontlistcatscangj(i).ne.newcontlistcatscangj(j)) cycle
+ ilist_catscangf=ilist_catscangf+1
+ contlistcatscangfi(ilist_catscangf)=newcontlistcatscangi(i)
+ contlistcatscangfj(ilist_catscangf)=newcontlistcatscangj(i)
+ contlistcatscangfk(ilist_catscangf)=newcontlistcatscangi(j)
+! print *,"TUTU",g_listcatscang_start,g_listcatscang_end,i,j,g_ilist_catscangf,myrank
enddo
- enddo
+ enddo
+ if (nfgtasks.gt.1)then
- return
- end subroutine eprot_sc_base
- SUBROUTINE sc_grad_scbase
- use calc_data
+ call MPI_Reduce(ilist_catscangf,g_ilist_catscangf,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catscangf,1,MPI_INTEGER,&
+ i_ilist_catscangf,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catscangf(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatscangfi,ilist_catscangf,MPI_INTEGER,&
+ newcontlistcatscangfi,i_ilist_catscangf,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatscangfj,ilist_catscangf,MPI_INTEGER,&
+ newcontlistcatscangfj,i_ilist_catscangf,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatscangfk,ilist_catscangf,MPI_INTEGER,&
+ newcontlistcatscangfk,i_ilist_catscangf,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+
+ call MPI_Bcast(g_ilist_catscangf,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatscangfi,g_ilist_catscangf,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatscangfj,g_ilist_catscangf,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatscangfk,g_ilist_catscangf,MPI_INT,king,FG_COMM,IERR)
+ else
+ g_ilist_catscangf=ilist_catscangf
+ do i=1,ilist_catscangf
+ newcontlistcatscangfi(i)=contlistcatscangfi(i)
+ newcontlistcatscangfj(i)=contlistcatscangfj(i)
+ newcontlistcatscangfk(i)=contlistcatscangfk(i)
+ enddo
+ endif
+ call int_bounds(g_ilist_catscangf,g_listcatscangf_start,g_listcatscangf_end)
- 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
+ ilist_catscangt=0
+ do i=g_listcatscang_start,g_listcatscang_end
+ do j=1,g_ilist_catscang
+ do k=1,g_ilist_catscang
+! print *,"TUTU1",g_listcatscang_start,g_listcatscang_end,i,j
- eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ if (newcontlistcatscangj(i).ne.newcontlistcatscangj(j)) cycle
+ if (newcontlistcatscangj(i).ne.newcontlistcatscangj(k)) cycle
+ if (newcontlistcatscangj(k).ne.newcontlistcatscangj(j)) cycle
+ if (newcontlistcatscangi(i).eq.newcontlistcatscangi(j)) cycle
+ if (newcontlistcatscangi(i).eq.newcontlistcatscangi(k)) cycle
+ if (newcontlistcatscangi(k).eq.newcontlistcatscangi(j)) cycle
+! print *,"TUTU2",g_listcatscang_start,g_listcatscang_end,i,j
-! 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
+ ilist_catscangt=ilist_catscangt+1
+ contlistcatscangti(ilist_catscangt)=newcontlistcatscangi(i)
+ contlistcatscangtj(ilist_catscangt)=newcontlistcatscangj(i)
+ contlistcatscangtk(ilist_catscangt)=newcontlistcatscangi(j)
+ contlistcatscangtl(ilist_catscangt)=newcontlistcatscangi(k)
+ enddo
+ enddo
+ enddo
+ if (nfgtasks.gt.1)then
- 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
+ call MPI_Reduce(ilist_catscangt,g_ilist_catscangt,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catscangt,1,MPI_INTEGER,&
+ i_ilist_catscangt,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catscangt(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatscangti,ilist_catscangt,MPI_INTEGER,&
+ newcontlistcatscangti,i_ilist_catscangt,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatscangtj,ilist_catscangt,MPI_INTEGER,&
+ newcontlistcatscangtj,i_ilist_catscangt,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatscangtk,ilist_catscangt,MPI_INTEGER,&
+ newcontlistcatscangtk,i_ilist_catscangt,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatscangtl,ilist_catscangt,MPI_INTEGER,&
+ newcontlistcatscangtl,i_ilist_catscangt,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+
+ call MPI_Bcast(g_ilist_catscangt,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatscangti,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatscangtj,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatscangtk,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatscangtl,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR)
-! 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)
+ else
+ g_ilist_catscangt=ilist_catscangt
+ do i=1,ilist_catscangt
+ newcontlistcatscangti(i)=contlistcatscangti(i)
+ newcontlistcatscangtj(i)=contlistcatscangtj(i)
+ newcontlistcatscangtk(i)=contlistcatscangtk(i)
+ newcontlistcatscangtl(i)=contlistcatscangtl(i)
+ enddo
+ endif
+ call int_bounds(g_ilist_catscangt,g_listcatscangt_start,g_listcatscangt_end)
- 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
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",ilist_catsctran,ilist_catptran, &
+ ilist_catscnorm,ilist_catpnorm
+
+ do i=1,g_ilist_catsctran
+ write (iout,*) i,newcontlistcatsctrani(i),newcontlistcatsctranj(i)
+ enddo
+ do i=1,g_ilist_catptran
+ write (iout,*) i,newcontlistcatptrani(i),newcontlistcatsctranj(i)
+ enddo
+ do i=1,g_ilist_catscnorm
+ write (iout,*) i,newcontlistcatscnormi(i),newcontlistcatscnormj(i)
+ enddo
+ do i=1,g_ilist_catpnorm
+ write (iout,*) i,newcontlistcatpnormi(i),newcontlistcatscnormj(i)
+ enddo
+ do i=1,g_ilist_catscang
+ write (iout,*) i,newcontlistcatscangi(i),newcontlistcatscangj(i)
+ enddo
+#endif
+ return
+ end subroutine make_cat_pep_list
+
+ subroutine make_lip_pep_list
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
+ real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
+ real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ real(kind=8) :: xja,yja,zja
+ integer:: contlistmartpi(300*nres),contlistmartpj(300*nres)
+ integer:: contlistmartsci(250*nres),contlistmartscj(250*nres)
+
+
+! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_martsc,&
+ ilist_martp,k,itmp
+ integer displ(0:nprocs),i_ilist_martsc(0:nprocs),ierr,&
+ i_ilist_martp(0:nprocs)
+! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list
+ ilist_martp=0
+ ilist_martsc=0
+
+
+ r_buff_list=6.0
+ itmp=0
+ do i=1,3
+ itmp=itmp+nres_molec(i)
+ enddo
+! go to 17
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+ do i=ibond_start,ibond_end
+
+! print *,"I am in EVDW",i
+ itypi=iabs(itype(i,1))
+
+! if (i.ne.47) cycle
+ if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
+! itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ dxi=dc_norm(1,i)
+ dyi=dc_norm(2,i)
+ dzi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
+
+! dsci_inv=vbld_inv(i+nres)
+ do j=itmp+1,itmp+nres_molec(4)
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xja=boxshift(xj-xmedi,boxxsize)
+ yja=boxshift(yj-ymedi,boxysize)
+ zja=boxshift(zj-zmedi,boxzsize)
+ dist_init=xja**2+yja**2+zja**2
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_martp=ilist_martp+1
+! this can be substituted by cantor and anti-cantor
+ contlistmartpi(ilist_martp)=i
+ contlistmartpj(ilist_martp)=j
+ endif
+ xja=boxshift(xj-xi,boxxsize)
+ yja=boxshift(yj-yi,boxysize)
+ zja=boxshift(zj-zi,boxzsize)
+ dist_init=xja**2+yja**2+zja**2
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_martsc=ilist_martsc+1
+! this can be substituted by cantor and anti-cantor
+! write(iout,*) "have contact",i,j,ilist_martsc
+ contlistmartsci(ilist_martsc)=i
+ contlistmartscj(ilist_martsc)=j
+! write(iout,*) "have contact2",i,j,ilist_martsc,&
+! contlistmartsci(ilist_martsc),contlistmartscj(ilist_martsc)
+ endif
+! enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_catsctran,ilist_catptran,&
+ ilist_catscnorm,ilist_catpnorm,ilist_catscang
+
+ do i=1,ilist_catsctran
+ write (iout,*) i,contlistcatsctrani(i),contlistcatsctranj(i),&
+ itype(j,contlistcatsctranj(i))
+ enddo
+ do i=1,ilist_catptran
+ write (iout,*) i,contlistcatptrani(i),contlistcatsctranj(i)
+ enddo
+ do i=1,ilist_catscnorm
+ write (iout,*) i,contlistcatscnormi(i),contlistcatscnormj(i)
+ enddo
+ do i=1,ilist_catpnorm
+ write (iout,*) i,contlistcatpnormi(i),contlistcatscnormj(i)
+ enddo
+ do i=1,ilist_catscang
+ write (iout,*) i,contlistcatscangi(i),contlistcatscangi(i)
+ enddo
-!c! & - ( dFdR * ertail(k))
- gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
-!c! & + ( dFdR * ertail(k))
+#endif
+ if (nfgtasks.gt.1)then
- gg(k) = 0.0d0
-!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
-!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- END DO
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Reduce(ilist_martsc,g_ilist_martsc,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_martsc,1,MPI_INTEGER,&
+ i_ilist_martsc,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_martsc(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistmartsci,ilist_martsc,MPI_INTEGER,&
+ newcontlistmartsci,i_ilist_martsc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistmartscj,ilist_martsc,MPI_INTEGER,&
+ newcontlistmartscj,i_ilist_martsc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_martsc,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistmartsci,g_ilist_martsc,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistmartscj,g_ilist_martsc,MPI_INT,king,FG_COMM,IERR)
- 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))
+ call MPI_Reduce(ilist_martp,g_ilist_martp,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_martp,1,MPI_INTEGER,&
+ i_ilist_martp,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_martp(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistmartpi,ilist_martp,MPI_INTEGER,&
+ newcontlistmartpi,i_ilist_martp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistmartpj,ilist_martp,MPI_INTEGER,&
+ newcontlistmartpj,i_ilist_martp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_martp,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistmartpi,g_ilist_martp,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistmartpj,g_ilist_martp,MPI_INT,king,FG_COMM,IERR)
- 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
+ else
+ g_ilist_martsc=ilist_martsc
+ g_ilist_martp=ilist_martp
- 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
+ do i=1,ilist_martsc
+ newcontlistmartsci(i)=contlistmartsci(i)
+ newcontlistmartscj(i)=contlistmartscj(i)
+ enddo
+ do i=1,ilist_martp
+ newcontlistmartpi(i)=contlistmartpi(i)
+ newcontlistmartpj(i)=contlistmartpj(i)
+ enddo
+ endif
+ call int_bounds(g_ilist_martsc,g_listmartsc_start,g_listmartsc_end)
+ call int_bounds(g_ilist_martp,g_listmartp_start,g_listmartp_end)
+! print *,"TUTU",g_listcatscang_start,g_listcatscang_end,i,j,g_ilist_catscangf,myrank
- eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",ilist_catsctran,ilist_catptran, &
+ ilist_catscnorm,ilist_catpnorm
- 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)
+ do i=1,g_ilist_catsctran
+ write (iout,*) i,newcontlistcatsctrani(i),newcontlistcatsctranj(i)
+ enddo
+ do i=1,g_ilist_catptran
+ write (iout,*) i,newcontlistcatptrani(i),newcontlistcatsctranj(i)
+ enddo
+ do i=1,g_ilist_catscnorm
+ write (iout,*) i,newcontlistcatscnormi(i),newcontlistcatscnormj(i)
+ enddo
+ do i=1,g_ilist_catpnorm
+ write (iout,*) i,newcontlistcatpnormi(i),newcontlistcatscnormj(i)
+ enddo
+ do i=1,g_ilist_catscang
+ write (iout,*) i,newcontlistcatscangi(i),newcontlistcatscangj(i)
+#endif
+ return
+ end subroutine make_lip_pep_list
-! 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
+ subroutine make_cat_cat_list
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
+ real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
+ real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ real(kind=8) :: xja,yja,zja
+ integer,dimension(:),allocatable:: contlistcatpnormi,contlistcatpnormj
+! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_catscnorm,&
+ ilist_catsctran,ilist_catpnorm,ilist_catptran,itmp,ilist_catscang,&
+ ilist_catscangf,ilist_catscangt,k
+ integer displ(0:nprocs),i_ilist_catscnorm(0:nprocs),ierr,&
+ i_ilist_catpnorm(0:nprocs),i_ilist_catsctran(0:nprocs),&
+ i_ilist_catptran(0:nprocs),i_ilist_catscang(0:nprocs),&
+ i_ilist_catscangf(0:nprocs),i_ilist_catscangt(0:nprocs)
+! write(iout,*),"START make_catcat"
+ ilist_catpnorm=0
+ ilist_catscnorm=0
+ ilist_catptran=0
+ ilist_catsctran=0
+ ilist_catscang=0
+
+ if (.not.allocated(contlistcatpnormi)) then
+ allocate(contlistcatpnormi(900*nres))
+ allocate(contlistcatpnormj(900*nres))
+ endif
+ r_buff_list=3.0
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! go to 17
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+ do i=icatb_start,icatb_end
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
+ call to_box(xi,yi,zi)
+ dxi=dc_norm(1,i)
+ dyi=dc_norm(2,i)
+ dzi=dc_norm(3,i)
+! dsci_inv=vbld_inv(i+nres)
+ do j=i+1,itmp+nres_molec(5)
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xja=boxshift(xj-xi,boxxsize)
+ yja=boxshift(yj-yi,boxysize)
+ zja=boxshift(zj-zi,boxzsize)
+ dist_init=xja**2+yja**2+zja**2
+ if (sqrt(dist_init).le.(10.0+r_buff_list)) then
+! Here the list is created
+! if (i.eq.2) then
+! print *,i,j,dist_init,ilist_catpnorm
+! endif
+ ilist_catpnorm=ilist_catpnorm+1
+
+! this can be substituted by cantor and anti-cantor
+ contlistcatpnormi(ilist_catpnorm)=i
+ contlistcatpnormj(ilist_catpnorm)=j
+ endif
+! enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_catsctran,ilist_catptran,&
+ ilist_catscnorm,ilist_catpnorm,ilist_catscang
-! 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 )
+ do i=1,ilist_catpnorm
+ write (iout,*) i,contlistcatpnormi(i)
+ enddo
- 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 )
+#endif
+ if (nfgtasks.gt.1)then
- gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
-!c! & - ( dFdR * ertail(k))
+ call MPI_Reduce(ilist_catpnorm,g_ilist_catcatnorm,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_catpnorm,1,MPI_INTEGER,&
+ i_ilist_catpnorm,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_catpnorm(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistcatpnormi,ilist_catpnorm,MPI_INTEGER,&
+ newcontlistcatcatnormi,i_ilist_catpnorm,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistcatpnormj,ilist_catpnorm,MPI_INTEGER,&
+ newcontlistcatcatnormj,i_ilist_catpnorm,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_catcatnorm,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistcatcatnormi,g_ilist_catcatnorm,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistcatcatnormj,g_ilist_catcatnorm,MPI_INT,king,FG_COMM,IERR)
+
+
+ else
+ g_ilist_catcatnorm=ilist_catpnorm
+ do i=1,ilist_catpnorm
+ newcontlistcatcatnormi(i)=contlistcatpnormi(i)
+ newcontlistcatcatnormj(i)=contlistcatpnormj(i)
+ enddo
+ endif
+ call int_bounds(g_ilist_catcatnorm,g_listcatcatnorm_start,g_listcatcatnorm_end)
+
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_catcatnorm
- gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
+ do i=1,g_ilist_catcatnorm
+ write (iout,*) i,newcontlistcatcatnormi(i),newcontlistcatcatnormj(i)
+ enddo
+#endif
+! write(iout,*),"END make_catcat"
+ return
+ end subroutine make_cat_cat_list
- gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
-!c! & + ( dFdR * ertail(k))
+!-----------------------------------------------------------------------------
+ double precision function boxshift(x,boxsize)
+ implicit none
+ double precision x,boxsize
+ double precision xtemp
+ xtemp=dmod(x,boxsize)
+ if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then
+ boxshift=xtemp-boxsize
+ else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then
+ boxshift=xtemp+boxsize
+ else
+ boxshift=xtemp
+ endif
+ return
+ end function boxshift
+!-----------------------------------------------------------------------------
+ subroutine to_box(xi,yi,zi)
+ implicit none
+! include 'DIMENSIONS'
+! include 'COMMON.CHAIN'
+ double precision xi,yi,zi
+ xi=dmod(xi,boxxsize)
+ if (xi.lt.0.0d0) xi=xi+boxxsize
+ yi=dmod(yi,boxysize)
+ if (yi.lt.0.0d0) yi=yi+boxysize
+ zi=dmod(zi,boxzsize)
+ if (zi.lt.0.0d0) zi=zi+boxzsize
+ return
+ end subroutine to_box
+!--------------------------------------------------------------------------
+ subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ implicit none
+! include 'DIMENSIONS'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+ double precision xi,yi,zi,sslipi,ssgradlipi
+ double precision fracinbuf
+! double precision sscalelip,sscagradlip
+#ifdef DEBUG
+ write (iout,*) "bordlipbot",bordlipbot," bordliptop",bordliptop
+ write (iout,*) "buflipbot",buflipbot," lipbufthick",lipbufthick
+ write (iout,*) "xi yi zi",xi,yi,zi
+#endif
+ if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then
+! the energy transfer exist
+ if (zi.lt.buflipbot) then
+! what fraction I am in
+ fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick)
+! lipbufthick is thickenes of lipid buffore
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+ elseif (zi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
+ sslipi=sscalelip(fracinbuf)
+ ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+ else
+ sslipi=1.0d0
+ ssgradlipi=0.0
+ endif
+ else
+ sslipi=0.0d0
+ ssgradlipi=0.0
+ endif
+#ifdef DEBUG
+ write (iout,*) "sslipi",sslipi," ssgradlipi",ssgradlipi
+#endif
+ return
+ end subroutine lipid_layer
+!-------------------------------------------------------------
+ subroutine ecat_prot_transition(ecation_prottran)
+ integer:: itypi,itypj,ityptrani,ityptranj,k,l,i,j
+ real(kind=8),dimension(3):: cjtemp,citemp,diff,dsctemp,vecsc,&
+ diffnorm,boxx,r,dEvan1Cm,dEvan2Cm,dEtotalCm
+ real(kind=8):: ecation_prottran,dista,sdist,De,ene,x0left,&
+ alphac,grad,sumvec,simplesum,pom,erdxi,facd1,&
+ sss_ele_cut,sss_ele_cut_grad,sss2min,sss2mingrad,&
+ ene1,ene2,grad1,grad2,evan1,evan2,rcal,r4,r7,r0p,&
+ r06,r012,epscalc,rocal,ract
+ ecation_prottran=0.0d0
+ boxx(1)=boxxsize
+ boxx(2)=boxysize
+ boxx(3)=boxzsize
+ write(iout,*) "start ecattran",g_listcatsctran_start,g_listcatsctran_end
+ do k=g_listcatsctran_start,g_listcatsctran_end
+ i=newcontlistcatsctrani(k)
+ j=newcontlistcatsctranj(k)
+! print *,i,j,"in new tran"
+ do l=1,3
+ citemp(l)=c(l,i+nres)
+ cjtemp(l)=c(l,j)
+ enddo
+
+ itypi=itype(i,1) !as the first is the protein part
+ itypj=itype(j,5) !as the second part is always cation
+! remapping to internal types
+! read (iiontran,*,err=123,end=123) (agamacattran(k,j,i),k=1,3),&
+! (athetacattran(k,j,i),k=1,6),acatshiftdsc(j,i),bcatshiftdsc(j,i),&
+! demorsecat(j,i),alphamorsecat(j,i),x0catleft(j,i),x0catright(j,i),&
+! x0cattrans(j,i)
+
+ if (itypj.eq.6) then
+ ityptranj=1 !as now only Zn2+ is this needs to be modified for other ions
+ endif
+ if (itypi.eq.16) then
+ ityptrani=1
+ elseif (itypi.eq.1) then
+ ityptrani=2
+ elseif (itypi.eq.15) then
+ ityptrani=3
+ elseif (itypi.eq.17) then
+ ityptrani=4
+ elseif (itypi.eq.2) then
+ ityptrani=5
+ else
+ ityptrani=6
+ endif
- gg(k) = 0.0d0
- ENDDO
+ if (ityptrani.gt.ntrantyp(ityptranj)) then
+! do l=1,3
+! write(iout,*),gradcattranc(l,j),gradcattranx(l,i)
+! enddo
+!volume excluded
+ call to_box(cjtemp(1),cjtemp(2),cjtemp(3))
+ call to_box(citemp(1),citemp(2),citemp(3))
+ rcal=0.0d0
+ do l=1,3
+ r(l)=boxshift(cjtemp(l)-citemp(l),boxx(l))
+ rcal=rcal+r(l)*r(l)
+ enddo
+ ract=sqrt(rcal)
+ if (ract.gt.r_cut_ele) cycle
+ sss_ele_cut=sscale_ele(ract)
+ sss_ele_cut_grad=sscagrad_ele(ract)
+ 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 l=1,3
+ dEvan1Cm(l) = 12*r(l)*epscalc*r012/r7
+ dEvan2Cm(l) = 12*r(l)*epscalc*r06/r4
+ enddo
+ do l=1,3
+ dEtotalCm(l)=(dEvan1Cm(l)+dEvan2Cm(l))*sss_ele_cut-&
+ (Evan1+Evan2)*sss_ele_cut_grad*r(l)/ract
+ enddo
+ ecation_prottran = ecation_prottran+&
+ (Evan1+Evan2)*sss_ele_cut
+ do l=1,3
+ gradcattranx(l,i)=gradcattranx(l,i)+dEtotalCm(l)
+ gradcattranc(l,i)=gradcattranc(l,i)+dEtotalCm(l)
+ gradcattranc(l,j)=gradcattranc(l,j)-dEtotalCm(l)
+ enddo
+
+ ene=0.0d0
+ else
+! cycle
+ sumvec=0.0d0
+ simplesum=0.0d0
+ do l=1,3
+ vecsc(l)=citemp(l)-c(l,i)
+ sumvec=sumvec+vecsc(l)**2
+ simplesum=simplesum+vecsc(l)
+ enddo
+ sumvec=dsqrt(sumvec)
+ call to_box(cjtemp(1),cjtemp(2),cjtemp(3))
+ call to_box(citemp(1),citemp(2),citemp(3))
+! sumvec=2.0d0
+ do l=1,3
+ dsctemp(l)=c(l,i+nres)&
+ +(acatshiftdsc(ityptrani,ityptranj)-1.0d0)*vecsc(l)&
+ +bcatshiftdsc(ityptrani,ityptranj)*vecsc(l)/sumvec
+ enddo
+ call to_box(dsctemp(1),dsctemp(2),dsctemp(3))
+ sdist=0.0d0
+ do l=1,3
+ diff(l)=boxshift(dsctemp(l)-cjtemp(l),boxx(l))
+ sdist=sdist+diff(l)*diff(l)
+ enddo
+ dista=sqrt(sdist)
+ if (dista.gt.r_cut_ele) cycle
+
+ sss_ele_cut=sscale_ele(dista)
+ sss_ele_cut_grad=sscagrad_ele(dista)
+ sss2min=sscale2(dista,x0cattrans(ityptrani,ityptranj)-0.1d0,0.2d0)
+ De=demorsecat(ityptrani,ityptranj)
+ alphac=alphamorsecat(ityptrani,ityptranj)
+ if (sss2min.eq.1.0d0) then
+! print *,"ityptrani",ityptrani,ityptranj
+ x0left=x0catleft(ityptrani,ityptranj) ! to mn
+ ene=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2)
+ grad=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*&
+ (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut&
+ +ene/sss_ele_cut*sss_ele_cut_grad
+ else if (sss2min.eq.0.0d0) then
+ x0left=x0catright(ityptrani,ityptranj)
+ ene=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2)
+ grad=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*&
+ (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut&
+ +ene/sss_ele_cut*sss_ele_cut_grad
+ else
+ sss2mingrad=sscagrad2(dista,x0cattrans(ityptrani,ityptranj)-0.1d0,0.2d0)
+ x0left=x0catleft(ityptrani,ityptranj)
+ ene1=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2)
+ grad1=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*&
+ (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut&
+ +ene/sss_ele_cut*sss_ele_cut_grad
+ x0left=x0catright(ityptrani,ityptranj)
+ ene2=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2)
+ grad2=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*&
+ (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut&
+ +ene/sss_ele_cut*sss_ele_cut_grad
+ ene=sss2min*ene1+(1.0d0-sss2min)*ene2
+ grad=sss2min*grad1+(1.0d0-sss2min)*grad2+sss2mingrad*(ene1-ene2)
+ endif
+ do l=1,3
+ diffnorm(l)= diff(l)/dista
+ enddo
+ erdxi=scalar(diffnorm(1),dc_norm(1,i+nres))
+ facd1=bcatshiftdsc(ityptrani,ityptranj)/sumvec
+
+ do l=1,3
+! 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)
-! 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!-------------------------------------------------------------------
+! pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+! gvdwx(k,i) = gvdwx(k,i) &
+! - (( dFdR + gg(k) ) * pom)
+ pom=diffnorm(l)+facd1*(diffnorm(l)-erdxi*dc_norm(l,i+nres))
+! write(iout,*),gradcattranc(l,j),gradcattranx(l,i),grad*diff(l)/dista
+
+ gradcattranx(l,i)=gradcattranx(l,i)+grad*pom&
+ +grad*diffnorm(l)*(acatshiftdsc(ityptrani,ityptranj)-1.0d0)
+! *( bcatshiftdsc(ityptrani,ityptranj)*&
+! (1.0d0/sumvec-(vecsc(l)*simplesum)*(sumvec**(-3.0d0))))
+ gradcattranc(l,i)=gradcattranc(l,i)+grad*diff(l)/dista
+! +sss_ele_cut_grad*ene*diff(l)/dista/sss_ele_cut
+ gradcattranc(l,j)=gradcattranc(l,j)-grad*diff(l)/dista
+! -sss_ele_cut_grad*ene*diff(l)/dista/sss_ele_cut
+ enddo
+ ecation_prottran=ecation_prottran+ene
+ if (energy_dec) write(iout,*) "etrancat",i,j,ene,x0left,De,dista,&
+ alphac
+ endif
+ enddo
+! do k=g_listcatptran_start,g_listcatptran_end
+! ene=0.0d0 this will be used if peptide group interaction is needed
+! enddo
-!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
+ return
+ end subroutine
+ subroutine ecat_prot_ang(ecation_protang)
+ integer:: itypi,itypj,ityptrani,ityptranj,k,l,i,j,n,m,&
+ ityptrani1,ityptranj1,ityptrani2,ityptranj2,&
+ i1,i2,j1,j2,k1,k2,k3,i3,j3,ityptrani3,ityptranj3
+
+ real(kind=8),dimension(3):: cjtemp,citemp,diff,dsctemp,vecsc,&
+ diffnorm,boxx,dscvec,dscvecnorm,diffnorm2,&
+ dscvec2,dscvecnorm2,cjtemp2,citemp2,diff2,dsctemp2,&
+ vecsc2,diff1,diffnorm1,diff3,mindiffnorm2
+ real(kind=8),dimension(3):: dscvec1,dscvecnorm1,cjtemp1,citemp1,vecsc1,dsctemp1,&
+ dscvec3,dscvecnorm3,cjtemp3,citemp3,vecsc3,dsctemp3,&
+ diffnorm3,diff4,diffnorm4
+
+ real(kind=8):: ecation_protang,dista,sdist,De,ene,x0left,&
+ alphac,grad,sumvec,sumdscvec,pom,erdxi,facd1,&
+ sss_ele_cut,sss_ele_cut_grad,sss2min,sss2mingrad,&
+ simplesum,cosval,part1,part2a,part2,part2b,part3,&
+ part4a,part4b,part4,bottom,dista2,sdist2,sumvec2,&
+ sumdscvec2,simplesum2,dista1,sdist1,sumvec1,simplesum1,&
+ sumdscvec1,facd2,scal1a,scal1b,scal2a,scal2b,&
+ sss2mingrad1,sss2mingrad2,sss2min1,sss2min2,pom1,pom2,&
+ det1ij,det2ij,cosom1,cosom2,cosom12,cosphij,dista3,&
+ sumvec3
+ real(kind=8):: sinom1,sinom2,sinaux,dephiij,sumdscvec3,sumscvec3,&
+ cosphi,sdist3,simplesum3,det1t2ij,sss2mingrad3,sss2min3,&
+ scal1c,scal2c,scal3a,scal3b,scal3c,facd3,facd2b,scal3d,&
+ scal3e,dista4,sdist4,pom3,sssmintot
+
+ ecation_protang=0.0d0
+ boxx(1)=boxxsize
+ boxx(2)=boxysize
+ boxx(3)=boxzsize
+! print *,"KUR**3",g_listcatscang_start,g_listcatscang_end
+! go to 19
+! go to 21
+ do k=g_listcatscang_start,g_listcatscang_end
+ ene=0.0d0
+ i=newcontlistcatscangi(k)
+ j=newcontlistcatscangj(k)
+ itypi=itype(i,1) !as the first is the protein part
+ itypj=itype(j,5) !as the second part is always cation
+! print *,"KUR**4",i,j,itypi,itypj
+! remapping to internal types
+! read (iiontran,*,err=123,end=123) (agamacattran(k,j,i),k=1,3),&
+! (athetacattran(k,j,i),k=1,6),acatshiftdsc(j,i),bcatshiftdsc(j,i),&
+! demorsecat(j,i),alphamorsecat(j,i),x0catleft(j,i),x0catright(j,i),&
+! x0cattrans(j,i)
+ if (itypj.eq.6) then
+ ityptranj=1 !as now only Zn2+ is this needs to be modified for other ions
+ endif
+ if (itypi.eq.16) then
+ ityptrani=1
+ elseif (itypi.eq.1) then
+ ityptrani=2
+ elseif (itypi.eq.15) then
+ ityptrani=3
+ elseif (itypi.eq.17) then
+ ityptrani=4
+ elseif (itypi.eq.2) then
+ ityptrani=5
+ else
+ ityptrani=6
+ endif
+ if (ityptrani.gt.ntrantyp(ityptranj)) cycle
+ do l=1,3
+ citemp(l)=c(l,i+nres)
+ cjtemp(l)=c(l,j)
+ enddo
+ sumvec=0.0d0
+ simplesum=0.0d0
+ do l=1,3
+ vecsc(l)=citemp(l)-c(l,i)
+ sumvec=sumvec+vecsc(l)**2
+ simplesum=simplesum+vecsc(l)
+ enddo
+ sumvec=dsqrt(sumvec)
+ sumdscvec=0.0d0
+ do l=1,3
+ dsctemp(l)=c(l,i)&
+! +1.0d0
+ +(acatshiftdsc(ityptrani,ityptranj))*vecsc(l)&
+ +bcatshiftdsc(ityptrani,ityptranj)*vecsc(l)/sumvec
+ dscvec(l)= &
+!1.0d0
+ (acatshiftdsc(ityptrani,ityptranj))*vecsc(l)&
+ +bcatshiftdsc(ityptrani,ityptranj)*vecsc(l)/sumvec
+ sumdscvec=sumdscvec+dscvec(l)**2
+ enddo
+ sumdscvec=dsqrt(sumdscvec)
+ do l=1,3
+ dscvecnorm(l)=dscvec(l)/sumdscvec
+ enddo
+ call to_box(dsctemp(1),dsctemp(2),dsctemp(3))
+ call to_box(cjtemp(1),cjtemp(2),cjtemp(3))
+ sdist=0.0d0
+ do l=1,3
+ diff(l)=boxshift(dsctemp(l)-cjtemp(l),boxx(l))
+ sdist=sdist+diff(l)*diff(l)
+ enddo
+ dista=sqrt(sdist)
+ do l=1,3
+ diffnorm(l)= diff(l)/dista
+ enddo
+ cosval=scalar(diffnorm(1),dc_norm(1,i+nres))
+ grad=0.0d0
+ sss2min=sscale2(dista,r_cut_ang,1.0d0)
+ sss2mingrad=sscagrad2(dista,r_cut_ang,1.0d0)
+ ene=ene&
+ +tschebyshev(1,6,athetacattran(1,ityptrani,ityptranj),cosval)
+ grad=gradtschebyshev(0,5,athetacattran(1,ityptrani,ityptranj),cosval)*sss2min
+
+ facd1=bcatshiftdsc(ityptrani,ityptranj)/sumvec
+ erdxi=scalar(diffnorm(1),dc_norm(1,i+nres))
+ part1=0.0d0
+ part2=0.0d0
+ part3=0.0d0
+ part4=0.0d0
+ do l=1,3
+ bottom=sumvec**2*sdist
+ part1=diff(l)*sumvec*dista
+ part2a=(acatshiftdsc(ityptrani,ityptranj))*vecsc(l)
+ part2b=0.0d0
+ !bcatshiftdsc(ityptrani,ityptranj)/sumvec*&
+ !(vecsc(l)-cosval*dista*dc_norm(l,i+nres))
+ part2=(part2a+part2b)*sumvec*dista
+ part3=cosval*sumvec*dista*dc_norm(l,i+nres)*dista
+ part4a=diff(l)*acatshiftdsc(ityptrani,ityptranj)
+ part4b=bcatshiftdsc(ityptrani,ityptranj)/sumvec*&
+ (diff(l)-cosval*dista*dc_norm(l,i+nres))
+ part4=cosval*sumvec*(part4a+part4b)*sumvec
+! gradlipang(m,l)=gradlipang(m,l)+(fac &
+! *(xa(m)-scalar*vnorm*xb(m)/wnorm)&
+! /(vnorm*wnorm))
+
+! 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)
+ pom=diffnorm(l)+facd1*(diffnorm(l)-erdxi*dc_norm(l,i+nres))
-!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)
+ gradcatangc(l,j)=gradcatangc(l,j)-grad*&
+ (dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)-&
+ ene*sss2mingrad*diffnorm(l)
- 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)
+ gradcatangc(l,i)=gradcatangc(l,i)+grad*&
+ (dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)+&
+ ene*sss2mingrad*diffnorm(l)
- 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
+ gradcatangx(l,i)=gradcatangx(l,i)+grad*&
+ (part1+part2-part3-part4)/bottom+&
+ ene*sss2mingrad*pom+&
+ ene*sss2mingrad*diffnorm(l)*(acatshiftdsc(ityptrani,ityptranj)-1.0d0)
+! +grad*(dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)&
+! +grad*pom+grad*diffnorm(l)*(acatshiftdsc(ityptrani,ityptranj)-1.0d0)
+!&
+! (diff(l)-cosval*dscvecnorm(l)*dista)/(sumdscvec*dista)
- 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
+ enddo
+! print *,i,j,cosval,tschebyshev(1,3,aomicattr(1,ityptranj),cosval)&
+! ,aomicattr(0,ityptranj),ene
+ if (energy_dec) write(iout,*) i,j,ityptrani,ityptranj,ene,cosval
+ ecation_protang=ecation_protang+ene*sss2min
+ enddo
+ 19 continue
+! print *,"KUR**",g_listcatscangf_start,g_listcatscangf_end
+ do k=g_listcatscangf_start,g_listcatscangf_end
+ ene=0.0d0
+ i1=newcontlistcatscangfi(k)
+ j1=newcontlistcatscangfj(k)
+ itypi=itype(i1,1) !as the first is the protein part
+ itypj=itype(j1,5) !as the second part is always cation
+ if (itypj.eq.6) then
+ ityptranj1=1 !as now only Zn2+ is this needs to be modified for other ions
+ endif
+ if (itypi.eq.16) then
+ ityptrani1=1
+ elseif (itypi.eq.1) then
+ ityptrani1=2
+ elseif (itypi.eq.15) then
+ ityptrani1=3
+ elseif (itypi.eq.17) then
+ ityptrani1=4
+ elseif (itypi.eq.2) then
+ ityptrani1=5
+ else
+ ityptrani1=6
+ endif
+ do l=1,3
+ citemp1(l)=c(l,i1+nres)
+ cjtemp1(l)=c(l,j1)
+ enddo
+ sumvec1=0.0d0
+ simplesum1=0.0d0
+ do l=1,3
+ vecsc1(l)=citemp1(l)-c(l,i1)
+ sumvec1=sumvec1+vecsc1(l)**2
+ simplesum1=simplesum1+vecsc1(l)
+ enddo
+ sumvec1=dsqrt(sumvec1)
+ sumdscvec1=0.0d0
+ do l=1,3
+ dsctemp1(l)=c(l,i1)&
+! +1.0d0
+ +(acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)&
+ +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1
+ dscvec1(l)= &
+!1.0d0
+ (acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)&
+ +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1
+ sumdscvec1=sumdscvec1+dscvec1(l)**2
+ enddo
+ sumdscvec1=dsqrt(sumdscvec1)
+ do l=1,3
+ dscvecnorm1(l)=dscvec1(l)/sumdscvec1
+ enddo
+ call to_box(dsctemp1(1),dsctemp1(2),dsctemp1(3))
+ call to_box(cjtemp1(1),cjtemp1(2),cjtemp1(3))
+ sdist1=0.0d0
+ do l=1,3
+ diff1(l)=boxshift(dsctemp1(l)-cjtemp1(l),boxx(l))
+ sdist1=sdist1+diff1(l)*diff1(l)
+ enddo
+ dista1=sqrt(sdist1)
+ do l=1,3
+ diffnorm1(l)= diff1(l)/dista1
+ enddo
+ sss2min1=sscale2(dista1,r_cut_ang,1.0d0)
+ sss2mingrad1=sscagrad2(dista1,r_cut_ang,1.0d0)
+ if (ityptrani1.gt.ntrantyp(ityptranj1)) cycle
+
+!-----------------------------------------------------------------
+! do m=k+1,g_listcatscang_end
+ ene=0.0d0
+ i2=newcontlistcatscangfk(k)
+ j2=j1
+ if (j1.ne.j2) cycle
+ itypi=itype(i2,1) !as the first is the protein part
+ itypj=itype(j2,5) !as the second part is always cation
+ if (itypj.eq.6) then
+ ityptranj2=1 !as now only Zn2+ is this needs to be modified for other ions
+ endif
+ if (itypi.eq.16) then
+ ityptrani2=1
+ elseif (itypi.eq.1) then
+ ityptrani2=2
+ elseif (itypi.eq.15) then
+ ityptrani2=3
+ elseif (itypi.eq.17) then
+ ityptrani2=4
+ elseif (itypi.eq.2) then
+ ityptrani2=5
+ else
+ ityptrani2=6
+ endif
+ if (ityptrani2.gt.ntrantyp(ityptranj2)) cycle
+
+ do l=1,3
+ citemp2(l)=c(l,i2+nres)
+ cjtemp2(l)=c(l,j2)
+ enddo
+ sumvec2=0.0d0
+ simplesum2=0.0d0
+ do l=1,3
+ vecsc2(l)=citemp2(l)-c(l,i2)
+ sumvec2=sumvec2+vecsc2(l)**2
+ simplesum2=simplesum2+vecsc2(l)
+ enddo
+ sumvec2=dsqrt(sumvec2)
+ sumdscvec2=0.0d0
+ do l=1,3
+ dsctemp2(l)=c(l,i2)&
+! +1.0d0
+ +(acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)&
+ +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2
+ dscvec2(l)= &
+!1.0d0
+ (acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)&
+ +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2
+ sumdscvec2=sumdscvec2+dscvec2(l)**2
+ enddo
+ sumdscvec2=dsqrt(sumdscvec2)
+ do l=1,3
+ dscvecnorm2(l)=dscvec2(l)/sumdscvec2
+ enddo
+ call to_box(dsctemp2(1),dsctemp2(2),dsctemp2(3))
+ call to_box(cjtemp2(1),cjtemp2(2),cjtemp2(3))
+ sdist2=0.0d0
+ do l=1,3
+ diff2(l)=boxshift(dsctemp2(l)-cjtemp2(l),boxx(l))
+! diff2(l)=1.0d0
+ sdist2=sdist2+diff2(l)*diff2(l)
+ enddo
+ dista2=sqrt(sdist2)
+ do l=1,3
+ diffnorm2(l)= diff2(l)/dista2
+ enddo
+! print *,i1,i2,diffnorm2(1)
+ cosval=scalar(diffnorm1(1),diffnorm2(1))
+ grad=0.0d0
+ sss2min2=sscale2(dista2,r_cut_ang,1.0d0)
+ sss2mingrad2=sscagrad2(dista2,r_cut_ang,1.0d0)
+ ene=ene+tschebyshev(1,3,aomicattr(1,ityptranj1),cosval)
+ grad=gradtschebyshev(0,2,aomicattr(1,ityptranj1),cosval)*sss2min2*sss2min1
+ part1=0.0d0
+ part2=0.0d0
+ part3=0.0d0
+ part4=0.0d0
+ ecation_protang=ecation_protang+ene*sss2min2*sss2min1
+ facd1=bcatshiftdsc(ityptrani1,ityptranj1)/sumvec1
+ facd2=bcatshiftdsc(ityptrani2,ityptranj2)/sumvec2
+ scal1a=scalar(diffnorm1(1),dc_norm(1,i1+nres))
+ scal1b=scalar(diffnorm2(1),dc_norm(1,i1+nres))
+ scal2a=scalar(diffnorm1(1),dc_norm(1,i2+nres))
+ scal2b=scalar(diffnorm2(1),dc_norm(1,i2+nres))
+
+ if (energy_dec) write(iout,*) "omi", i,j,ityptrani,ityptranj,ene,cosval,aomicattr(1,ityptranj1),&
+ aomicattr(2,ityptranj1),aomicattr(3,ityptranj1),tschebyshev(1,3,aomicattr(1,ityptranj1),cosval)
+
+!*sss2min
+ do l=1,3
+ pom1=diffnorm1(l)+facd1*(diffnorm1(l)-scal1a*dc_norm(l,i1+nres))
+ pom2=diffnorm2(l)+facd2*(diffnorm2(l)-scal2b*dc_norm(l,i2+nres))
+
+
+ gradcatangc(l,i1)=gradcatangc(l,i1)+grad*(diff2(l)-&
+ cosval*diffnorm1(l)*dista2)/(dista2*dista1)+&
+ ene*sss2mingrad1*diffnorm1(l)*sss2min2
+
+
+ gradcatangx(l,i1)=gradcatangx(l,i1)+grad/(dista2*dista1)*&
+ (acatshiftdsc(ityptrani1,ityptranj1)*diff2(l)+&
+ facd1*(diff2(l)-scal1b*dc_norm(l,i1+nres)*dista2)-&
+ cosval*dista2/dista1*&
+ (acatshiftdsc(ityptrani1,ityptranj1)*diff1(l)+&
+ facd1*(diff1(l)-scal1a*dc_norm(l,i1+nres)*dista1)))+&
+ ene*sss2mingrad1*sss2min2*(pom1+&
+ diffnorm1(l)*(acatshiftdsc(ityptrani1,ityptranj1)-1.0d0))
+
+
+ gradcatangx(l,i2)=gradcatangx(l,i2)+grad/(dista2*dista1)*&
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff1(l)+&
+ facd2*(diff1(l)-scal2a*dc_norm(l,i2+nres)*dista1)-&
+ cosval*dista1/dista2*&
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+&
+ facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2)))+&
+ ene*sss2mingrad2*sss2min1*(pom2+&
+ diffnorm2(l)*(acatshiftdsc(ityptrani2,ityptranj2)-1.0d0))
+
+
+ gradcatangx(l,i2)=gradcatangx(l,i2)
+ gradcatangc(l,i2)=gradcatangc(l,i2)+grad*(diff1(l)-&
+ cosval*diffnorm2(l)*dista1)/(dista2*dista1)+&
+ ene*sss2mingrad2*diffnorm2(l)*sss2min1
+
+ gradcatangc(l,j2)=gradcatangc(l,j2)-grad*(diff2(l)/dista2/dista1-&
+ cosval*diff1(l)/dista1/dista1+diff1(l)/dista2/dista1-&
+ cosval*diff2(l)/dista2/dista2)-&
+ ene*sss2mingrad1*diffnorm1(l)*sss2min2-&
+ ene*sss2mingrad2*diffnorm2(l)*sss2min1
+
+
+ enddo
+
+ enddo
+! enddo
+!#ifdef DUBUG
+ 21 continue
+! do k1=g_listcatscang_start,g_listcatscang_end
+! print *,"KURNA",g_listcatscangt_start,g_listcatscangt_end
+ do k1=g_listcatscangt_start,g_listcatscangt_end
+ i1=newcontlistcatscangti(k1)
+ j1=newcontlistcatscangtj(k1)
+ itypi=itype(i1,1) !as the first is the protein part
+ itypj=itype(j1,5) !as the second part is always cation
+ if (itypj.eq.6) then
+ ityptranj1=1 !as now only Zn2+ is this needs to be modified for other ions
+ endif
+ if (itypi.eq.16) then
+ ityptrani1=1
+ elseif (itypi.eq.1) then
+ ityptrani1=2
+ elseif (itypi.eq.15) then
+ ityptrani1=3
+ elseif (itypi.eq.17) then
+ ityptrani1=4
+ elseif (itypi.eq.2) then
+ ityptrani1=5
+ else
+ ityptrani1=6
+ endif
+ do l=1,3
+ citemp1(l)=c(l,i1+nres)
+ cjtemp1(l)=c(l,j1)
+ enddo
+ sumvec1=0.0d0
+ simplesum1=0.0d0
+ do l=1,3
+ vecsc1(l)=citemp1(l)-c(l,i1)
+ sumvec1=sumvec1+vecsc1(l)**2
+ simplesum1=simplesum1+vecsc1(l)
+ enddo
+ sumvec1=dsqrt(sumvec1)
+ sumdscvec1=0.0d0
+ do l=1,3
+ dsctemp1(l)=c(l,i1)&
+ +(acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)&
+ +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1
+ dscvec1(l)= &
+ (acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)&
+ +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1
+ sumdscvec1=sumdscvec1+dscvec1(l)**2
+ enddo
+ sumdscvec1=dsqrt(sumdscvec1)
+ do l=1,3
+ dscvecnorm1(l)=dscvec1(l)/sumdscvec1
+ enddo
+ call to_box(dsctemp1(1),dsctemp1(2),dsctemp1(3))
+ call to_box(cjtemp1(1),cjtemp1(2),cjtemp1(3))
+ sdist1=0.0d0
+ do l=1,3
+ diff1(l)=boxshift(dsctemp1(l)-cjtemp1(l),boxx(l))
+ sdist1=sdist1+diff1(l)*diff1(l)
+ enddo
+ dista1=sqrt(sdist1)
+ do l=1,3
+ diffnorm1(l)= diff1(l)/dista1
+ enddo
+ sss2min1=sscale2(dista1,r_cut_ang,1.0d0)
+ sss2mingrad1=sscagrad2(dista1,r_cut_ang,1.0d0)
+ if (ityptrani1.gt.ntrantyp(ityptranj1)) cycle
+!---------------before second loop
+! do k2=k1+1,g_listcatscang_end
+ i2=newcontlistcatscangtk(k1)
+ j2=j1
+! print *,"TUTU3",i1,i2,j1,j2
+ if (i2.eq.i1) cycle
+ if (j2.ne.j1) cycle
+ itypi=itype(i2,1) !as the first is the protein part
+ itypj=itype(j2,5) !as the second part is always cation
+ if (itypj.eq.6) then
+ ityptranj2=1 !as now only Zn2+ is this needs to be modified for other ions
+ endif
+ if (itypi.eq.16) then
+ ityptrani2=1
+ elseif (itypi.eq.1) then
+ ityptrani2=2
+ elseif (itypi.eq.15) then
+ ityptrani2=3
+ elseif (itypi.eq.17) then
+ ityptrani2=4
+ elseif (itypi.eq.2) then
+ ityptrani2=5
+ else
+ ityptrani2=6
+ endif
+ if (ityptrani2.gt.ntrantyp(ityptranj2)) cycle
+ do l=1,3
+ citemp2(l)=c(l,i2+nres)
+ cjtemp2(l)=c(l,j2)
+ enddo
+ sumvec2=0.0d0
+ simplesum2=0.0d0
+ do l=1,3
+ vecsc2(l)=citemp2(l)-c(l,i2)
+ sumvec2=sumvec2+vecsc2(l)**2
+ simplesum2=simplesum2+vecsc2(l)
+ enddo
+ sumvec2=dsqrt(sumvec2)
+ sumdscvec2=0.0d0
+ do l=1,3
+ dsctemp2(l)=c(l,i2)&
+ +(acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)&
+ +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2
+ dscvec2(l)= &
+ (acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)&
+ +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2
+ sumdscvec2=sumdscvec2+dscvec2(l)**2
+ enddo
+ sumdscvec2=dsqrt(sumdscvec2)
+ do l=1,3
+ dscvecnorm2(l)=dscvec2(l)/sumdscvec2
+ enddo
+ call to_box(dsctemp2(1),dsctemp2(2),dsctemp2(3))
+ call to_box(cjtemp2(1),cjtemp2(2),cjtemp2(3))
+ sdist2=0.0d0
+ do l=1,3
+ diff2(l)=boxshift(dsctemp2(l)-cjtemp2(l),boxx(l))
+! diff2(l)=1.0d0
+ sdist2=sdist2+diff2(l)*diff2(l)
+ enddo
+ dista2=sqrt(sdist2)
+ do l=1,3
+ diffnorm2(l)= diff2(l)/dista2
+ mindiffnorm2(l)=-diffnorm2(l)
+ enddo
+! print *,i1,i2,diffnorm2(1)
+ cosom1=scalar(diffnorm1(1),diffnorm2(1))
+ sss2min2=sscale2(dista2,r_cut_ang,1.0d0)
+ sss2mingrad2=sscagrad2(dista2,r_cut_ang,1.0d0)
+
+!---------------- before third loop
+! do k3=g_listcatscang_start,g_listcatscang_end
+ ene=0.0d0
+ i3=newcontlistcatscangtl(k1)
+ j3=j1
+! print *,"TUTU4",i1,i2,i3,j1,j2,j3
+
+ if (i3.eq.i2) cycle
+ if (i3.eq.i1) cycle
+ if (j3.ne.j1) cycle
+ itypi=itype(i3,1) !as the first is the protein part
+ itypj=itype(j3,5) !as the second part is always cation
+ if (itypj.eq.6) then
+ ityptranj3=1 !as now only Zn2+ is this needs to be modified for other ions
+ endif
+ if (itypi.eq.16) then
+ ityptrani3=1
+ elseif (itypi.eq.1) then
+ ityptrani3=2
+ elseif (itypi.eq.15) then
+ ityptrani3=3
+ elseif (itypi.eq.17) then
+ ityptrani3=4
+ elseif (itypi.eq.2) then
+ ityptrani3=5
+ else
+ ityptrani3=6
+ endif
+ if (ityptrani3.gt.ntrantyp(ityptranj3)) cycle
+ do l=1,3
+ citemp3(l)=c(l,i3+nres)
+ cjtemp3(l)=c(l,j3)
+ enddo
+ sumvec3=0.0d0
+ simplesum3=0.0d0
+ do l=1,3
+ vecsc3(l)=citemp3(l)-c(l,i3)
+ sumvec3=sumvec3+vecsc3(l)**2
+ simplesum3=simplesum3+vecsc3(l)
+ enddo
+ sumvec3=dsqrt(sumvec3)
+ sumdscvec3=0.0d0
+ do l=1,3
+ dsctemp3(l)=c(l,i3)&
+ +(acatshiftdsc(ityptrani3,ityptranj3))*vecsc3(l)&
+ +bcatshiftdsc(ityptrani3,ityptranj3)*vecsc3(l)/sumvec3
+ dscvec3(l)= &
+ (acatshiftdsc(ityptrani3,ityptranj3))*vecsc3(l)&
+ +bcatshiftdsc(ityptrani3,ityptranj3)*vecsc3(l)/sumvec3
+ sumdscvec3=sumdscvec3+dscvec3(l)**2
+ enddo
+ sumdscvec3=dsqrt(sumdscvec3)
+ do l=1,3
+ dscvecnorm3(l)=dscvec3(l)/sumdscvec3
+ enddo
+ call to_box(dsctemp3(1),dsctemp3(2),dsctemp3(3))
+ call to_box(cjtemp3(1),cjtemp3(2),cjtemp3(3))
+ sdist3=0.0d0
+ do l=1,3
+ diff3(l)=boxshift(dsctemp3(l)-dsctemp2(l),boxx(l))
+ sdist3=sdist3+diff3(l)*diff3(l)
+ enddo
+ dista3=sqrt(sdist3)
+ do l=1,3
+ diffnorm3(l)= diff3(l)/dista3
+ enddo
+ sdist4=0.0d0
+ do l=1,3
+ diff4(l)=boxshift(dsctemp3(l)-cjtemp2(l),boxx(l))
+! diff2(l)=1.0d0
+ sdist4=sdist4+diff4(l)*diff4(l)
+ enddo
+ dista4=sqrt(sdist4)
+ do l=1,3
+ diffnorm4(l)= diff4(l)/dista4
+ enddo
+
+ sss2min3=sscale2(dista4,r_cut_ang,1.0d0)
+ sss2mingrad3=sscagrad2(dista4,r_cut_ang,1.0d0)
+ sssmintot=sss2min3*sss2min2*sss2min1
+ if (ityptrani3.gt.ntrantyp(ityptranj3)) cycle
+ cosom12=scalar(diffnorm3(1),diffnorm1(1))
+ cosom2=scalar(diffnorm3(1),mindiffnorm2(1))
+ sinom1=dsqrt(1.0d0-cosom1*cosom1)
+ sinom2=dsqrt(1.0d0-cosom2*cosom2)
+ cosphi=cosom12-cosom1*cosom2
+ sinaux=sinom1*sinom2
+ ene=ene+mytschebyshev(1,3,agamacattran(1,ityptrani2,ityptranj2),cosphi,sinaux)
+ call mygradtschebyshev(1,3,agamacattran(1,ityptrani2,ityptranj2)&
+ ,cosphi,sinaux,dephiij,det1t2ij)
+
+ det1ij=-det1t2ij*sinom2*cosom1/sinom1-dephiij*cosom2
+ det2ij=-det1t2ij*sinom1*cosom2/sinom2-dephiij*cosom1
+ facd1=bcatshiftdsc(ityptrani1,ityptranj1)/sumvec1
+ facd2=bcatshiftdsc(ityptrani2,ityptranj2)/sumvec2
+! facd2b=bcatshiftdsc(ityptrani2,ityptranj2)/sumvec3
+ facd3=bcatshiftdsc(ityptrani3,ityptranj3)/sumvec3
+ scal1a=scalar(diffnorm1(1),dc_norm(1,i1+nres))
+ scal1b=scalar(diffnorm2(1),dc_norm(1,i1+nres))
+ scal1c=scalar(diffnorm3(1),dc_norm(1,i1+nres))
+ scal2a=scalar(diffnorm1(1),dc_norm(1,i2+nres))
+ scal2b=scalar(diffnorm2(1),dc_norm(1,i2+nres))
+ scal2c=scalar(diffnorm3(1),dc_norm(1,i2+nres))
+ scal3a=scalar(diffnorm1(1),dc_norm(1,i3+nres))
+ scal3b=scalar(mindiffnorm2(1),dc_norm(1,i3+nres))
+ scal3d=scalar(diffnorm2(1),dc_norm(1,i3+nres))
+ scal3c=scalar(diffnorm3(1),dc_norm(1,i3+nres))
+ scal3e=scalar(diffnorm4(1),dc_norm(1,i3+nres))
- 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
+ do l=1,3
+ pom1=diffnorm1(l)+facd1*(diffnorm1(l)-scal1a*dc_norm(l,i1+nres))
+ pom2=diffnorm2(l)+facd2*(diffnorm2(l)-scal2b*dc_norm(l,i2+nres))
+ pom3=diffnorm4(l)+facd3*(diffnorm4(l)-scal3e*dc_norm(l,i3+nres))
+
+ gradcatangc(l,i1)=gradcatangc(l,i1)&
+ +det1ij*sssmintot*(diff2(l)-diffnorm1(l)*cosom1*dista2)/(dista2*dista1)+&
+ dephiij*sssmintot*(diff3(l)-diffnorm1(l)*cosom12*dista3)/(dista3*dista1)&
+ +ene*sss2mingrad1*diffnorm1(l)*sss2min2*sss2min3
+
+
+ gradcatangc(l,i2)=gradcatangc(l,i2)+(&
+ det1ij*(diff1(l)-diffnorm2(l)*cosom1*dista1)/(dista2*dista1)+&
+ det2ij*(-diff3(l)+mindiffnorm2(l)*cosom2*dista3)/(dista3*dista2)&
+ -det2ij*(-diff2(l)-diffnorm3(l)*cosom2*dista2)/(dista3*dista2)&
+ -dephiij*(diff1(l)-diffnorm3(l)*cosom12*dista1)/(dista3*dista1))*sssmintot&
+ +ene*sss2mingrad2*diffnorm2(l)*sss2min1*sss2min3
+
+
+
+ gradcatangc(l,i3)=gradcatangc(l,i3)&
+ +det2ij*(-diff2(l)-diffnorm3(l)*cosom2*dista2)/(dista3*dista2)*sssmintot&
+ +dephiij*(diff1(l)-diffnorm3(l)*cosom12*dista1)/(dista3*dista1)*sssmintot&
+ +ene*sss2mingrad3*diffnorm4(l)*sss2min1*sss2min2
+
+
+ gradcatangc(l,j1)=gradcatangc(l,j1)-&
+ sssmintot*(det1ij*(diff2(l)-diffnorm1(l)*cosom1*dista2)/(dista2*dista1)+&
+ dephiij*(diff3(l)-diffnorm1(l)*cosom12*dista3)/(dista3*dista1))&
+ -(det1ij*(diff1(l)-diffnorm2(l)*cosom1*dista1)/(dista1*dista2)+&
+ det2ij*(-diff3(l)+mindiffnorm2(l)*cosom2*dista3)/(dista3*dista2))*sssmintot&
+ -ene*sss2mingrad1*diffnorm1(l)*sss2min2*sss2min3&
+ -ene*sss2mingrad2*diffnorm2(l)*sss2min1*sss2min3&
+ -ene*sss2mingrad3*diffnorm4(l)*sss2min1*sss2min2
+
+
+ gradcatangx(l,i1)=gradcatangx(l,i1)+(det1ij/(dista2*dista1)*&
+ (acatshiftdsc(ityptrani1,ityptranj1)*diff2(l)+&
+ facd1*(diff2(l)-scal1b*dc_norm(l,i1+nres)*dista2)-&
+ cosom1*dista2/dista1*&
+ (acatshiftdsc(ityptrani1,ityptranj1)*diff1(l)+&
+ facd1*(diff1(l)-scal1a*dc_norm(l,i1+nres)*dista1)))&
+ +dephiij/(dista3*dista1)*&
+ (acatshiftdsc(ityptrani1,ityptranj1)*diff3(l)+&
+ facd1*(diff3(l)-scal1c*dc_norm(l,i1+nres)*dista3)-&
+ cosom12*dista3/dista1*&
+ (acatshiftdsc(ityptrani1,ityptranj1)*diff1(l)+&
+ facd1*(diff1(l)-scal1a*dc_norm(l,i1+nres)*dista1))))*sssmintot&
+ +ene*sss2mingrad1*sss2min2*sss2min3*(pom1+&
+ diffnorm1(l)*(acatshiftdsc(ityptrani1,ityptranj1)-1.0d0))
+
+
+ gradcatangx(l,i3)=gradcatangx(l,i3)+(&
+ det2ij/(dista3*dista2)*&
+ (acatshiftdsc(ityptrani3,ityptranj3)*(-diff2(l))+&
+ facd3*(-diff2(l)-scal3b*dc_norm(l,i3+nres)*dista2)-&
+ cosom2*dista2/dista3*&
+ (acatshiftdsc(ityptrani3,ityptranj3)*diff3(l)+&
+ facd3*(diff3(l)-scal3c*dc_norm(l,i3+nres)*dista3)))&
+ +dephiij/(dista3*dista1)*&
+ (acatshiftdsc(ityptrani3,ityptranj3)*diff1(l)+&
+ facd3*(diff1(l)-scal3a*dc_norm(l,i3+nres)*dista1)-&
+ cosom12*dista1/dista3*&
+ (acatshiftdsc(ityptrani3,ityptranj3)*diff3(l)+&
+ facd3*(diff3(l)-scal3c*dc_norm(l,i3+nres)*dista3))))*sssmintot&
+ +ene*sss2mingrad3*sss2min2*sss2min1*(pom3+&
+ diffnorm4(l)*(acatshiftdsc(ityptrani3,ityptranj3)-1.0d0))
+
+
+ gradcatangx(l,i2)=gradcatangx(l,i2)+(&!
+ det1ij/(dista2*dista1)*&!
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff1(l)&!
+ +facd2*(diff1(l)-scal2a*dc_norm(l,i2+nres)*dista1)&
+ -cosom1*dista1/dista2*&!
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+&!
+ facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2)))+&
+ det2ij/(dista3*dista2)*&!
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+&!
+ facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2)&
+ -(acatshiftdsc(ityptrani2,ityptranj2)*diff3(l)+&!
+ facd2*(diff3(l)-scal2c*dc_norm(l,i2+nres)*dista3))&
+ -cosom2*dista3/dista2*&!
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+&!
+ facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2))&
+ +cosom2*dista2/dista3*&!
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff3(l)+&!
+ facd2*(diff3(l)-scal2c*dc_norm(l,i2+nres)*dista3)))&
+ +dephiij/(dista3*dista1)*&!
+ (-(acatshiftdsc(ityptrani2,ityptranj2)*diff1(l)+&!
+ facd2*(diff1(l)-scal2a*dc_norm(l,i2+nres)*dista1))+&
+ cosom12*dista1/dista3*&!
+ (acatshiftdsc(ityptrani2,ityptranj2)*diff3(l)+&!
+ facd2*(diff3(l)-scal2c*dc_norm(l,i2+nres)*dista3))))*sssmintot&
+ +ene*sss2mingrad2*sss2min3*sss2min1*(pom2+&
+ diffnorm2(l)*(acatshiftdsc(ityptrani2,ityptranj2)-1.0d0))
-! & + 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
+! print *,i1,i2,i3,j1,j2,j3,"tors",ene,sinaux,cosphi
+! print *,"param",agamacattran(1,ityptrani2,ityptranj2),ityptranj2,ityptrani2
+ ecation_protang=ecation_protang+ene*sssmintot
enddo
-
+! enddo
+! enddo
+!#endif
+ return
+ end subroutine
+!--------------------------------------------------------------------------
+!c------------------------------------------------------------------------------
+ double precision function mytschebyshev(m,n,x,y,yt)
+ implicit none
+ integer i,m,n
+ double precision x(n),y,yt,yy(0:100),aux
+!c Tschebyshev polynomial in y multiplied by sin(t1)sin(t2) (yt).
+!c Note that the first term is omitted
+!c m=0: the constant term is included
+!c m=1: the constant term is not included
+ yy(0)=1.0d0
+ yy(1)=y
+ do i=2,n
+ yy(i)=2*yy(1)*yy(i-1)-yy(i-2)*yt*yt
+ enddo
+ aux=0.0d0
+ do i=m,n
+ aux=aux+x(i)*yy(i)
+ enddo
+!c print *,(yy(i),i=1,n)
+ mytschebyshev=aux
+ return
+ end function
+!C--------------------------------------------------------------------------
+!C--------------------------------------------------------------------------
+ subroutine mygradtschebyshev(m,n,x,y,yt,fy,fyt)
+ implicit none
+ integer i,m,n
+ double precision x(n+1),y,yt,fy,fyt,yy(0:100),yb(0:100), &
+ ybt(0:100)
+!c Derivative of Tschebyshev polynomial in y multiplied by sin(t1)sin(t2) (yt).
+!c Note that the first term is omitted
+!c m=0: the constant term is included
+!c m=1: the constant term is not included
+ yy(0)=1.0d0
+ yy(1)=y
+ yb(0)=0.0d0
+ yb(1)=1.0d0
+ ybt(0)=0.0d0
+ ybt(1)=0.0d0
+ do i=2,n
+ yy(i)=2*yy(1)*yy(i-1)-yy(i-2)*yt*yt
+ yb(i)=2*yy(i-1)+2*yy(1)*yb(i-1)-yb(i-2)*yt*yt
+ ybt(i)=2*yy(1)*ybt(i-1)-ybt(i-2)*yt*yt-2*yy(i-2)*yt
enddo
+ fy=0.0d0
+ fyt=0.0d0
+ do i=m,n
+ fy=fy+x(i)*yb(i)
+ fyt=fyt+x(i)*ybt(i)
+ enddo
+ return
+ end subroutine
+ subroutine fodstep(nsteps)
+ use geometry_data, only: c, nres, theta, alph
+ use geometry, only:alpha,beta,dist
+ integer, intent(in) :: nsteps
+ integer idxtomod, j, i
+ double precision RD0, RD1, fi
+! double precision alpha
+! double precision beta
+! double precision dist
+! double precision compute_RD
+ double precision TT
+ real :: r21(5)
+!c ! Założenia: dla łańcucha zapisanego w tablicy c zawierającego
+!c ! nres elementów CA i CB da się wyznaczyć kąty płaskie
+!c ! theta (procedura Alpha) i kąty torsyjne (procedura beta),
+!c ! zapisywane w tablicach theta i alph.
+!c ! Na podstawie danych z tych tablic da się odtworzyć
+!c ! strukturę 3D łańcucha procedurą chainbuild.
+!c !
+! print *,"fodstep: nres=",nres
+ RD0 = compute_RD()
+! print *, "RD0before step: ",RD0
+ do j=1,nsteps
+!c ! Wyznaczenie kątów theta na podstawie struktury
+!c ! zapisanej w tablicy c
+ do i=3,nres
+ TT=alpha(i-2,i-1,i)
+ theta(i)=TT
+!c print *,"TT=",TT
+ end do
+!c ! Wyznaczenie kątów phi na podstawie struktury
+!c ! zapisanej w tablicy c
+ do i=4,nres
+ phi(i)=beta(i-3,i-2,i-1,i)
+ end do
+!c ! Wyznaczenie odległości między atomami
+!c ! vbld(i)=dist(i-1,i)
+ do i=2,nres
+ vbld(i)=dist(i-1,i)
+ end do
+!c ! losujemy kilka liczb
+ call random_number(r21)
+!c ! r21(1): indeks pozycji do zmiany
+!c ! r21(2): kąt (r21(2)/20.0-1/40.0)
+!c ! r21(3): wybór tablicy
+ RD0 = compute_RD()
+!c print *, "RD before step: ",RD0
+ fi = (r21(2)/20.0-1.0/40.0) ! o tyle radianów zmienimy losowy kąt
+ if (r21(3) .le. 0.5) then
+ idxtomod = 3+r21(1)*(nres - 2)
+ theta(idxtomod) = theta(idxtomod)+fi
+! print *,"Zmiana kąta theta(",&
+! idxtomod,") o fi = ",fi
+ else
+ idxtomod = 4+r21(1)*(nres - 3)
+ phi(idxtomod) = phi(idxtomod)+fi
+! print *,"Zmiana kąta phi(",&
+! idxtomod,") o fi = ",fi
+ end if
+!c ! odtwarzamy łańcuch
+ call chainbuild
+!c ! czy coś się polepszyło?
+ RD1 = compute_RD()
+ if (RD1 .gt. RD0) then ! nie, wycofujemy zmianę
+! print *, "RD after step: ",RD1," rejected"
+ if (r21(3) .le. 0.5) then
+ theta(idxtomod) = theta(idxtomod)-fi
+ else
+ phi(idxtomod) = phi(idxtomod)-fi
+ end if
+ call chainbuild ! odtworzenie pierwotnej wersji (bez zmienionego kąta)
+ else
+! print *, "RD after step: ",RD1," accepted"
+ continue
+ end if
+ end do
+ end subroutine
+!c-----------------------------------------------------------------------------------------
+ subroutine orientation_matrix(res) ! obliczenie macierzy oraz przygotowanie ea z tymi przeksztalceniami
+ use geometry_data, only: c, nres
+ use energy_data, only: itype
+ double precision, intent(out) :: res(4,4)
+ double precision resM(4,4)
+ double precision M(4,4)
+ double precision M2(4,4)
+ integer i, j, maxi, maxj
+! double precision sq
+ double precision maxd, dd
+ double precision v1(3)
+ double precision v2(3)
+ double precision vecnea(3)
+ double precision mean_ea(3)
+ double precision fi
+!c ! liczymy atomy efektywne i zapisujemy w tablicy ea
+ do i=1,nres
+!c if (itype(i,1) .ne. 10) then
+ if (itype(i,1) .ne. 10) then
+ ea(1,i) = c(1,i+nres)
+ ea(2,i) = c(2,i+nres)
+ ea(3,i) = c(3,i+nres)
+ else
+ ea(1,i) = c(1,i)
+ ea(2,i) = c(2,i)
+ ea(3,i) = c(3,i)
+ end if
+ end do
+ call IdentityM(resM)
+ if (nres .le. 2) then
+ print *, "nres too small (should be at least 2), stopping"
+ stop
+ end if
+ do i=1,3
+ v1(i)=ea(i,1)
+ v2(i)=ea(i,2)
+ end do
+!c ! szukamy najwiekszej odleglosci miedzy atomami efektywnymi ea
+ call Dist3d(maxd,v1,v2)
+!c ! odleglosc miedzy pierwsza para atomow efektywnych
+ maxi = 1
+ maxj = 2
+ do i=1,nres-1
+ do j=i+1,nres
+ v1(1)=ea(1,i)
+ v1(2)=ea(2,i)
+ v1(3)=ea(3,i)
+ v2(1)=ea(1,j)
+ v2(2)=ea(2,j)
+ v2(3)=ea(3,j)
+ call Dist3d(dd,v1,v2)
+ if (dd .gt. maxd) then
+ maxd = dd
+ maxi = i
+ maxj = j
+ end if
+ end do
+ end do
+ vecnea(1)=ea(1,maxi)-ea(1,maxj)
+ vecnea(2)=ea(2,maxi)-ea(2,maxj)
+ vecnea(3)=ea(3,maxi)-ea(3,maxj)
+ if (vecnea(1) .lt. 0) then
+ vecnea(1) = -vecnea(1)
+ vecnea(2) = -vecnea(2)
+ vecnea(3) = -vecnea(3)
+ end if
+!c ! obliczenie kata obrotu wokol osi Z
+ fi = -atan2(vecnea(2),vecnea(1))
+ call RotateZ(M,fi)
+!c ! obliczenie kata obrotu wokol osi Y
+ fi = atan2(vecnea(3), sqrt(sq(vecnea(1))+sq(vecnea(2))))
+ call RotateY(M2,fi)
+ M = matmul(M2,M)
+!c ! Przeksztalcamy wszystkie atomy efektywne
+!c ! uzyskujac najwieksza odleglosc ulożona wzdluz OX
+!c ! ea = transform_eatoms(ea,M)
+ do i=1,nres
+ v1(1)=ea(1,i)
+ v1(2)=ea(2,i)
+ v1(3)=ea(3,i)
+ call tranform_point(v2,v1,M)
+ ea(1,i)=v2(1)
+ ea(2,i)=v2(2)
+ ea(3,i)=v2(3)
+ end do
+ resM = M
+!c ! Teraz szukamy najdluzszego rzutu na plaszczyzne YZ
+!c ! (czyli w liczeniu odleglosci bierzemy pod uwage tylko wsp. y, z)
+ maxd = sqrt( sq(ea(2,1)-ea(2,2)) + sq(ea(3,1)-ea(3,2))) ! aktualnie max odl
+ maxi = 1 ! indeksy atomow
+ maxj = 2 ! miedzy ktorymi jest max odl (chwilowe)
+ do i=1,nres-1
+ do j=i+1,nres
+ dd = sqrt( (ea(2,i)-ea(2,j))**2 + (ea(3,i)-ea(3,j))**2)
+ if (dd .gt. maxd) then
+ maxd = dd
+ maxi = i
+ maxj = j
+ end if
+ end do
+ end do
+!c ! Teraz obrocimy wszystko wokol OX tak, zeby znaleziony rzut
+!c ! byl rownolegly do OY
+ vecnea(1) = ea(1,maxi)-ea(1,maxj)
+ vecnea(2) = ea(2,maxi)-ea(2,maxj)
+ vecnea(3) = ea(3,maxi)-ea(3,maxj)
+!c ! jeśli współrzędna vecnea.y < 0, to robimy odwrotnie
+ if (vecnea(2) .lt. 0) then
+ vecnea(1) = -vecnea(1)
+ vecnea(2) = -vecnea(2)
+ vecnea(3) = -vecnea(3)
+ end if
+!c ! obliczenie kąta obrotu wokół osi X
+ fi = -atan2(vecnea(3),vecnea(2))
+ call RotateX(M,fi)
+!c ! Przeksztalcamy wszystkie atomy efektywne
+ do i=1,nres
+ v1(1)=ea(1,i)
+ v1(2)=ea(2,i)
+ v1(3)=ea(3,i)
+ call tranform_point(v2,v1,M)
+ ea(1,i)=v2(1)
+ ea(2,i)=v2(2)
+ ea(3,i)=v2(3)
+ end do
+ resM = matmul(M,resM) ! zbieramy wynik (sprawdzic kolejnosc M,resM)
+!c ! centrujemy
+ mean_ea(1) = 0
+ mean_ea(2) = 0
+ mean_ea(3) = 0
+ do i=1,nres
+ mean_ea(1) = mean_ea(1) + ea(1,i)
+ mean_ea(2) = mean_ea(2) + ea(2,i)
+ mean_ea(3) = mean_ea(3) + ea(3,i)
+ end do
+ v1(1) = -mean_ea(1)/nres
+ v1(2) = -mean_ea(2)/nres
+ v1(3) = -mean_ea(3)/nres
+ call TranslateV(M,v1)
+ resM = matmul(M,resM)
+!c ! przesuwamy
+ do i=1,nres
+ ea(1,i) = ea(1,i) + v1(1)
+ ea(2,i) = ea(2,i) + v1(2)
+ ea(3,i) = ea(3,i) + v1(3)
+ end do
+ res = resM
+!c ! wynikowa macierz przeksztalcenia lancucha
+!c ! (ale lancuch w ea juz mamy przeksztalcony)
+ return
+ end subroutine
+ double precision function compute_rd
+ use geometry_data, only: nres
+ use energy_data, only: itype
+ implicit none
+ double precision or_mat(4,4)
+! double precision hydrophobicity
+ integer neatoms
+ double precision cutoff
+ double precision ho(70000)
+ double precision ht(70000)
+ double precision hosum, htsum
+ double precision marg, sigmax, sigmay, sigmaz
+ integer i, j
+ double precision v1(3)
+ double precision v2(3)
+ double precision rijdivc, coll, tmpkwadrat, tmppotega, dist
+ double precision OdivT, OdivR, ot_one, or_one, RD_classic
+ call orientation_matrix(or_mat)
+!c ! tam juz liczy sie tablica ea
+ neatoms = nres
+ cutoff = 8.99d0
+!c ! granica oddzialywania w A (powyzej ignorujemy oddzialywanie)
+!c ! Najpierw liczymy "obserwowana hydrofobowosc"
+ hosum = 0.0d0 ! na sume pol ho, do celow pozniejszej normalizacji
+ do j=1,neatoms
+ ho(j)=0.0d0
+ do i=1,neatoms
+ if (j .eq. i) then ! nie uwzgledniamy oddzialywania atomu z samym soba
+ cycle
+ end if
+ v1(1)=ea(1,i)
+ v1(2)=ea(2,i)
+ v1(3)=ea(3,i)
+ v2(1)=ea(1,j)
+ v2(2)=ea(2,j)
+ v2(3)=ea(3,j)
+ call Dist3d(dist,v1,v2) ! odleglosc miedzy atomami
+ if (dist .gt. cutoff) then ! za daleko, nie uwzgledniamy
+ cycle
+ end if
+ rijdivc = dist / cutoff
+ coll = 0.0d0
+ tmppotega = rijdivc*rijdivc
+ tmpkwadrat = tmppotega
+ coll = coll + 7*tmpkwadrat
+ tmppotega = tmppotega * tmpkwadrat ! do potęgi 4
+ coll = coll - 9*tmppotega
+ tmppotega = tmppotega * tmpkwadrat ! do potęgi 6
+ coll = coll + 5*tmppotega
+ tmppotega = tmppotega * tmpkwadrat ! do potęgi 8
+ coll = coll - tmppotega
+!c ! Wersja: Bryliński 2007
+!c ! EAtoms[j].collectedhp += EAtoms[i].hyphob*(1 - 0.5 * coll);
+!c ! ea$ho[j] = ea$ho[j] + hydrophobicity(ea$resid[i])*(1-0.5*coll)
+!c ! Wersja: Banach Konieczny Roterman 2014
+!c ! EAtoms[j].collectedhp += (EAtoms[i].hyphob+EAtoms[j].hyphob)*(1 - 0.5 * coll);
+!c ponizej bylo itype(i,1) w miejscu itype(i) oraz itype(j,1) w miejscu itype(j)
+ ho(j) = ho(j) + (hydrophobicity(itype(i,1))+&
+ hydrophobicity(itype(j,1)))*(1.0d0-0.5_8*coll)
+ end do
+ hosum = hosum + ho(j)
+ end do
+!c ! Normalizujemy
+ do i=1,neatoms
+ ho(i) = ho(i) / hosum
+ end do
+!c ! Koniec liczenia hydrofobowosci obserwowanej (profil ho)
+!c ! Teraz liczymy "teoretyczna hydrofobowosc", wedlug kropli i rozkladu Gaussa
+ htsum = 0.0d0
+!c ! tu zbieramy sume ht, uzyjemy potem do normalizacji
+!c ! Ustalimy teraz parametry rozkladu Gaussa, czyli sigmy (srodek jest w (0,0,0)).
+!c ! To bedzie (max odl od srodka + margines) / 3, oddzielnie dla kazdej wspolrzednej.
+ marg = 9.0d0
+ htsum = 0.0d0
+!c ! jeszcze raz zerujemy
+!c ! szukamy ekstremalnej wartosci wspolrzednej x (max wart bezwzgl)
+ sigmax = ea(1,1)
+ do i=2,neatoms
+ if (abs(ea(1,i))>sigmax) then
+ sigmax = abs(ea(1,i))
+ end if
+ end do
+ sigmax = (marg + sigmax) / 3.0d0
+!c ! szukamy ekstremalnej wartosci wspolrzednej y (max wart bezwzgl)
+ sigmay = ea(2,1)
+ do i=2,neatoms
+ if (abs(ea(2,i))>sigmay) then
+ sigmay = abs(ea(2,i))
+ end if
+ end do
+ sigmay = (marg + sigmay) / 3.0d0
+!c ! szukamy ekstremalnej wartosci wspolrzednej z (max wart bezwzgl)
+ sigmaz = ea(3,1)
+ do i=2,neatoms
+ if (abs(ea(3,i))>sigmaz) then
+ sigmaz = abs(ea(3,i))
+ end if
+ end do
+ sigmaz = (marg + sigmaz) / 3.0d0
+!c !sigmax = (marg + max(abs(max(ea$acoor[,1])), abs(min(ea$acoor[,1]))))/3.0
+!c !sigmay = (marg + max(abs(max(ea$acoor[,2])), abs(min(ea$acoor[,2]))))/3.0
+!c !sigmaz = (marg + max(abs(max(ea$acoor[,3])), abs(min(ea$acoor[,3]))))/3.0
+!c ! print *,"sigmax =",sigmax," sigmay =",sigmay," sigmaz = ",sigmaz
+ do j=1,neatoms
+ ht(j)= exp(-(ea(1,j))**2/(2*sigmax**2))&
+ * exp(-(ea(2,j))**2/(2*sigmay**2)) &
+ * exp(-(ea(3,j))**2/(2*sigmaz**2))
+ htsum = htsum + ht(j)
+ end do
+!c ! Normalizujemy
+ do i=1, neatoms
+ ht(i) = ht(i) / htsum
+ end do
+!c ! Teraz liczymy RD
+ OdivT = 0.0d0
+ OdivR = 0.0d0
+ do j=1,neatoms
+ if (ho(j) .ne. 0) then
+ ot_one = ho(j) * log(ho(j)/ht(j)) / log(2.0d0)
+ OdivT = OdivT + ot_one
+ or_one = ho(j) * log(ho(j)/ (1.0d0/neatoms)) / log(2.0_8)
+ OdivR = OdivR + or_one
+ endif
+ end do
+ RD_classic = OdivT / (OdivT+OdivR)
+ compute_rd = RD_classic
+ return
+ end function
+ function hydrophobicity(id) ! do przepisania (bylo: identyfikowanie aa po nazwach)
+ integer id
+ double precision hydrophobicity
+ hydrophobicity = 0.0d0
+ if (id .eq. 1) then
+ hydrophobicity = 1.000d0 ! CYS
+ return
+ endif
+ if (id .eq. 2) then
+ hydrophobicity = 0.828d0 ! MET
+ return
+ endif
+ if (id .eq. 3) then
+ hydrophobicity = 0.906d0 ! PHE
+ return
+ endif
+ if (id .eq. 4) then
+ hydrophobicity = 0.883d0 ! ILE
+ return
+ endif
+ if (id .eq. 5) then
+ hydrophobicity = 0.783d0 ! LEU
+ return
+ endif
+ if (id .eq. 6) then
+ hydrophobicity = 0.811d0 ! VAL
+ return
+ endif
+ if (id .eq. 7) then
+ hydrophobicity = 0.856d0 ! TRP
+ return
+ endif
+ if (id .eq. 8) then
+ hydrophobicity = 0.700d0 ! TYR
+ return
+ endif
+ if (id .eq. 9) then
+ hydrophobicity = 0.572d0 ! ALA
+ return
+ endif
+ if (id .eq. 10) then
+ hydrophobicity = 0.550d0 ! GLY
+ return
+ endif
+ if (id .eq. 11) then
+ hydrophobicity = 0.478d0 ! THR
+ return
+ endif
+ if (id .eq. 12) then
+ hydrophobicity = 0.422d0 ! SER
+ return
+ endif
+ if (id .eq. 13) then
+ hydrophobicity = 0.250d0 ! GLN
+ return
+ endif
+ if (id .eq. 14) then
+ hydrophobicity = 0.278d0 ! ASN
+ return
+ endif
+ if (id .eq. 15) then
+ hydrophobicity = 0.083d0 ! GLU
+ return
+ endif
+ if (id .eq. 16) then
+ hydrophobicity = 0.167d0 ! ASP
+ return
+ endif
+ if (id .eq. 17) then
+ hydrophobicity = 0.628d0 ! HIS
+ return
+ endif
+ if (id .eq. 18) then
+ hydrophobicity = 0.272d0 ! ARG
+ return
+ endif
+ if (id .eq. 19) then
+ hydrophobicity = 0.000d0 ! LYS
+ return
+ endif
+ if (id .eq. 20) then
+ hydrophobicity = 0.300d0 ! PRO
+ return
+ endif
+ return
+ end function hydrophobicity
+ subroutine mycrossprod(res,b,c)
+ implicit none
+ double precision, intent(out) :: res(3)
+ double precision, intent(in) :: b(3)
+ double precision, intent(in) :: c(3)
+!c ! Tylko dla wektorów trójwymiarowych, ale nie sprawdzamy tego tutaj
+ res(1) = b(2)*c(3)-b(3)*c(2)
+ res(2) = b(3)*c(1)-b(1)*c(3)
+ res(3) = b(1)*c(2)-b(2)*c(1)
+ return
+ end subroutine
+ subroutine mydotprod(res,b,c)
+ implicit none
+ double precision, intent(out) :: res
+ double precision, intent(in) :: b(3)
+ double precision, intent(in) :: c(3)
+!c ! Tylko dla wektorów trójwymiarowych, ale nie sprawdzamy tego tutaj
+ res = b(1)*c(1)+b(2)*c(2)+b(3)*c(3)
+ return
+ end subroutine
+!c ! cosinus k¹ta miêdzy wektorami trójwymiarowymi
+ subroutine cosfi(res, x, y)
+ implicit none
+ double precision, intent(out) :: res
+ double precision, intent(in) :: x(3)
+ double precision, intent(in) :: y(3)
+ double precision LxLy
+ LxLy=sqrt(x(1)*x(1)+x(2)*x(2)+x(3)*x(3)) *&
+ sqrt(y(1)*y(1)+y(2)*y(2)+y(3)*y(3))
+ if (LxLy==0.0) then
+ res = 0.0d0
+ else
+ call mydotprod(res,x,y)
+ res = res / LxLy
+ end if
+ return
+ end subroutine
+
+
+ subroutine Dist3d(res,v1,v2)
+ implicit none
+ double precision, intent(out) :: res
+ double precision, intent(in) :: v1(3)
+ double precision, intent(in) :: v2(3)
+! double precision sq
+ res = sqrt( sq(v1(1)-v2(1)) + sq(v1(2)-v2(2)) + sq(v1(3)-v2(3)))
+ return
+ end subroutine
+!c ! Przeksztalca wsp. 3d uzywajac macierzy przeksztalcenia M (4x4)
+ subroutine tranform_point(res,v3d,M)
+ implicit none
+ double precision, intent(out) :: res(3)
+ double precision, intent(in) :: v3d(3)
+ double precision, intent(in) :: M(4,4)
+
+ res(1) = M(1,1)*v3d(1) + M(1,2)*v3d(2) + M(1,3)*v3d(3) + M(1,4)
+ res(2) = M(2,1)*v3d(1) + M(2,2)*v3d(2) + M(2,3)*v3d(3) + M(2,4)
+ res(3) = M(3,1)*v3d(1) + M(3,2)*v3d(2) + M(3,3)*v3d(3) + M(3,4)
+ return
+ end subroutine
+!c ! TranslateV: macierz translacji o wektor V
+ subroutine TranslateV(res,V)
+ implicit none
+ double precision, intent(out) :: res(4,4)
+ double precision, intent(in) :: v(3)
+ res(1,1) = 1.0d0
+ res(1,2) = 0
+ res(1,3) = 0
+ res(1,4) = v(1)
+ res(2,1) = 0
+ res(2,2) = 1.0d0
+ res(2,3) = 0
+ res(2,4) = v(2)
+ res(3,1) = 0
+ res(3,2) = 0
+ res(3,3) = 1.0d0
+ res(3,4) = v(3)
+ res(4,1) = 0
+ res(4,2) = 0
+ res(4,3) = 0
+ res(4,4) = 1.0d0
+ return
+ end subroutine
+!c ! RotateX: macierz obrotu wokol osi OX o kat fi
+ subroutine RotateX(res,fi)
+ implicit none
+ double precision, intent(out) :: res(4,4)
+ double precision, intent(in) :: fi
+ res(1,1) = 1.0d0
+ res(1,2) = 0
+ res(1,3) = 0
+ res(1,4) = 0
+ res(2,1) = 0
+ res(2,2) = cos(fi)
+ res(2,3) = -sin(fi)
+ res(2,4) = 0
+ res(3,1) = 0
+ res(3,2) = sin(fi)
+ res(3,3) = cos(fi)
+ res(3,4) = 0
+ res(4,1) = 0
+ res(4,2) = 0
+ res(4,3) = 0
+ res(4,4) = 1.0d0
+ return
+ end subroutine
+!c ! RotateY: macierz obrotu wokol osi OY o kat fi
+ subroutine RotateY(res,fi)
+ implicit none
+ double precision, intent(out) :: res(4,4)
+ double precision, intent(in) :: fi
+ res(1,1) = cos(fi)
+ res(1,2) = 0
+ res(1,3) = sin(fi)
+ res(1,4) = 0
+ res(2,1) = 0
+ res(2,2) = 1.0d0
+ res(2,3) = 0
+ res(2,4) = 0
+ res(3,1) = -sin(fi)
+ res(3,2) = 0
+ res(3,3) = cos(fi)
+ res(3,4) = 0
+ res(4,1) = 0
+ res(4,2) = 0
+ res(4,3) = 0
+ res(4,4) = 1.0d0
+ return
+ end subroutine
+!c ! RotateZ: macierz obrotu wokol osi OZ o kat fi
+ subroutine RotateZ(res,fi)
+ implicit none
+ double precision, intent(out) :: res(4,4)
+ double precision, intent(in) :: fi
+ res(1,1) = cos(fi)
+ res(1,2) = -sin(fi)
+ res(1,3) = 0
+ res(1,4) = 0
+ res(2,1) = sin(fi)
+ res(2,2) = cos(fi)
+ res(2,3) = 0
+ res(2,4) = 0
+ res(3,1) = 0
+ res(3,2) = 0
+ res(3,3) = 1.0d0
+ res(3,4) = 0
+ res(4,1) = 0
+ res(4,2) = 0
+ res(4,3) = 0
+ res(4,4) = 1.0d0
+ return
+ end subroutine
+!c ! IdentityM
+ subroutine IdentityM(res)
+ implicit none
+ double precision, intent(out) :: res(4,4)
+ res(1,1) = 1.0d0
+ res(1,2) = 0
+ res(1,3) = 0
+ res(1,4) = 0
+ res(2,1) = 0
+ res(2,2) = 1.0d0
+ res(2,3) = 0
+ res(2,4) = 0
+ res(3,1) = 0
+ res(3,2) = 0
+ res(3,3) = 1.0d0
+ res(3,4) = 0
+ res(4,1) = 0
+ res(4,2) = 0
+ res(4,3) = 0
+ res(4,4) = 1.0d0
+ return
+ end subroutine
+ double precision function sq(x)
+ double precision x
+ sq = x*x
+ return
+ end function sq
+#ifdef LBFGS
+ double precision function funcgrad(x,g)
+ use MD_data, only: totT,usampl
+ implicit none
+ double precision energia(0:n_ene)
+ double precision x(nvar),g(nvar)
+ integer i
+ call var_to_geom(nvar,x)
+ call zerograd
+ call chainbuild
+ call etotal(energia(0))
+ call sum_gradient
+ funcgrad=energia(0)
+ call cart2intgrad(nvar,g)
+ if (usampl) then
+ do i=1,nres-3
+ gloc(i,icg)=gloc(i,icg)+dugamma(i)
+ enddo
+ do i=1,nres-2
+ gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
+ enddo
+ endif
+ do i=1,nvar
+ g(i)=g(i)+gloc(i,icg)
+ enddo
return
- end subroutine eprot_sc_phosphate
- SUBROUTINE sc_grad_scpho
- use calc_data
+ end function funcgrad
+ subroutine cart2intgrad(n,g)
+ integer n
+ double precision g(n)
+ double precision drt(3,3,nres),rdt(3,3,nres),dp(3,3),&
+ temp(3,3),prordt(3,3,nres),prodrt(3,3,nres)
+ double precision xx(3),xx1(3),alphi,omegi,xj,dpjk,yp,xp,xxp,yyp
+ double precision cosalphi,sinalphi,cosomegi,sinomegi,theta2,&
+ cost2,sint2,rj,dxoiij,tempkl,dxoijk,dsci,zzp,dj,dpkl
+ double precision fromto(3,3),aux(6)
+ integer i,ii,j,jjj,k,l,m,indi,ind,ind1
+ logical sideonly
+ sideonly=.false.
+ g=0.0d0
+ if (sideonly) goto 10
+ do i=1,nres-2
+ rdt(1,1,i)=-rt(1,2,i)
+ rdt(1,2,i)= rt(1,1,i)
+ rdt(1,3,i)= 0.0d0
+ rdt(2,1,i)=-rt(2,2,i)
+ rdt(2,2,i)= rt(2,1,i)
+ rdt(2,3,i)= 0.0d0
+ rdt(3,1,i)=-rt(3,2,i)
+ rdt(3,2,i)= rt(3,1,i)
+ rdt(3,3,i)= 0.0d0
+ enddo
+ do i=2,nres-2
+ drt(1,1,i)= 0.0d0
+ drt(1,2,i)= 0.0d0
+ drt(1,3,i)= 0.0d0
+ drt(2,1,i)= rt(3,1,i)
+ drt(2,2,i)= rt(3,2,i)
+ drt(2,3,i)= rt(3,3,i)
+ drt(3,1,i)=-rt(2,1,i)
+ drt(3,2,i)=-rt(2,2,i)
+ drt(3,3,i)=-rt(2,3,i)
+ enddo
+ ind1=0
+ do i=1,nres-2
+ ind1=ind1+1
+ if (n.gt.nphi) then
- real (kind=8) :: dcosom1(3),dcosom2(3)
- eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ do j=1,3
+ do k=1,2
+ dpjk=0.0D0
+ do l=1,3
+ dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
+ enddo
+ dp(j,k)=dpjk
+ prordt(j,k,i)=dp(j,k)
+ enddo
+ dp(j,3)=0.0D0
+ g(nphi+i)=g(nphi+i)+vbld(i+2)*dp(j,1)*gradc(j,i+1,icg)
+ enddo
+ xx1(1)=-0.5D0*xloc(2,i+1)
+ xx1(2)= 0.5D0*xloc(1,i+1)
+ do j=1,3
+ xj=0.0D0
+ do k=1,2
+ xj=xj+r(j,k,i)*xx1(k)
+ enddo
+ xx(j)=xj
+ enddo
+ do j=1,3
+ rj=0.0D0
+ do k=1,3
+ rj=rj+prod(j,k,i)*xx(k)
+ enddo
+ g(nphi+i)=g(nphi+i)+rj*gradx(j,i+1,icg)
+ enddo
+ if (i.lt.nres-2) then
+ do j=1,3
+ dxoiij=0.0D0
+ do k=1,3
+ dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
+ enddo
+ g(nphi+i)=g(nphi+i)+dxoiij*gradx(j,i+2,icg)
+ enddo
+ endif
- eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ endif
- 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
+ if (i.gt.1) then
+ do j=1,3
+ do k=1,3
+ dpjk=0.0
+ do l=2,3
+ dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
+ enddo
+ dp(j,k)=dpjk
+ prodrt(j,k,i)=dp(j,k)
+ enddo
+ g(i-1)=g(i-1)+vbld(i+2)*dp(j,1)*gradc(j,i+1,icg)
+ enddo
+ endif
+ xx(1)= 0.0D0
+ xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
+ xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
+ if (i.gt.1) then
+ do j=1,3
+ rj=0.0D0
+ do k=2,3
+ rj=rj+prod(j,k,i)*xx(k)
+ enddo
+ g(i-1)=g(i-1)-rj*gradx(j,i+1,icg)
+ enddo
+ endif
+ if (i.gt.1) then
+ do j=1,3
+ dxoiij=0.0D0
+ do k=1,3
+ dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
+ enddo
+ g(i-1)=g(i-1)+dxoiij*gradx(j,i+2,icg)
+ enddo
+ endif
+ do j=i+1,nres-2
+ ind1=ind1+1
+ call build_fromto(i+1,j+1,fromto)
+ do k=1,3
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,2
+ tempkl=tempkl+prordt(k,m,i)*fromto(m,l)
+ enddo
+ temp(k,l)=tempkl
+ enddo
+ enddo
+ if (n.gt.nphi) then
+ do k=1,3
+ g(nphi+i)=g(nphi+i)+vbld(j+2)*temp(k,1)*gradc(k,j+1,icg)
+ enddo
+ do k=1,3
+ dxoijk=0.0D0
+ do l=1,3
+ dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
+ enddo
+ g(nphi+i)=g(nphi+i)+dxoijk*gradx(k,j+2,icg)
+ enddo
endif
+ do k=1,3
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,3
+ tempkl=tempkl+prodrt(k,m,i)*fromto(m,l)
+ enddo
+ temp(k,l)=tempkl
+ enddo
enddo
+ if (i.gt.1) then
+ do k=1,3
+ g(i-1)=g(i-1)+vbld(j+2)*temp(k,1)*gradc(k,j+1,icg)
enddo
+ do k=1,3
+ dxoijk=0.0D0
+ do l=1,3
+ dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
+ enddo
+ g(i-1)=g(i-1)+dxoijk*gradx(k,j+2,icg)
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))
+ enddo
+ enddo
-!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
+ if (nvar.le.nphi+ntheta) return
- 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
+ 10 continue
+ do i=2,nres-1
+ if (iabs(itype(i,1)).eq.10 .or. itype(i,1).eq.ntyp1& !) cycle
+ .or. mask_side(i).eq.0 ) cycle
+ ii=ialph(i,1)
+ dsci=vbld(i+nres)
+#ifdef OSF
+ alphi=alph(i)
+ omegi=omeg(i)
+ if(alphi.ne.alphi) alphi=100.0
+ if(omegi.ne.omegi) omegi=-100.0
+#else
+ alphi=alph(i)
+ omegi=omeg(i)
+#endif
+ 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
+ do j=1,2
+ xp=temp(1,j)
+ yp=temp(2,j)
+ xxp= xp*cost2+yp*sint2
+ yyp=-xp*sint2+yp*cost2
+ zzp=temp(3,j)
+ xx(1)=xxp
+ xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
+ xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
+ do k=1,3
+ dj=0.0D0
+ do l=1,3
+ dj=dj+prod(k,l,i-1)*xx(l)
+ enddo
+ aux(jjj+k)=dj
+ enddo
+ jjj=jjj+3
enddo
- epeppho=epeppho+evdwij+Fcav+ECL
-! print *,i,j,evdwij,Fcav,ECL,rij_shift
- enddo
- enddo
- end subroutine eprot_pep_phosphate
-!!!!!!!!!!!!!!!!-------------------------------------------------------------
- subroutine emomo(evdw)
+ do k=1,3
+ g(ii)=g(ii)+aux(k)*gradx(k,i,icg)
+ g(ii+nside)=g(ii+nside)+aux(k+3)*gradx(k,i,icg)
+ enddo
+ enddo
+ return
+ end subroutine cart2intgrad
+
+
+#endif
+
+!-----------LIPID-MARTINI-UNRES-PROTEIN
+
+! new for K+
+ subroutine elip_prot(evdw)
+! subroutine emart_prot2(emartion_prot)
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
+ integer :: iint,itypi1,subchap,isel,itmp
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
- real(kind=8) :: evdw
+ real(kind=8) :: evdw,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
- integer :: ii
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
+ integer :: ii,ki
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) :: 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,&
+ emartions_prot_amber,dFdOM2,dFdL,dFdOM12,&
+ federmaus,&
+ d1i,d1j
! real(kind=8),dimension(3,2)::erhead_tail
! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
- real(kind=8) :: facd4, adler, Fgb, facd3
- integer troll,jj,istate
- real (kind=8) :: dcosom1(3),dcosom2(3)
- 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
+ real(kind=8) :: facd4, adler, Fgb, facd3
+ integer troll,jj,istate
+ real (kind=8) :: dcosom1(3),dcosom2(3)
+ real(kind=8) ::locbox(3)
+ locbox(1)=boxxsize
+ locbox(2)=boxysize
+ locbox(3)=boxzsize
+
+ evdw=0.0D0
+ if (nres_molec(4).eq.0) return
+ eps_out=80.0d0
+! sss_ele_cut=1.0d0
-!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)
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! go to 17
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+! do i=ibond_start,ibond_end
+ do ki=g_listmartsc_start,g_listmartsc_end
+ i=newcontlistmartsci(ki)
+ j=newcontlistmartscj(ki)
-! 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 )
+! print *,"I am in EVDW",i
+ itypi=iabs(itype(i,1))
+
+! if (i.ne.47) cycle
+ if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+! do j=itmp+1,itmp+nres_molec(5)
+
+! Calculate SC interaction energy.
+ itypj=iabs(itype(j,4))
+ if ((itypj.gt.ntyp_molec(4))) cycle
+ CALL elgrad_init_mart(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+! print *,i,j,"after elgrad"
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+
+ call to_box(xj,yj,zj)
+! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
+
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+! write(iout,*) "xj,yj,zj", xj,yj,zj,boxxsize
+ rreal(1)=xj
+ rreal(2)=yj
+ rreal(3)=zj
+ dxj=0.0
+ dyj=0.0
+ dzj=0.0
+! dxj = dc_norm( 1, nres+j )
+! dyj = dc_norm( 2, nres+j )
+! dzj = dc_norm( 3, nres+j )
+
+ itypi = itype(i,1)
+ itypj = itype(j,4)
+! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
+! sampling performed with amber package
+! alf1 = 0.0d0
+! alf2 = 0.0d0
+! alf12 = 0.0d0
+! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ chi1 = chi1mart(itypi,itypj)
+ chis1 = chis1mart(itypi,itypj)
+ chip1 = chipp1mart(itypi,itypj)
! chi1=0.0d0
-! chi2=0.0d0
+! chis1=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
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
+! chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1mart(itypi,itypj)
+ sig2=0.0d0
+! sig2 = sigmap2(itypi,itypj)
! 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)
+ b1cav = alphasurmart(1,itypi,itypj)
+ b2cav = alphasurmart(2,itypi,itypj)
+ b3cav = alphasurmart(3,itypi,itypj)
+ b4cav = alphasurmart(4,itypi,itypj)
+
+! b1cav=0.0d0
+! b2cav=0.0d0
+! b3cav=0.0d0
+! b4cav=0.0d0
+
! used to determine whether we want to do quadrupole calculations
- eps_in = epsintab(itypi,itypj)
+ eps_in = epsintabmart(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
+! Rtail = 0.0d0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=c(k,i+nres)
+ ctail(k,2)=c(k,j)
END DO
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
- 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 )
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
-
-! write (*,*) "eps_inout_fac = ", eps_inout_fac
-!-------------------------------------------------------------------
-! tail location and distance calculations
- d1 = dhead(1, 1, itypi, itypj)
- d2 = dhead(2, 1, itypi, itypj)
-
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+! tail lomartion and distance calculations
+! dhead1
+ d1 = dheadmart(1, 1, itypi, itypj)
+! d2 = dhead(2, 1, itypi, itypj)
DO k = 1,3
-! location of polar head is computed by taking hydrophobic centre
+! lomartion 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)
+! see unres publimartions for very informative images
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
+ enddo
+ call to_box(chead(1,1),chead(2,1),chead(3,1))
+ call to_box(chead(1,2),chead(2,2),chead(3,2))
+! write(iout,*) "TEST",chead(1,1),chead(2,1),chead(3,1),dc_norm(k, i+nres),d1
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
-! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ do k=1,3
+ Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ Fisocav=0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
-!----------------------------
- CALL sc_angular
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+! print *,sss_ele_cut,sss_ele_grad,&
+! 1.0d0/(rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = Rtail - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_aq(itypi,itypj)
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ if (evdw.gt.1.0d6) then
+ write (*,'(2(1x,a3,i3),7f7.2)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij,sigsq
+ write(*,*) facsig,faceps1_inv,om1,chiom1,chi1
+ write(*,*) "ANISO?!",chi1
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+ endif
+
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_mart(itypi,itypj)
! print *,"ADAM",aa_aq(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_aq(itypi,itypj)
+ c2 = fac * bb_aq_mart(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
!#ifdef TSCSC
! IF (bb_aq(itypi,itypj).gt.0) THEN
! evdw_p = evdw_p + evdwij
! evdw_m = evdw_m + evdwij
! END IF
!#else
- evdw = evdw &
- + evdwij
+ evdw = evdw &
+ + evdwij*sss_ele_cut
!#endif
-
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
-! fac = rij * fac
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
-! 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
+ gg(1) = fac
+!*sss_ele_cut+evdwij*sss_ele_grad
+ gg(2) = fac
+!*sss_ele_cut+evdwij*sss_ele_grad
+ gg(3) = fac
+!*sss_ele_cut+evdwij*sss_ele_grad
+! print *,"GG(1),distance grad",gg(1)
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Chif = Rtail * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
- 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)
+ dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
+ dbot = 12.0d0 * b4cav * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
-!c! Now we add appropriate partial derivatives (one in each dimension)
+ DO k= 1, 3
+ ertail(k) = Rtail_distance(k)/Rtail
+ END DO
+ erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
+ erdxj = scalar( ertail(1), dC_norm(1,j) )
+ facd1 = dtailmart(1,itypi,itypj) * vbld_inv(i+nres)
+ facd2 = dtailmart(2,itypi,itypj) * vbld_inv(j)
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 = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ gradpepmartx(k,i) = gradpepmartx(k,i) &
+ - (( dFdR + gg(k) ) * pom)*sss_ele_cut&
+ -(evdwij+Fcav)*rij*sss_ele_grad*rreal(k)
- 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)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j))
+! gvdwx(k,j) = gvdwx(k,j) &
+! + (( dFdR + gg(k) ) * pom)
+ gradpepmart(k,i) = gradpepmart(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))*sss_ele_cut&
+ -(evdwij+Fcav)*rij*sss_ele_grad*rreal(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
+ gradpepmart(k,j) = gradpepmart(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))*sss_ele_cut&
+ +(evdwij+Fcav)*rij*sss_ele_grad*rreal(k)
- 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
+ gg(k) = 0.0d0
+ ENDDO
+!c! Compute head-head and head-tail energies for each state
+!! if (.false.) then ! turn off electrostatic
+ isel = iabs(Qi)+iabs(Qj)
+ if ((itype(j,4).gt.4).and.(itype(j,4).lt.14)) isel=isel+2
+! isel=0
+! if (isel.eq.2) isel=0
+ IF (isel.le.1) THEN
+ eheadtail = 0.0d0
+ ELSE IF (isel.eq.3) THEN
+ if (iabs(Qj).eq.1) then
+ CALL edq_mart(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+ else
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ call eqd_mart(ecl,elj,epol)
+ eheadtail = ECL + elj + epol
+ endif
+ ELSE IF ((isel.eq.2)) THEN
+ if (iabs(Qi).ne.1) then
+ eheadtail=0.0d0
+ else
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ CALL eqq_mart(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
+ endif
+ ELSE IF (isel.eq.4) then
+ call edd_mart(ecl)
+ eheadtail = ECL
+ ENDIF
+! write(iout,*) "not yet implemented",j,itype(j,5)
+!! endif ! turn off electrostatic
+ evdw = evdw + (Fcav + eheadtail)*sss_ele_cut
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
-!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
+ 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 (energy_dec) write(iout,*) "FCAV", &
+ sig1,sig2,b1cav,b2cav,b3cav,b4cav
+! print *,"before sc_grad_mart", i,j, gradpepmart(1,j)
+! iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad_mart
+! print *,"after sc_grad_mart", i,j, gradpepmart(1,j)
+
+! 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
+!c! NAPISY KONCOWE
+ END DO ! j
+! END DO ! i
+!c write (iout,*) "Number of loop steps in EGB:",ind
+!c energy_dec=.false.
+! print *,"EVDW KURW",evdw,nres
+!!! return
+ 17 continue
+! go to 23
+! do i=ibond_start,ibond_end
- 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
+ do ki=g_listmartp_start,g_listmartp_end
+ i=newcontlistmartpi(ki)
+ j=newcontlistmartpj(ki)
-!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
+! print *,"I am in EVDW",i
+ itypi=10 ! the peptide group parameters are for glicine
+
+! if (i.ne.47) cycle
+ if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+ dxi=dc_norm(1,i)
+ dyi=dc_norm(2,i)
+ dzi=dc_norm(3,i)
+ dsci_inv=vbld_inv(i+1)/2.0
+! do j=itmp+1,itmp+nres_molec(5)
+
+! Calculate SC interaction energy.
+ itypj=iabs(itype(j,4))
+ if ((itypj.gt.ntyp_molec(4))) cycle
+ CALL elgrad_init_mart_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ rreal(1)=xj
+ rreal(2)=yj
+ rreal(3)=zj
+
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+
+ dxj = 0.0d0! dc_norm( 1, nres+j )
+ dyj = 0.0d0!dc_norm( 2, nres+j )
+ dzj = 0.0d0! dc_norm( 3, nres+j )
+
+ itypi = 10
+ itypj = itype(j,4)
+! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
+! sampling performed with amber package
+! alf1 = 0.0d0
+! alf2 = 0.0d0
+! alf12 = 0.0d0
+! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ chi1 = chi1mart(itypi,itypj)
+ chis1 = chis1mart(itypi,itypj)
+ chip1 = chipp1mart(itypi,itypj)
+! chi1=0.0d0
+! chis1=0.0d0
+! chip1=0.0d0
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
+! chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1mart(itypi,itypj)
+ sig2=0.0
+! sig2 = sigmap2(itypi,itypj)
+! alpha factors from Fcav/Gcav
+ b1cav = alphasurmart(1,itypi,itypj)
+ b2cav = alphasurmart(2,itypi,itypj)
+ b3cav = alphasurmart(3,itypi,itypj)
+ b4cav = alphasurmart(4,itypi,itypj)
+
+! used to determine whether we want to do quadrupole calculations
+ eps_in = epsintabmart(itypi,itypj)
+ if (eps_in.eq.0.0) eps_in=1.0
+
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+! Rtail = 0.0d0
DO k = 1, 3
- 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
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0
+ ctail(k,2)=c(k,j)
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
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
- 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
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+! tail lomartion and distance calculations
+! dhead1
+ d1 = dheadmart(1, 1, itypi, itypj)
+! print *,"d1",d1
+! d1=0.0d0
+! d2 = dhead(2, 1, itypi, itypj)
+ DO k = 1,3
+! lomartion of polar head is computed by taking hydrophobic centre
+! and moving by a d1 * dc_norm vector
+! see unres publimartions for very informative images
+ chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
+ chead(k,2) = c(k, j)
+ ENDDO
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ call to_box(chead(1,1),chead(2,1),chead(3,1))
+ call to_box(chead(1,2),chead(2,2),chead(3,2))
+
+! distance
+! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ do k=1,3
+ Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
END DO
-!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
+! 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 = 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)
+ dPOLdOM2 = 0.0d0
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = 0.0d0 ! 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)
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+! print *,sss_ele_cut,sss_ele_grad,&
+! 1.0d0/(rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ 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
+ om2=0.0d0
+ om12=0.0d0
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
+
+! now we calculate EGB - Gey-Berne
+! It will be summed up in evdwij and saved in evdw
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+! rij_shift = 1.0D0 / rij - sig + sig0ij
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),6f6.2)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_mart(itypi,itypj)
+! print *,"ADAM",aa_aq(itypi,itypj)
+
+! c1 = 0.0d0
+ c2 = fac * bb_aq_mart(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*sss_ele_cut
+!#endif
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
+! Calculate distance derivative
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
+
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+! print *,"TUT2",fac,chis1,sqom1,pom
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Chif = Rtail * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+ dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
+ dbot = 12.0d0 * b4cav * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+! dCAVdOM2 = dFdL * ( dFdOM2 )
+! dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM2=0.0d0
+ dCAVdOM12=0.0d0
+
+ DO k= 1, 3
+ ertail(k) = Rtail_distance(k)/Rtail
+ END DO
+ erdxi = scalar( ertail(1), dC_norm(1,i) )
+ erdxj = scalar( ertail(1), dC_norm(1,j) )
+ facd1 = dtailmart(1,itypi,itypj) * vbld_inv(i)
+ facd2 = dtailmart(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 = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i))
+! gradpepmartx(k,i) = gradpepmartx(k,i) &
+! - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+! gvdwx(k,j) = gvdwx(k,j) &
+! + (( dFdR + gg(k) ) * pom)
+ gradpepmart(k,i) = gradpepmart(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0*sss_ele_cut&
+ -(evdwij+Fcav)*rij*sss_ele_grad*rreal(k)*0.5d0
+ gradpepmart(k,i+1) = gradpepmart(k,i+1) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0*sss_ele_cut&
+ -(evdwij+Fcav)*rij*sss_ele_grad*rreal(k)*0.5d0
+
+ gradpepmart(k,j) = gradpepmart(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))*sss_ele_cut&
+ +(evdwij+Fcav)*rij*sss_ele_grad*rreal(k)
+
+ gg(k) = 0.0d0
+ ENDDO
+!c! Compute head-head and head-tail energies for each state
+!c! Dipole-charge interactions
+ isel = 2+iabs(Qj)
+ if ((itype(j,4).gt.4).and.(itype(j,4).lt.14)) isel=isel+2
+! if (isel.eq.4) isel=0
+ if (isel.le.2) then
+ eheadtail=0.0d0
+ ELSE if (isel.eq.3) then
+ CALL edq_mart_pep(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+! print *,"i,",i,eheadtail
+! eheadtail = 0.0d0
+ else
+!HERE WATER and other types of molecules solvents will be added
+! write(iout,*) "not yet implemented"
+ CALL edd_mart_pep(ecl)
+ eheadtail=ecl
+! CALL edd_mart_pep
+! eheadtail=0.0d0
+ endif
+ evdw = evdw +( Fcav + eheadtail)*sss_ele_cut
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+ IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
+! evdw = evdw + Fcav + eheadtail
- 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)))
+! iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad_mart_pep
+! END IF
+!c!-------------------------------------------------------------------
+!c! NAPISY KONCOWE
+ END DO ! j
+! END DO ! i
+!c write (iout,*) "Number of loop steps in EGB:",ind
+!c energy_dec=.false.
+! print *,"EVDW KURW",evdw,nres
+ 23 continue
+! print *,"before leave sc_grad_mart", i,j, gradpepmart(1,nres-1)
- gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
- gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
+ return
+ end subroutine elip_prot
- END DO
- RETURN
- END SUBROUTINE eqn
- SUBROUTINE enq(Epol)
+ SUBROUTINE eqq_mart(Ecl,Egb,Epol,Fisocav,Elj)
use calc_data
use comm_momo
- double precision facd3, adler,epol
- alphapol2 = alphapol(itypj,itypi)
+ real (kind=8) :: facd3, facd4, federmaus, adler,&
+ Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
+! integer :: k
+!c! Epol and Gpol analytical parameters
+ alphapol1 = alphapolmart(itypi,itypj)
+ alphapol2 = alphapolmart2(itypj,itypi)
+!c! Fisocav and Gisocav analytical parameters
+ al1 = alphisomart(1,itypi,itypj)
+ al2 = alphisomart(2,itypi,itypj)
+ al3 = alphisomart(3,itypi,itypj)
+ al4 = alphisomart(4,itypi,itypj)
+ csig = (1.0d0 &
+ / dsqrt(sigiso1mart(itypi, itypj)**2.0d0 &
+ + sigiso2mart(itypi,itypj)**2.0d0))
+!c!
+ pis = sig0headmart(itypi,itypj)
+ eps_head = epsheadmart(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
- R2=R2+(chead(k,2)-ctail(k,1))**2
+!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 Polarization energy
+
+!c!-------------------------------------------------------------------
+!c! Coulomb electrostatic interaction
+ Ecl = (332.0d0 * Qij) / Rhead
+!c! derivative of Ecl is Gcl...
+ dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ debkap=debaykapmart(itypi,itypj)
+ if (energy_dec) write(iout,*) "egb",Qij,debkap,Fgb,a12sq,ee0
+ Egb = -(332.0d0 * Qij *&
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
+! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
+!c! Derivative of Egb is Ggb...
+ dGGBdFGB = -(-332.0d0 * Qij * &
+ (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
+ -(332.0d0 * Qij *&
+ (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
+ dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
+ dGGBdR = dGGBdFGB * dFGBdR
+!c!-------------------------------------------------------------------
+!c! Fisocav - isotropic cavity creation term
+!c! or "how much energy it costs to put charged head in water"
+ pom = Rhead * csig
+ top = al1 * (dsqrt(pom) + al2 * pom - al3)
+ bot = (1.0d0 + al4 * pom**12.0d0)
+ botsq = bot * bot
+ FisoCav = top / bot
+! write (*,*) "Rhead = ",Rhead
+! write (*,*) "csig = ",csig
+! write (*,*) "pom = ",pom
+! write (*,*) "al1 = ",al1
+! write (*,*) "al2 = ",al2
+! write (*,*) "al3 = ",al3
+! write (*,*) "al4 = ",al4
+! write (*,*) "top = ",top
+! write (*,*) "bot = ",bot
+!c! Derivative of Fisocav is GCV...
+ dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
+ dbot = 12.0d0 * al4 * pom ** 11.0d0
+ dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
+!c!-------------------------------------------------------------------
+!c! Epol
+!c! Polarization energy - charged heads polarize hydrophobic "neck"
+ MomoFac1 = (1.0d0 - chi1 * sqom2)
MomoFac2 = (1.0d0 - chi2 * sqom1)
- 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
+ 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!*sss_ele_cut+epol*sss_ele_grad
+!c! dPOLdR1 = 0.0d0
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2!*sss_ele_cut+epol*sss_ele_grad
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
- dPOLdOM2 = 0.0d0
+ dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+! epol=epol*sss_ele_cut
+!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! (See comments in Eqq)
+!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_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
- 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)
+ 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) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailmart(1,itypi,itypj) * vbld_inv(i+nres)
+ facd4 = dtailmart(2,itypi,itypj) * vbld_inv(j)
+!c! Now we add appropriate partial derivatives (one in each dimension)
+ DO k = 1, 3
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ condor = (erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepmartx(k,i) = gradpepmartx(k,i) &
+ +sss_ele_cut*(- 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)-&
+ sss_ele_grad*rij*rreal(k)*(Ecl+Egb+Epol+Fisocav+Elj)
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepmartx(k,j) = gradpepmartx(k,j)+ dGCLdR * pom&
+! + dGGBdR * pom+ dGCVdR * pom&
+! + dPOLdR1 * (erhead_tail(k,1)&
+! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))&
+! + dPOLdR2 * condor + dGLJdR * pom
+
+ gradpepmart(k,i) = gradpepmart(k,i) + &
+ sss_ele_cut*(- dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k))&
+ - sss_ele_grad*rij*rreal(k)*(Ecl+Egb+Epol+Fisocav+Elj)
+
+
+ gradpepmart(k,j) = gradpepmart(k,j) + &
+ sss_ele_cut*( dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2)&
+ + dGLJdR * erhead(k))&
+ +sss_ele_grad*rij*rreal(k)*(Ecl+Egb+Epol+Fisocav+Elj)
END DO
- RETURN
- END SUBROUTINE enq
- SUBROUTINE eqd(Ecl,Elj,Epol)
+ RETURN
+ END SUBROUTINE eqq_mart
+
+ SUBROUTINE eqd_mart(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)
+ alphapol1 = alphapolmart(itypi,itypj)
+ w1 = wqdipmart(1,itypi,itypj)
+ w2 = wqdipmart(2,itypi,itypj)
+ pis = sig0headmart(itypi,itypj)
+ eps_head = epsheadmart(itypi,itypj)
+! eps_head=0.0d0
+! w2=0.0d0
+! alphapol1=0.0d0
!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
+ R1=R1+(ctail(k,2)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
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
+ - hawk / Rhead**4.0d0
+ dGCLdR =sss_ele_cut*(-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)
+ dGCLdOM2 = 0.0d0 !
+
+!(2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
+
!c--------------------------------------------------------------------
!c Polarization energy
!c Epol
!c!------------------------------------------------------------------
!c! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
- dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
+ dFGBdOM2 = 0.0d0 ! as om2 is 0
+! (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
+! * (2.0d0 - 0.5d0 * ee1) ) &
+! / (2.0d0 * fgb1)
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut
!c! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
- dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
-!c! dPOLdOM2 = 0.0d0
+! dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+ 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)))
+ dGLJdR = 4.0d0 * eps_head*sss_ele_cut &
+ * (((-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)
+ 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)))
+ 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)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepmartx(k,i) = gradpepmartx(k,i) &
+ - dGCLdR * pom&
+ - dPOLdR1 * hawk &
+ - dGLJdR * pom&
+ -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) &
- + dGCLdR * pom &
- + dPOLdR1 * (erhead_tail(k,1) &
- -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
- + dGLJdR * pom
+
+! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+! gradpepmartx(k,j) = gradpepmartx(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)
+ gradpepmart(k,i) = gradpepmart(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1) &
+ - dGLJdR * erhead(k)&
+ -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
+
+
+ gradpepmart(k,j) = gradpepmart(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dGLJdR * erhead(k)&
+ +(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
- 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
+ END SUBROUTINE eqd_mart
+
+ SUBROUTINE edq_mart(Ecl,Elj,Epol)
+ use comm_momo
use calc_data
double precision facd3, adler,ecl,elj,epol
- alphapol2 = alphapol(itypj,itypi)
- w1 = wqdip(1,itypi,itypj)
- w2 = wqdip(2,itypi,itypj)
- pis = sig0head(itypi,itypj)
- eps_head = epshead(itypi,itypj)
+ alphapol2 = alphapolmart(itypi,itypj)
+ w1 = wqdipmart(1,itypi,itypj)
+ w2 = wqdipmart(2,itypi,itypj)
+ pis = sig0headmart(itypi,itypj)
+ eps_head = epsheadmart(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
+! write(iout,*) "KURWA2",Rhead
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+ ECL = sparrow / Rhead**2.0d0 &
+ - hawk / Rhead**4.0d0
+!c!-------------------------------------------------------------------
+!c! derivative of ecl is Gcl
+!c! dF/dr part
+ dGCLdR =( - 2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0)*sss_ele_cut
+!c! dF/dom1
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
+!c! dF/dom2
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
+!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*sss_ele_cut
+!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)))*sss_ele_cut
+!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) )
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j)
+ facd3 = dtailmart(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)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepmartx(k,i) = gradpepmartx(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
+ - dGLJdR * pom&
+ -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
+
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+! gradpepmartx(k,j) = gradpepmartx(k,j) &
+! + dGCLdR * pom &
+! + dPOLdR2 * condor &
+! + dGLJdR * pom
+
+
+ gradpepmart(k,i) = gradpepmart(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k)&
+ -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
+
+
+ gradpepmart(k,j) = gradpepmart(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)&
+ +(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
+
+ END DO
+ RETURN
+ END SUBROUTINE edq_mart
+
+ SUBROUTINE edq_mart_pep(Ecl,Elj,Epol)
+ use comm_momo
+ use calc_data
+
+ double precision facd3, adler,ecl,elj,epol
+ alphapol2 = alphapolmart(itypi,itypj)
+ w1 = wqdipmart(1,itypi,itypj)
+ w2 = wqdipmart(2,itypi,itypj)
+ pis = sig0headmart(itypi,itypj)
+ eps_head = epsheadmart(itypi,itypj)
!c!-------------------------------------------------------------------
!c! R2 - distance between head of jth side chain and tail of ith sidechain
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
!c!-------------------------------------------------------------------
!c! ecl
- sparrow = w1 * Qi * om1
- hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
+ sparrow = w1 * Qj * om1
+ hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
+! print *,"CO2", itypi,itypj
+! print *,"CO?!.", w1,w2,Qj,om1
ECL = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
- dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ dGCLdR = (- 2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0)*sss_ele_cut
!c! dF/dom1
- dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
+ dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
!c! dF/dom2
- dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
+ dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
+!c--------------------------------------------------------------------
!c--------------------------------------------------------------------
!c Polarization energy
!c Epol
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
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)))
+ dGLJdR = 4.0d0 * eps_head*sss_ele_cut &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
+
!c! Return the results
!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+ erdxi = scalar( erhead(1), dC_norm(1,i) )
+ facd1 = d1 * vbld_inv(i+1)
+ DO k = 1, 3
+ pom = facd1*(erhead(k)-erdxi*dC_norm(k,i))
+! gradpepmartx(k,i) = gradpepmartx(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))
+! gradpepmartx(k,j) = gradpepmartx(k,j) &
+! + dGCLdR * pom &
+! + dPOLdR2 * condor &
+! + dGLJdR * pom
+
+ gradpepmart(k,i) = gradpepmart(k,i)+pom*(dGCLdR+dGLJdR)
+ gradpepmart(k,i+1) = gradpepmart(k,i+1)-pom*(dGCLdR+dGLJdR)
+
+ gradpepmart(k,i) = gradpepmart(k,i) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))&
+ -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
+ gradpepmart(k,i+1) = gradpepmart(k,i+1) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))&
+ -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
+
+
+
+ gradpepmart(k,j) = gradpepmart(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)&
+ +(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij
+
+
+ END DO
+ RETURN
+ END SUBROUTINE edq_mart_pep
+!--------------------------------------------------------------------------
+
+ SUBROUTINE edd_mart(ECL)
+! IMPLICIT NONE
+ use comm_momo
+ use calc_data
+
+ double precision ecl
+!c! csig = sigiso(itypi,itypj)
+ w1 = wqdipmart(1,itypi,itypj)
+ w2 = wqdipmart(2,itypi,itypj)
+! w2=0.0d0
+!c!-------------------------------------------------------------------
+!c! ECL
+! print *,"om1",om1,om2,om12
+ fac = - 3.0d0 * om1 !after integer and simplify
+ c1 = (w1 / (Rhead**3.0d0)) * fac
+ c2 = (w2 / Rhead ** 6.0d0) &
+ * (4.0d0 + 6.0d0*sqom1 ) !after integration and simplifimartion
+ ECL = c1 - c2
+!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 + 6.0d0*sqom1)
+ dGCLdR = (c1 - c2)*sss_ele_cut
+!c! dECL/dom1
+ c1 = (-3.0d0 * w1) / (Rhead**3.0d0)
+ c2 = (12.0d0 * w2*om1) / (Rhead**6.0d0)
+ dGCLdOM1 = c1 - c2
+!c! dECL/dom2
+! c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
+ c1=0.0 ! this is because om2 is 0
+! c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
+! * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ c2=0.0 !om is 0
+ dGCLdOM2 = c1 - c2
+!c! dECL/dom12
+! c1 = w1 / (Rhead ** 3.0d0)
+ c1=0.0d0 ! this is because om12 is 0
+! c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
+ c2=0.0d0 !om12 is 0
+ 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) )
- 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
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepmartx(k,i) = gradpepmartx(k,i) - dGCLdR * pom&
+ -ecl*sss_ele_grad*rij*rreal(k)
+! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+! gradpepmartx(k,j) = gradpepmartx(k,j) + dGCLdR * pom
+ gradpepmart(k,i) = gradpepmart(k,i) - dGCLdR * erhead(k)&
+ -ecl*sss_ele_grad*rij*rreal(k)
- 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)
+ gradpepmart(k,j) = gradpepmart(k,j) + dGCLdR * erhead(k)&
+ +ecl*sss_ele_grad*rij*rreal(k)
END DO
RETURN
- END SUBROUTINE edq
- SUBROUTINE edd(ECL)
+ END SUBROUTINE edd_mart
+ SUBROUTINE edd_mart_pep(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)
+ w1 = wqdipmart(1,itypi,itypj)
+ w2 = wqdipmart(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))
+ * (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
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ dGCLdR = (c1 - c2)*sss_ele_cut
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
dGCLdOM1 = c1 - c2
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
dGCLdOM2 = c1 - c2
+ dGCLdOM2=0.0d0 ! this is because om2=0
!c! dECL/dom12
c1 = w1 / (Rhead ** 3.0d0)
c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
dGCLdOM12 = c1 - c2
+ dGCLdOM12=0.0d0 !this is because om12=0.0
!c!-------------------------------------------------------------------
!c! Return the results
!c! (see comments in Eqq)
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
- erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxi = scalar( erhead(1), dC_norm(1,i) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
- facd1 = d1 * vbld_inv(i+nres)
+ facd1 = d1 * vbld_inv(i)
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
+ pom = facd1*(erhead(k)-erdxi*dC_norm(k,i))
+ gradpepmart(k,i) = gradpepmart(k,i) + dGCLdR * pom
+ gradpepmart(k,i+1) = gradpepmart(k,i+1) - dGCLdR * pom
+! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+! gradpepmartx(k,j) = gradpepmartx(k,j) + dGCLdR * pom
+
+ gradpepmart(k,i) = gradpepmart(k,i) - dGCLdR * erhead(k)*0.5d0&
+ -ECL*sss_ele_grad*rreal(k)*rij
+ gradpepmart(k,i+1) = gradpepmart(k,i+1)- dGCLdR * erhead(k)*0.5d0&
+ -ECL*sss_ele_grad*rreal(k)*rij
+
+ gradpepmart(k,j) = gradpepmart(k,j) + dGCLdR * erhead(k)&
+ +ECL*sss_ele_grad*rreal(k)*rij
- 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
+ END SUBROUTINE edd_mart_pep
+
+ SUBROUTINE elgrad_init_mart(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ use comm_momo
use calc_data
-
real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
eps_out=80.0d0
itypi = itype(i,1)
- itypj = itype(j,1)
+ itypj = itype(j,4)
+! print *,"in elegrad",i,j,itypi,itypj
!c! 1/(Gas Constant * Thermostate temperature) = BetaT
!c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
!c! t_bath = 300
Rb=0.001986d0
BetaT = 1.0d0 / (298.0d0 * Rb)
!c! Gay-berne var's
- sig0ij = sigma( itypi,itypj )
- chi1 = chi( itypi, itypj )
- chi2 = chi( itypj, itypi )
- chi12 = chi1 * chi2
- chip1 = chipp( itypi, itypj )
- chip2 = chipp( itypj, itypi )
- chip12 = chip1 * chip2
-! chi1=0.0
-! chi2=0.0
-! chi12=0.0
-! chip1=0.0
-! chip2=0.0
-! chip12=0.0
+ sig0ij = sigmamart( itypi,itypj )
+ chi1 = chi1mart( itypi, itypj )
+ chi2 = 0.0d0
+ chi12 = 0.0d0
+ chip1 = chipp1mart( itypi, itypj )
+ chip2 = 0.0d0
+ chip12 = 0.0d0
!c! not used by momo potential, but needed by sc_angular which is shared
!c! by all energy_potential subroutines
alf1 = 0.0d0
alf2 = 0.0d0
alf12 = 0.0d0
-!c! location, location, location
-! xj = c( 1, nres+j ) - xi
-! yj = c( 2, nres+j ) - yi
-! zj = c( 3, nres+j ) - zi
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ dxj = 0.0d0 !dc_norm( 1, nres+j )
+ dyj = 0.0d0 !dc_norm( 2, nres+j )
+ dzj = 0.0d0 !dc_norm( 3, nres+j )
+! print *,"before dheadmart"
!c! distance from center of chain(?) to polar/charged head
-!c! write (*,*) "istate = ", 1
-!c! write (*,*) "ii = ", 1
-!c! write (*,*) "jj = ", 1
- d1 = dhead(1, 1, itypi, itypj)
- d2 = dhead(2, 1, itypi, itypj)
+ d1 = dheadmart(1, 1, itypi, itypj)
+ d2 = dheadmart(2, 1, itypi, itypj)
!c! ai*aj from Fgb
- a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ a12sq = rborn1mart(itypi,itypj) * rborn2mart(itypi,itypj)
!c! a12sq = a12sq * a12sq
!c! charge of amino acid itypi is...
+! print *,"after dheadmart"
Qi = icharge(itypi)
- Qj = icharge(itypj)
+ Qj = ichargelipid(itypj)
Qij = Qi * Qj
+! print *,"after icharge"
+
!c! chis1,2,12
- chis1 = chis(itypi,itypj)
- chis2 = chis(itypj,itypi)
- chis12 = chis1 * chis2
- sig1 = sigmap1(itypi,itypj)
- sig2 = sigmap2(itypi,itypj)
-!c! write (*,*) "sig1 = ", sig1
-!c! write (*,*) "sig2 = ", sig2
+ chis1 = chis1mart(itypi,itypj)
+ chis2 = 0.0d0
+ chis12 = 0.0d0
+ sig1 = sigmap1mart(itypi,itypj)
+ sig2 = sigmap2mart(itypi,itypj)
+! print *,"before alphasurmart"
!c! alpha factors from Fcav/Gcav
- b1cav = alphasur(1,itypi,itypj)
-! b1cav=0.0
- b2cav = alphasur(2,itypi,itypj)
- b3cav = alphasur(3,itypi,itypj)
- b4cav = alphasur(4,itypi,itypj)
- wqd = wquad(itypi, itypj)
+ b1cav = alphasurmart(1,itypi,itypj)
+ b2cav = alphasurmart(2,itypi,itypj)
+ b3cav = alphasurmart(3,itypi,itypj)
+ b4cav = alphasurmart(4,itypi,itypj)
+ wqd = wquadmart(itypi, itypj)
+! print *,"after alphasurmar n wquad"
!c! used by Fgb
- eps_in = epsintab(itypi,itypj)
+ eps_in = epsintabmart(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
+!c! tail lomartion and distance calculations
Rtail = 0.0d0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=c(k,i+nres)-dtailmart(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j)!-dtailmart(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
!c!-------------------------------------------------------------------
-!c! Calculate location and distance between polar heads
+!c! Calculate lomartion and distance between polar heads
!c! distance between heads
!c! for each one of our three dimensional space...
- d1 = dhead(1, 1, itypi, itypj)
- d2 = dhead(2, 1, itypi, itypj)
+ d1 = dheadmart(1, 1, itypi, itypj)
+ d2 = dheadmart(2, 1, itypi, itypj)
DO k = 1,3
-!c! location of polar head is computed by taking hydrophobic centre
+!c! lomartion 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! see unres publimartions for very informative images
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
!c! distance
!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
!c! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!c!-------------------------------------------------------------------
!c! zero everything that should be zero'ed
Egb = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
RETURN
- END SUBROUTINE elgrad_init
+ END SUBROUTINE elgrad_init_mart
+
+ SUBROUTINE elgrad_init_mart_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ use comm_momo
+ use calc_data
+ real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
+ eps_out=80.0d0
+ itypi = 10
+ itypj = itype(j,4)
+!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 = sigmamart( itypi,itypj )
+ chi1 = chi1mart( itypi, itypj )
+ chi2 = 0.0d0
+ chi12 = 0.0d0
+ chip1 = chipp1mart( itypi, itypj )
+ chip2 = 0.0d0
+ chip12 = 0.0d0
+!c! not used by momo potential, but needed by sc_angular which is shared
+!c! by all energy_potential subroutines
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ dxj = 0.0d0 !dc_norm( 1, nres+j )
+ dyj = 0.0d0 !dc_norm( 2, nres+j )
+ dzj = 0.0d0 !dc_norm( 3, nres+j )
+!c! distance from center of chain(?) to polar/charged head
+ d1 = dheadmart(1, 1, itypi, itypj)
+ d2 = dheadmart(2, 1, itypi, itypj)
+!c! ai*aj from Fgb
+ a12sq = rborn1mart(itypi,itypj) * rborn2mart(itypi,itypj)
+!c! a12sq = a12sq * a12sq
+!c! charge of amino acid itypi is...
+ Qi = 0
+ Qj = ichargelipid(itypj)
+! Qij = Qi * Qj
+!c! chis1,2,12
+ chis1 = chis1mart(itypi,itypj)
+ chis2 = 0.0d0
+ chis12 = 0.0d0
+ sig1 = sigmap1mart(itypi,itypj)
+ sig2 = sigmap2mart(itypi,itypj)
+!c! alpha factors from Fcav/Gcav
+ b1cav = alphasurmart(1,itypi,itypj)
+ b2cav = alphasurmart(2,itypi,itypj)
+ b3cav = alphasurmart(3,itypi,itypj)
+ b4cav = alphasurmart(4,itypi,itypj)
+ wqd = wquadmart(itypi, itypj)
+!c! used by Fgb
+ eps_in = epsintabmart(itypi,itypj)
+ eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
+!c!-------------------------------------------------------------------
+!c! tail lomartion and distance calculations
+ Rtail = 0.0d0
+ DO k = 1, 3
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailmart(1,itypi,itypj)*dc_norm(k,i)
+ ctail(k,2)=c(k,j)!-dtailmart(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 lomartion and distance between polar heads
+!c! distance between heads
+!c! for each one of our three dimensional space...
+ d1 = dheadmart(1, 1, itypi, itypj)
+ d2 = dheadmart(2, 1, itypi, itypj)
+
+ DO k = 1,3
+!c! lomartion of polar head is computed by taking hydrophobic centre
+!c! and moving by a d1 * dc_norm vector
+!c! see unres publimartions for very informative images
+ chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
+ chead(k,2) = c(k, j)
+!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_mart_pep
+
+ subroutine sc_grad_mart
+ use calc_data
+ real(kind=8), dimension(3) :: dcosom1,dcosom2
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
+ +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
+ +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
+
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+
+ do k=1,3
+ dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+ dcosom2(k)=rij*(dc_norm(k,j)-om2*erij(k))
+ enddo
+ do k=1,3
+ gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))
+! print *,'gg',k,gg(k)
+ enddo
+! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
+! write (iout,*) "gg",(gg(k),k=1,3)
+ do k=1,3
+ gradpepmartx(k,i)=gradpepmartx(k,i)-gg(k)*sss_ele_cut &
+ +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut
+
+! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) &
+! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv
+
+! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ enddo
+!
+! Calculate the components of the gradient in DC and X
+!
+ do l=1,3
+ gradpepmart(l,i)=gradpepmart(l,i)-gg(l)*sss_ele_cut
+ gradpepmart(l,j)=gradpepmart(l,j)+gg(l)*sss_ele_cut
+ enddo
+ end subroutine sc_grad_mart
+
+ subroutine sc_grad_mart_pep
+ use calc_data
+ real(kind=8), dimension(3) :: dcosom1,dcosom2
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
+ +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
+ +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
+
+ eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12&
+ +dCAVdOM12+ dGCLdOM12
+! diagnostics only
+! eom1=0.0d0
+! eom2=0.0d0
+! eom12=evdwij*eps1_om12
+! end diagnostics
+! write (iout,*) "gg",(gg(k),k=1,3)
+
+ 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)
+ gradpepmart(k,i)= gradpepmart(k,i) +sss_ele_cut*(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)
+ gradpepmart(k,i+1)= gradpepmart(k,i+1) +sss_ele_cut*(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)
+ gradpepmart(k,j)=gradpepmart(k,j)+gg(k)*sss_ele_cut
+ enddo
+ end subroutine sc_grad_mart_pep
end module energy
projects / unres4.git / blobdiff