gvdwc_peppho
!------------------------------IONS GRADIENT
real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
- gradpepcat,gradpepcatx,gradnuclcat,gradnuclcatx
+ 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
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,ecations_prot_amber,&
- ecation_nucl
+ 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:: &
! 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
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)
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)
! 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"
! 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)
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.'
!
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
! 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.
! edihcnstr=0
! endif
if (wtor.gt.0.0d0) then
+! print *,"WTOR",wtor,tor_mode
if (tor_mode.eq.0) then
call etor(etors)
else
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)
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
! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
! print *,"before ecatcat",wcatcat
if (nres_molec(5).gt.0) then
- if (nfgtasks.gt.1) then
- if (fg_rank.eq.0) then
- call ecatcat(ecationcation)
- endif
- else
- call ecatcat(ecationcation)
- endif
- if (oldion.gt.0) then
- call ecat_prot(ecation_prot)
- else
- call ecats_prot_amber(ecation_prot)
- endif
+ 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
ecationcation=0.0d0
ecation_prot=0.0d0
+ ecation_protang=0.0d0
+ ecat_prottran=0.0d0
endif
+ 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)
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", wtor_nucl
#ifdef TIMING
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
+ ecorr3_nucl,ehomology_constr
real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
- ecation_nucl
+ 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
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
+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+wcatnucl*ecation_nucl
+ +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+wcatnucl*ecation_nucl
+ +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
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
+ ecorr3_nucl,ehomology_constr
real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
- ecation_nucl
+ 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)
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,&
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,&
- ecation_nucl,wcatnucl,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,&
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,Eafmforce, &
- etube,wtube, &
+ 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,&
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,&
- ecation_nucl,wcatnucl,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)'/ &
'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'
! 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'
!
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'
! 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,icont
+ 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
! 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
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
!
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'
! 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'
!
! 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'
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
+ 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"
#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
iti1=nloctyp
endif
+#endif
! print *,i,itype(i-2,1),iti
#ifdef NEWCORR
cost1=dcos(theta(i-1))
write (iout,*) 'theta=', theta(i-1)
#endif
#else
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
+ if (i.gt. innt+2 .and. i.lt.inct+2) then
! write(iout,*) "i,",molnum(i),nloctyp
! print *, "i,",molnum(i),i,itype(i-2,1)
if (molnum(i).eq.1) then
#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
! 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
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"
! 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'
! 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'
#ifdef NEWCORR
gloc(nphi+i,icg)=gloc(nphi+i,icg)&
-(gs13+gsE13+gsEE1)*wturn4&
- *fac_shield(i)*fac_shield(j)
+ *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)
+ *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)
+ *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
! 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'
! 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,icont
+ 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,&
!d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
! do i=iatscp_s,iatscp_e
if (nres_molec(1).eq.0) return
- do icont=g_listscp_start,g_listscp_end
- i=newcontlistscpi(icont)
- j=newcontlistscpj(icont)
+ 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))
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)
!
! 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
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'
!
! 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'
! 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'
! 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
! & (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)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
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
!-----------------------------------------------------------------------------
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 e_modeller(ehomology_constr)
+! implicit none
+! include 'DIMENSIONS'
+ 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'
+!
- 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
- return
- end subroutine ebend_kcc
-!c------------
-!c-------------------------------------------------------------------------------------
- subroutine etheta_constr(ethetacnstr)
- real (kind=8) :: ethetacnstr,thetiii,difi
- integer :: i,itheta
- ethetacnstr=0.0d0
-!C print *,ithetaconstr_start,ithetaconstr_end,"TU"
- do i=ithetaconstr_start,ithetaconstr_end
- itheta=itheta_constr(i)
- thetiii=theta(itheta)
- difi=pinorm(thetiii-theta_constr0(i))
- if (difi.gt.theta_drange(i)) then
- difi=difi-theta_drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
- +for_thet_constr(i)*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
- gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
- +for_thet_constr(i)*difi**3
- else
- difi=0.0
- endif
- if (energy_dec) then
- write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",&
- i,itheta,rad2deg*thetiii,&
- rad2deg*theta_constr0(i), rad2deg*theta_drange(i),&
- rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,&
- gloc(itheta+nphi-2,icg)
- endif
+
+ do i=1,max_template
+ distancek(i)=9999999.9
enddo
- return
- end subroutine etheta_constr
-!-----------------------------------------------------------------------------
- subroutine eback_sc_corr(esccor)
-! 7/21/2007 Correlations between the backbone-local and side-chain-local
-! conformational states; temporarily implemented as differences
-! between UNRES torsional potentials (dependent on three types of
-! residues) and the torsional potentials dependent on all 20 types
-! of residues computed from AM1 energy surfaces of terminally-blocked
-! amino-acid residues.
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.LOCAL'
-! include 'COMMON.TORSION'
-! include 'COMMON.SCCOR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.DERIV'
-! include 'COMMON.CHAIN'
-! include 'COMMON.NAMES'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.FFIELD'
-! include 'COMMON.CONTROL'
- real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
- cosphi,sinphi
- logical :: lprn
- integer :: i,interty,j,isccori,isccori1,intertyp
-! Set lprn=.true. for debugging
- lprn=.false.
-! lprn=.true.
-! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
- esccor=0.0D0
- do i=itau_start,itau_end
- if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
- esccor_ii=0.0D0
- isccori=isccortyp(itype(i-2,1))
- isccori1=isccortyp(itype(i-1,1))
-! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
- phii=phi(i)
- do intertyp=1,3 !intertyp
- esccor_ii=0.0D0
-!c Added 09 May 2012 (Adasko)
-!c Intertyp means interaction type of backbone mainchain correlation:
-! 1 = SC...Ca...Ca...Ca
-! 2 = Ca...Ca...Ca...SC
-! 3 = SC...Ca...Ca...SCi
- gloci=0.0D0
- if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
- (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
- (itype(i-1,1).eq.ntyp1))) &
- .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
- .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
- .or.(itype(i,1).eq.ntyp1))) &
- .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
- (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
- (itype(i-3,1).eq.ntyp1)))) cycle
- if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
- if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
- cycle
- do j=1,nterm_sccor(isccori,isccori1)
- v1ij=v1sccor(j,intertyp,isccori,isccori1)
- v2ij=v2sccor(j,intertyp,isccori,isccori1)
- cosphi=dcos(j*tauangle(intertyp,i))
- sinphi=dsin(j*tauangle(intertyp,i))
- if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
- esccor=esccor+v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
- 'esccor',i,intertyp,esccor_ii
-! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
- gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
- if (lprn) &
- write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
- restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
- (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
- (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
- gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
- enddo !intertyp
- enddo
+ odleg=0.0d0
- 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.
+! 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
- 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))
+! 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
+
+! 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
+
+!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
+! 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
+#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
- endif
- ecorr=0.0D0
+! 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)
-! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
-! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
- do i=nnt,nct
+ 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 i=loc_start,loc_end
+ do i=-1,nres
do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
enddo
enddo
- do i=nnt,nct-2
-
- DO ISHIFT = 3,4
+!
+! 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
+! write (iout,*) "maxres",maxres,"nres",nres
- 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
+ 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)
- ENDDO ! ISHIFT
+!
+ 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
- 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
- do m=i,j-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
+!
+! 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
+!
+! 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 m=k,l-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
+#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
- esccorr=-eij*ekl
+!
+! 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
+ endif
+ if (waga_d.eq.1.0d0) then
+ write (iout,*) "e_modeller after SC loop: duscdiff/x"
+ do i=1,nres
+ write (iout,*) i,(duscdiff(j,i),j=1,3)
+ write (iout,*) i,(duscdiffx(j,i),j=1,3)
+ enddo
+ endif
+#endif
+
+! Total energy from homology restraints
+#ifdef DEBUG
+ write (iout,*) "odleg",odleg," kat",kat
+#endif
+!
+! Addition of energy of theta angle and SC local geom over constr_homologs ref strs
+!
+! ehomology_constr=odleg+kat
+!
+! For Lorentzian-type Urestr
+!
+
+ if (waga_dist.ge.0.0d0) then
+!
+! For Gaussian-type Urestr
+!
+ ehomology_constr=(waga_dist*odleg+waga_angle*kat+ &
+ waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+! write (iout,*) "ehomology_constr=",ehomology_constr
+! print *, "ok7"
+ else
+!
+! For Lorentzian-type Urestr
+!
+ ehomology_constr=(-waga_dist*odleg+waga_angle*kat+ &
+ waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
+! write (iout,*) "ehomology_constr=",ehomology_constr
+ print *, "ok8"
+ endif
+#ifdef DEBUG
+ write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat, &
+ "Eval",waga_theta,eval, &
+ "Erot",waga_d,Erot
+ write (iout,*) "ehomology_constr",ehomology_constr
+#endif
return
- end function esccorr
+!
+! FP 01/15 end
+!
+ 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
+ 747 format(a12,i4,i4,i4,f8.3,f8.3)
+ 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
+ 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
+ 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, &
+ f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
+ end subroutine e_modeller
+
+!----------------------------------------------------------------------------
+ subroutine ebend_kcc(etheta)
+ logical lprn
+ double precision thybt1(maxang_kcc),etheta
+ integer :: i,iti,j,ihelp
+ real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1
+!C Set lprn=.true. for debugging
+ lprn=energy_dec
+!c lprn=.true.
+!C print *,"wchodze kcc"
+ if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
+ etheta=0.0D0
+ do i=ithet_start,ithet_end
+!c print *,i,itype(i-1),itype(i),itype(i-2)
+ if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 &
+ .or.itype(i,1).eq.ntyp1) cycle
+ iti=iabs(itortyp(itype(i-1,1)))
+ sinthet=dsin(theta(i))
+ costhet=dcos(theta(i))
+ do j=1,nbend_kcc_Tb(iti)
+ thybt1(j)=v1bend_chyb(j,iti)
+ enddo
+ sumth1thyb=v1bend_chyb(0,iti)+ &
+ tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
+ if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,&
+ sumth1thyb
+ ihelp=nbend_kcc_Tb(iti)-1
+ gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
+ etheta=etheta+sumth1thyb
+!C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
+ enddo
+ return
+ end subroutine ebend_kcc
+!c------------
+!c-------------------------------------------------------------------------------------
+ subroutine etheta_constr(ethetacnstr)
+ real (kind=8) :: ethetacnstr,thetiii,difi
+ integer :: i,itheta
+ ethetacnstr=0.0d0
+!C print *,ithetaconstr_start,ithetaconstr_end,"TU"
+ do i=ithetaconstr_start,ithetaconstr_end
+ itheta=itheta_constr(i)
+ thetiii=theta(itheta)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
+ +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
+ +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+ 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 etheta_constr
+
!-----------------------------------------------------------------------------
- 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)
+ 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'
-#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.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.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
-
+ 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.
-#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:'
+ write (iout,'(a)') 'Contact function values:'
do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
- j=1,num_cont_hb(i))
- enddo
+ 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,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
+ j=1,num_cont_hb(i))
+ enddo
endif
call flush(iout)
do i=1,ntask_cont_from
end subroutine multibody_hb
!-----------------------------------------------------------------------------
subroutine add_hb_contact(ii,jj,itask)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include "DIMENSIONS"
! include "COMMON.IOUNITS"
! include "COMMON.CONTACTS"
!-----------------------------------------------------------------------------
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)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
integer,parameter :: max_dim=70
end subroutine multibody_eello
!-----------------------------------------------------------------------------
subroutine add_hb_contact_eello(ii,jj,itask)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include "DIMENSIONS"
! include "COMMON.IOUNITS"
! include "COMMON.CONTACTS"
end subroutine add_hb_contact_eello
!-----------------------------------------------------------------------------
real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.DERIV'
#ifdef MOMENT
!-----------------------------------------------------------------------------
subroutine dipole(i,j,jj)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
! 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'
end subroutine kernel
!-----------------------------------------------------------------------------
real(kind=8) function eello4(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
end function eello4
!-----------------------------------------------------------------------------
real(kind=8) function eello5(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
end function eello5
!-----------------------------------------------------------------------------
real(kind=8) function eello6(i,j,k,l,jj,kk)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
!-----------------------------------------------------------------------------
real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
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'
!-----------------------------------------------------------------------------
real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
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'
end function eello6_graph2
!-----------------------------------------------------------------------------
real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
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)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
end function eello6_graph4
!-----------------------------------------------------------------------------
real(kind=8) function eello_turn6(i,jj,kk)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
#ifndef OSF
!DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
#endif
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
real(kind=8),dimension(2) :: V1,V2
real(kind=8),dimension(2,2) :: A1
#ifndef OSF
!DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
#endif
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=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
! energy_p_new_barrier.F
!-----------------------------------------------------------------------------
subroutine sum_gradient
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
use io_base, only: pdbout
! include 'DIMENSIONS'
#ifndef ISNAN
wscbase*gvdwc_scbase(j,i)+ &
wpepbase*gvdwc_pepbase(j,i)+&
wscpho*gvdwc_scpho(j,i)+ &
- wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(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)
+
wscbase*gvdwc_scbase(j,i)+ &
wpepbase*gvdwc_pepbase(j,i)+&
wscpho*gvdwc_scpho(j,i)+&
- wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(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
+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)
+ +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), &
+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)
+ +wsbloc*gsbloc(j,i)+wcatnucl*gradnuclcat(j,i)!&
+! + gradcattranc(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)
+ +wscpho*gvdwx_scpho(j,i)+wcatnucl*gradnuclcatx(j,i)&
+ +wcat_tran*gradcattranx(j,i)+gradcatangx(j,i)&
+ +wlip_prot*gradpepmartx(j,i)
+
! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
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"
end subroutine sum_gradient
!-----------------------------------------------------------------------------
subroutine sc_grad
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
use calc_data
! include 'DIMENSIONS'
! include 'COMMON.CHAIN'
enddo
do k=1,3
gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))
-!C print *,'gg',k,gg(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) &
+ 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
+ +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)) &
! Calculate the components of the gradient in DC and X
!
do l=1,3
- gradpepcat(l,i)=gradpepcat(l,i)-gg(l)
- gradpepcat(l,j)=gradpepcat(l,j)+gg(l)
+ 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
! 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)
- gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(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
- gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
+ - (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)
+ + (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
subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
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'
! Version of March '95, based on an early version of November '91.
!
!**********************************************************************
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.CHAIN'
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
!
! 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
fromto(k,l,ind)=temp(k,l)
enddo
enddo
+
do j=i+1,nres-2
ind=indmat(i,j+1)
do k=1,3
enddo
enddo
enddo
+#endif
!
! Calculate derivatives.
!
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
+ 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
+#else
do k=1,3
do l=1,3
tempkl=0.0D0
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)
!
!--- Calculate the derivatives in phi
!
+#ifdef FIVEDIAG
+ do k=1,3
+ do l=1,3
+ tempkl=0.0D0
+ do m=1,3
+ tempkl=tempkl+prodrt(k,m,i)*fromto(m,l)
+ enddo
+ temp(k,l)=tempkl
+ enddo
+ enddo
+#else
do k=1,3
do l=1,3
tempkl=0.0D0
temp(k,l)=tempkl
enddo
enddo
+#endif
+
+
do k=1,3
dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
enddo
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
+ temp(k,l)=rt(k,l,i)
+ enddo
+ enddo
+ do k=1,3
+ do l=1,3
+ fromto(k,l)=temp(k,l)
+ enddo
+ 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
+ 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 build_fromto
+#endif
+
!-----------------------------------------------------------------------------
! checkder_p.F
!-----------------------------------------------------------------------------
subroutine check_cartgrad
! Check the gradient of Cartesian coordinates in internal coordinates.
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.VAR'
!-----------------------------------------------------------------------------
subroutine check_ecart
! Check the gradient of the energy in Cartesian coordinates.
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
! 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) :: urparm(1)
!EL external fdum
integer :: nf,i,j,k
- real(kind=8) :: aincr,etot,etot1
+ real(kind=8) :: aincr,etot,etot1,ff
icg=1
nf=0
nfl=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)
subroutine check_ecartint
! Check the gradient of the energy in Cartesian coordinates.
use io_base, only: intout
+ use MD_data, only: iset
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
icg=1
nf=0
nfl=0
+ if (iset.eq.0) iset=1
call intout
! call intcartderiv
! call checkintcartgrad
call zerograd
- aincr=1.0D-5
- write(iout,*) 'Calling CHECK_ECARTINT.'
+ aincr=graddelta
+ write(iout,*) 'Calling CHECK_ECARTINT.,kupa'
nf=0
icall=0
call geom_to_var(nvar,x)
call etotal(energia)
etot=energia(0)
call cartgrad
+#ifdef FIVEDIAG
+ call grad_transform
+#endif
icall =1
do i=1,nres
write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
do j=1,3
grad_s(j,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
+
else
!- 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),&
call etotal_short(energia)
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),&
enddo
endif
write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
-! do i=1,nres
+#ifdef FIVEDIAG
+ do i=1,nres
+#else
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)
call zerograd
call etotal(energia1)
etot1=energia1(0)
- write (iout,*) "ij",i,j," etot1",etot1
+! write (iout,*) "ij",i,j," etot1",etot1
else
!- split gradient
call etotal_long(energia1)
call zerograd
call etotal(energia1)
etot2=energia1(0)
- write (iout,*) "ij",i,j," etot2",etot2
+! write (iout,*) "ij",i,j," etot2",etot2
ggg(j)=(etot1-etot2)/(2*aincr)
else
!- split gradient
subroutine check_ecartint
! Check the gradient of the energy in Cartesian coordinates.
use io_base, only: intout
+ use MD_data, only: iset
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
icg=1
nf=0
nfl=0
+ if (iset.eq.0) iset=1
call intout
! call intcartderiv
! call checkintcartgrad
if (.not.split_ene) then
call etotal(energia)
etot=energia(0)
-!el call enerprint(energia)
+! call enerprint(energia)
call cartgrad
icall =1
do i=1,nres
enddo
do j=1,3
grad_s(j,0)=gcart(j,0)
+ grad_s(j+3,0)=gxcart(j,0)
enddo
do i=1,nres
do j=1,3
grad_s(j,i)=gcart(j,i)
-! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
-
-! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
grad_s(j+3,i)=gxcart(j,i)
enddo
enddo
+ write(iout,*) "before movement analytical gradient"
+ do i=1,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3)
+ enddo
+
else
!- split gradient check
call zerograd
if (.not.split_ene) then
call zerograd
call etotal(energia1)
+! call enerprint(energia1)
etot2=energia1(0)
ggg(j)=(etot1-etot2)/(2*aincr)
else
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)
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
!-----------------------------------------------------------------------------
subroutine check_eint
! Check the gradient of energy in internal coordinates.
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
! 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)
character(len=6) :: key
!EL external fdum
integer :: i,ii,nf
- real(kind=8) :: xi,aincr,etot,etot1,etot2
+ real(kind=8) :: xi,aincr,etot,etot1,etot2,ff
call zerograd
aincr=1.0D-7
print '(a)','Calling CHECK_INT.'
#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)
!-----------------------------------------------------------------------------
subroutine Econstr_back
! MD with umbrella_sampling using Wolyne's distance measure as a constraint
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
! include 'COMMON.VAR'
endif
return
end function sscale_grad
-
-!!!!!!!!!! PBCSCALE
- real(kind=8) function sscale_ele(r)
+!SCALINING MARTINI
+ real(kind=8) function sscale_martini(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)
+! 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
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)
! 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'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
! 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'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
! 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'
! 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'
! assuming the Berne-Pechukas 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'
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)
+!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)
! assuming the Berne-Pechukas 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'
! 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'
! 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.CONTROL'
logical :: lprn
!el local variables
- integer :: iint,itypi,itypi1,itypj,subchap
+ 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,&
! 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
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'
! assuming the Gay-Berne-Vorobjev 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'
! assuming the Gay-Berne-Vorobjev 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'
! The potential depends both on the distance of peptide-group centers and on
! the orientation of the CA-CA virtual bonds.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
use comm_locel
#ifdef MPI
#endif
! print *, "before set matrices"
call set_matrices
-! print *,"after set martices"
+! print *,"after set catices"
#ifdef TIMING
time_mat=time_mat+MPI_Wtime()-time01
#endif
end subroutine eelec_scale
!-----------------------------------------------------------------------------
subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
use comm_locel
! include 'DIMENSIONS'
!
! Compute Evdwpp
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
! include 'COMMON.IOUNITS'
! 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'
! 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'
! energy_p_new-sep_barrier.F
!-----------------------------------------------------------------------------
subroutine sc_grad_scale(scalfac)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
use calc_data
! include 'DIMENSIONS'
! include 'COMMON.CHAIN'
!
! Compute the long-range slow-varying contributions to the energy
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
use MD_data, only: totT,usampl,eq_time
#ifndef ISNAN
integer :: i,n_corr,n_corr1,ierror,ierr
real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
- ecorr,ecorr5,ecorr6,eturn6,time00
+ ecorr,ecorr5,ecorr6,eturn6,time00, ehomology_constr
! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
!elwrite(iout,*)"in etotal long"
#endif
endif
!elwrite(iout,*)"in etotal long"
-
+ ehomology_constr=0.0d0
#ifdef MPI
! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
! & " absolute rank",myrank," nfgtasks",nfgtasks
energia(9)=eello_turn4
energia(10)=eturn6
energia(20)=Uconst+Uconst_back
+ energia(51)=ehomology_constr
call sum_energy(energia,.true.)
! write (iout,*) "Exit ETOTAL_LONG"
call flush(iout)
!
! Compute the short-range fast-varying contributions to the energy
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifndef ISNAN
external proc_proc
!el local variables
integer :: i,nres6
real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
- real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
+ real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr, &
+ ehomology_constr
nres6=6*nres
! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
!
! Calculate the disulfide-bridge and other energy and the contributions
! from other distance constraints.
- call edis(ehpb)
+! call edis(ehpb)
!
! Calculate the virtual-bond-angle energy.
!
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
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.)
!-----------------------------------------------------------------------------
! gradient_p.F
!-----------------------------------------------------------------------------
+#ifndef LBFGS
subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
use io_base, only:intout,briefout
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CHAIN'
! include 'COMMON.DERIV'
!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*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.DERIV'
! include 'COMMON.IOUNITS'
end subroutine func
!-----------------------------------------------------------------------------
subroutine cartgrad
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
use energy_data
use MD_data, only: totT,usampl,eq_time
! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
enddo
#ifdef DEBUG
- write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3),gloc(i,icg)
+ write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3),gloc(i,icg),(gloc_sc(j,i,icg),j=1,3)
#endif
enddo
#ifdef TIMING
#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)
+! 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
+! 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
+! 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
+! 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
!#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*8 (a-h,o-z)
+ ! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.DERIV'
! include 'COMMON.CHAIN'
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
! intcartderiv.F
!-----------------------------------------------------------------------------
subroutine intcartderiv
- ! implicit real*8 (a-h,o-z)
+ ! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
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
+ 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) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
+ 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)
#else
do i=3,nres
#endif
- if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).ne.5) then
+ 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))
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. &
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
+! 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)
+(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
+! 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
+! 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)
write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
#endif
!#undef DEBUG
- endif
+! endif
enddo
endif
enddo
! 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)
- ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
+ 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. &
! 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. &
! 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. &
end subroutine intcartderiv
!-----------------------------------------------------------------------------
subroutine checkintcartgrad
- ! implicit real*8 (a-h,o-z)
+ ! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
! q_measure.F
!-----------------------------------------------------------------------------
real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
end function qwolynes
!-----------------------------------------------------------------------------
subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
end subroutine qwolynes_prim
!-----------------------------------------------------------------------------
subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.CHAIN'
!-----------------------------------------------------------------------------
subroutine EconstrQ
! MD with umbrella_sampling using Wolyne's distance measure as a constraint
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
! include 'COMMON.VAR'
!-----------------------------------------------------------------------------
subroutine dEconstrQ_num
! Calculating numerical dUconst/ddc and dUconst/ddx
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
! include 'COMMON.VAR'
!EL external ran_number
! Local variables
- integer :: i,j,k,l,lmax,p,pmax
+ 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
dc_norm(k,nres+j)=dc(k,nres+j)/d
enddo
- call dyn_ssbond_ene(i,j,eij)
+ 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)
+ subroutine dyn_ssbond_ene(resi,resj,eij,countss)
! implicit none
! Includes
use calc_data
! Local variables
logical :: havebond
- integer itypi,itypj
+ 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
! 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
+ 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)')
! include 'COMMON.MD'
! Local variables
real(kind=8) :: emin
- integer :: i,j,imin,ierr
+ 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
+ newihpb,newjhpb,aliass
logical :: found
integer,dimension(0:nfgtasks) :: i_newnss
integer,dimension(0:nfgtasks) :: displ
integer :: g_newnss
allnss=0
+ k=0
do i=1,nres-1
do j=i+1,nres
- if (dyn_ssbond_ij(i,j).lt.1.0d300) then
+ 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
- endif
+ aliass(allnss)=k
+ endif
+ endif
enddo
enddo
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))
+ dyn_ssbond_ij(aliass(allnss)).lt.emin) then
+ emin=dyn_ssbond_ij(aliass(allnss))
imin=i
endif
enddo
if (idssb(i).eq.newihpb(j) .and. &
jdssb(i).eq.newjhpb(j)) found=.true.
enddo
-#ifndef CLUST
-#ifndef WHAM
+#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
-#endif
enddo
do i=1,newnss
if (newihpb(i).eq.idssb(j) .and. &
newjhpb(i).eq.jdssb(j)) found=.true.
enddo
-#ifndef CLUST
-#ifndef WHAM
+#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
-#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
end subroutine calctube2
!=====================================================================================================================================
subroutine calcnano(Etube)
- real(kind=8),dimension(3) :: vectube
+ 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
- integer:: i,j,iti,r
-
+ 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
!C lets ommit dummy atoms for now
if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
!C now calculate distance from center of tube and direction vectors
- xmin=boxxsize
- ymin=boxysize
- zmin=boxzsize
-
- do j=-1,1
- vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
- vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
- vectube(3)=vectube(3)+boxzsize*j
-
-
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
- vectube(1)=xtemp
- vectube(2)=ytemp
- vectube(3)=ztemp
+! 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)=vectube(1)-tubecenter(1)
- vectube(2)=vectube(2)-tubecenter(2)
- vectube(3)=vectube(3)-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 fac=fac+faccav
!C 667 continue
endif
- if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
+ 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
!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
-
+ 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)
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
+ vectube(1)=boxshift(xi-tubecenter(1),boxxsize)
+ vectube(2)=boxshift(yi-tubecenter(2),boxysize)
+ vectube(3)=boxshift(zi-tubecenter(3),boxzsize)
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
- vectube(1)=xtemp
- vectube(2)=ytemp
- vectube(3)=ztemp
-!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
-!C & tubecenter(2)
- vectube(1)=vectube(1)-tubecenter(1)
- vectube(2)=vectube(2)-tubecenter(2)
- vectube(3)=vectube(3)-tubecenter(3)
!C now calculte the distance
tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
!C now normalize vector
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)
+ 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
! SOUBROUTINE FOR AFM
subroutine AFMvel(Eafmforce)
use MD_data, only:totTafm
- real(kind=8),dimension(3) :: diffafm
+ real(kind=8),dimension(3) :: diffafm,cbeg,cend
real(kind=8) :: afmdist,Eafmforce
- integer :: i
+ 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
- do i=1,3
- diffafm(i)=c(i,afmend)-c(i,afmbeg)
- afmdist=afmdist+diffafm(i)**2
+ 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
- afmdist=dsqrt(afmdist)
+ 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
else
maxconts=10*nres ! (maxconts=maxres/4)
endif
- maxcont=12*nres ! Max. number of SC contacts
+ maxcont=100*nres ! Max. number of SC contacts
maxvar=6*nres ! Max. number of variables
!el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
! common /contacts1/
allocate(num_cont(0:nres+4))
!(maxres)
+#ifndef NEWCORR
allocate(jcont(maxconts,nres))
!(maxconts,maxres)
allocate(facont(maxconts,nres))
allocate(gacontm_hb3(3,maxconts,nres))
allocate(gacont_hbr(3,maxconts,nres))
allocate(grij_hb_cont(3,maxconts,nres))
-!(3,maxconts,maxres)
+ !(3,maxconts,maxres)
allocate(facont_hb(maxconts,nres))
allocate(ees0p(maxconts,nres))
allocate(ees0plist(maxconts,nres))
!(maxconts,maxres)
- allocate(num_cont_hb(nres))
!(maxres)
allocate(jcont_hb(maxconts,nres))
+#endif
+ allocate(num_cont_hb(nres))
!(maxconts,maxres)
! common /rotat/
allocate(Ug(2,2,nres))
allocate(sintab2(nres))
!(maxres)
! common /dipmat/
- allocate(a_chuj(2,2,maxconts,nres))
+! allocate(a_chuj(2,2,maxconts,nres))
!(2,2,maxconts,maxres)(maxconts=maxres/4)
- allocate(a_chuj_der(2,2,3,5,maxconts,nres))
+! 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(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))
!----------------------
! 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(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))
allocate(dutheta(nres))
allocate(dugamma(nres))
!(maxres)
- allocate(duscdiff(3,nres))
- allocate(duscdiffx(3,nres))
+ allocate(duscdiff(3,-1:nres))
+ allocate(duscdiffx(3,-1:nres))
!(3,maxres)
!el i io:read_fragments
! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
!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))
+ allocate(dyn_ssbond_ij(10000))
!(maxres,maxres)
! do i=1,nres
! do j=i+1,nres
- dyn_ssbond_ij(:,:)=1.0d300
+ dyn_ssbond_ij(:)=1.0d300
! enddo
! enddo
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(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
write (iout,*) "ibondp_start,ibondp_end",&
ibondp_nucl_start,ibondp_nucl_end
do i=ibondp_nucl_start,ibondp_nucl_end
- if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
- itype(i,2).eq.ntyp1_molec(2)) cycle
+
+ if (itype(i-1,2).eq.ntyp1_molec(2)&
+ .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
! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
! do j=1,3
! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
! & "estr1",i,vbld(i),distchainmax,
! & gnmr1(vbld(i),-1.0d0,distchainmax)
- diff = vbld(i)-vbldp0_nucl
if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
vbldp0_nucl,diff,AKP_nucl*diff*diff
estr_nucl=estr_nucl+diff*diff
end subroutine ebend_nucl
!----------------------------------------------------
subroutine etor_nucl(etors_nucl)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
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,*) "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)
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)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.DERIV'
!-------------------------------------------------------------------------
real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.DERIV'
!c------------------------------------------------------------------------------
#endif
subroutine ecatcat(ecationcation)
- integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj
+ 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, &
+ 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).eq.0) return
+ if (nres_molec(5).le.1) return
rcat0=3.472
epscalc=0.05
r06 = rcat0**6
! k0 = 332.0*(2.0*2.0)/80.0
itmp=0
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
-! write(iout,*) "itmp",itmp
- do i=itmp+1,itmp+nres_molec(5)-1
-
+! do i=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)
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)
+! 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
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
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)
+ 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,*) i,j,Evan1cat,Evan2cat,Eeleccat,&
+ 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
- enddo
+ 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
!---------------------------------------------------------------------------
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
+ integer :: ii,ki
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
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 i=ibond_start,ibond_end
+ do ki=g_listcatscnorm_start,g_listcatscnorm_end
+ i=newcontlistcatscnormi(ki)
+ j=newcontlistcatscnormj(ki)
! print *,"I am in EVDW",i
itypi=iabs(itype(i,1))
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)
+! do j=itmp+1,itmp+nres_molec(5)
! Calculate SC interaction energy.
itypj=iabs(itype(j,5))
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 )
! 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)
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
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
+! 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)
! 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
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
! END IF
!#else
evdw = evdw &
- + evdwij
+ + 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
-
+ 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
dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
dbot = 12.0d0 * b4cav * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
-
+ 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
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+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+nres))
+ 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) &
gg(k) = 0.0d0
ENDDO
!c! Compute head-head and head-tail energies for each state
+!! if (.false.) then ! turn off electrostatic
+ if (itype(j,5).gt.0) then ! the normal cation case
isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
+! print *,i,itype(i,1),isel
IF (isel.eq.0) THEN
-!c! No charges - do nothing
eheadtail = 0.0d0
-
ELSE IF (isel.eq.1) THEN
-!c! Nonpolar-charge interactions
if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
Qi=Qi*2
Qij=Qij*2
endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
-
CALL enq_cat(epol)
eheadtail = epol
-! eheadtail = 0.0d0
-
ELSE IF (isel.eq.3) THEN
-!c! Dipole-charge interactions
if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
Qi=Qi*2
Qij=Qij*2
endif
- 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
-! write(iout,*) "KURWA0",d1
-
CALL edq_cat(ecl, elj, epol)
eheadtail = ECL + elj + epol
-! eheadtail = 0.0d0
-
ELSE IF ((isel.eq.2)) THEN
-
-!c! Same charge-charge interaction ( +/+ or -/- )
if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
Qi=Qi*2
Qij=Qij*2
endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
-
CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
eheadtail = ECL + Egb + Epol + Fisocav + Elj
-! eheadtail = 0.0d0
-
-! ELSE IF ((isel.eq.2.and. &
-! iabs(Qi).eq.1).and. &
-! nstate(itypi,itypj).ne.1) THEN
-!c! Different charge-charge interaction ( +/- or -/+ )
-! if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
-! Qi=Qi*2
-! Qij=Qij*2
-! endif
-! if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
-! Qj=Qj*2
-! Qij=Qij*2
-! endif
-!
-! CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
+ else ! 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
+! 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
- do i=ibond_start,ibond_end
+! 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
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)
+! do j=itmp+1,itmp+nres_molec(5)
! Calculate SC interaction energy.
itypj=iabs(itype(j,5))
! 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)
dCAVdOM1 = 0.0d0
dCAVdOM2 = 0.0d0
dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ 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
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
! END IF
!#else
evdw = evdw &
- + evdwij
+ + 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
+ 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
dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
dbot = 12.0d0 * b4cav * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
-
+ 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 = dFdL * ( dFdOM2 )
+! dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM2=0.0d0
+ dCAVdOM12=0.0d0
DO k= 1, 3
ertail(k) = Rtail_distance(k)/Rtail
+ (( 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
- 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_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,&
!c!-------------------------------------------------------------------
!c! NAPISY KONCOWE
END DO ! j
- END DO ! i
+! END DO ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!c energy_dec=.false.
! print *,"EVDW KURW",evdw,nres
-
+ 23 continue
+! print *,"before leave sc_grad_cat", i,j, gradpepcat(1,nres-1)
return
end subroutine ecats_prot_amber
! use comm_momo
integer i,j,k,subchap,itmp,inum
real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
- r7,r4,ecationcation
+ 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, &
! 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))
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
+ dEcavdCm,boxik
real(kind=8),dimension(14) :: vcatnuclprm
ecation_nucl=0.0d0
+ boxik(1)=boxxsize
+ boxik(2)=boxysize
+ boxik(3)=boxzsize
+
if (nres_molec(5).eq.0) return
itmp=0
do i=1,4
itmp=itmp+nres_molec(i)
enddo
- do i=iatsc_s_nucl,iatsc_e_nucl
+! 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))
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 &
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
- 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)=(vcat(k)-vsug(k))
+ 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)
!-----------------------------------------------------------------------------
subroutine eprot_sc_base(escbase)
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'
! 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
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
+ 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)
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
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
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 sc_grad_pepbase
subroutine eprot_sc_phosphate(escpho)
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'
END SUBROUTINE sc_grad_scpho
subroutine eprot_pep_phosphate(epeppho)
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'
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
+
epeppho=epeppho+evdwij+Fcav+ECL
! print *,i,j,evdwij,Fcav,ECL,rij_shift
enddo
subroutine emomo(evdw)
use calc_data
use comm_momo
-! 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,itypi1,subchap,isel
+ 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
+ integer :: ii,icont
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
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
+! 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)
+
itypi=iabs(itype(i,1))
! if (i.ne.47) cycle
if (itypi.eq.ntyp1) cycle
!
! Calculate SC interaction energy.
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+! do iint=1,nint_gr(i)
+! do j=istart(i,iint),iend(i,iint)
! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- call dyn_ssbond_ene(i,j,evdwij)
+ 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'
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 )
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))
+
!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_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)) &
! 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
+! distance
+ 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))
+
+!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)
+
+ 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
+! 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)) &
! 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
+
!----------------------------
CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! END IF
!#else
evdw = evdw &
- + evdwij
+ + evdwij*sss_ele_cut
!#endif
c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
+ 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
dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
dbot = 12.0d0 * b4cav * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
-
+ 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
!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)
+ - (( 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)
+ + (( 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))
+ - (( dFdR + gg(k) ) * ertail(k)) &
+ -sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij)
+
!c! & - ( dFdR * ertail(k))
gvdwc(k,j) = gvdwc(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ + (( 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
! endif
! 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
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
+ evdw = evdw + Fcav*sss_ele_cut + eheadtail*sss_ele_cut
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,&
END IF
!c!-------------------------------------------------------------------
!c! NAPISY KONCOWE
- END DO ! j
- END DO ! iint
+ ! END DO ! j
+ !END DO ! iint
END DO ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!c energy_dec=.false.
use calc_data
use comm_momo
real (kind=8) :: facd3, facd4, federmaus, adler,&
- Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
+ Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap,sgrad
! integer :: k
!c! Epol and Gpol analytical parameters
alphapol1 = alphapol(itypi,itypj)
!c! Coulomb electrostatic interaction
Ecl = (332.0d0 * Qij) / Rhead
!c! derivative of Ecl is Gcl...
- dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
+ dGCLdR = (-332.0d0 * Qij ) / Rhead_sq*sss_ele_cut
dGCLdOM1 = 0.0d0
dGCLdOM2 = 0.0d0
dGCLdOM12 = 0.0d0
-(332.0d0 * Qij *&
(dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
- dGGBdR = dGGBdFGB * dFGBdR
+ 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"
!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
+ dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig*sss_ele_cut
!c!-------------------------------------------------------------------
!c! Epol
!c! Polarization energy - charged heads polarize hydrophobic "neck"
* ( 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
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut
!c! dPOLdR1 = 0.0d0
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.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)))
+ + (( 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
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&
- dPOLdR1 * hawk&
- dPOLdR2 * (erhead_tail(k,2)&
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
- - dGLJdR * pom
+ - dGLJdR * pom-sgrad
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
+ + dPOLdR2 * condor + dGLJdR * pom+sgrad
gvdwc(k,i) = gvdwc(k,i) &
- dGCLdR * erhead(k)&
- dGCVdR * erhead(k)&
- dPOLdR1 * erhead_tail(k,1)&
- dPOLdR2 * erhead_tail(k,2)&
- - dGLJdR * erhead(k)
+ - dGLJdR * erhead(k)-sgrad
gvdwc(k,j) = gvdwc(k,j) &
+ dGCLdR * erhead(k) &
+ dGCVdR * erhead(k) &
+ dPOLdR1 * erhead_tail(k,1) &
+ dPOLdR2 * erhead_tail(k,2)&
- + dGLJdR * erhead(k)
+ + dGLJdR * erhead(k)+sgrad
END DO
RETURN
! integer :: k
!c! Epol and Gpol analytical parameters
alphapol1 = alphapolcat(itypi,itypj)
- alphapol2 = alphapolcat(itypj,itypi)
+ alphapol2 = alphapolcat2(itypj,itypi)
!c! Fisocav and Gisocav analytical parameters
al1 = alphisocat(1,itypi,itypj)
al2 = alphisocat(2,itypi,itypj)
!c! Coulomb electrostatic interaction
Ecl = (332.0d0 * Qij) / Rhead
!c! derivative of Ecl is Gcl...
- dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
+ 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
-(332.0d0 * Qij *&
(dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
- dGGBdR = dGGBdFGB * dFGBdR
+ 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"
!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
+ 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"
* ( 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
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1!*sss_ele_cut+epol*sss_ele_grad
!c! dPOLdR1 = 0.0d0
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ 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
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*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
double precision dcosom1(3),dcosom2(3)
!c! used in Epol derivatives
double precision facd3, facd4
- double precision federmaus, adler
+ double precision federmaus, adler,sgrad
integer istate,ii,jj
real (kind=8) :: Fgb
! print *,"CALLING EQUAD"
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) &
+ 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
- gvdwx(k,j)= gvdwx(k,j) + gg(k) &
+ + 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
+ + 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)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
+ 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
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
+ 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
+ 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! head distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+
+ 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)))
+! 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
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
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 &
- 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
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut
pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
!c! this acts on hydrophobic center of interaction
+ 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
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss_ele_cut
!c! this acts on Calpha
gheadtail(k,3,1) = gheadtail(k,3,1) &
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)
+ 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
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
dQUADdOM1 = 0.0d0
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
* (2.0d0 - 0.5d0 * ee1) ) &
/ (2.0d0 * fgb1)
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut
+! epol=epol*sss_ele_cut
!c! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
gvdwx(k,i) = gvdwx(k,i) &
- - dPOLdR1 * hawk
+ - 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)))
+ -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
+ +epol*sss_ele_grad*rreal(k)*rij
- gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
- gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
+ gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)&
+ -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
END DO
RETURN
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
* (2.0d0 - 0.5d0 * ee2) ) &
/ (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
+! epol=epol*sss_ele_cut
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
gvdwx(k,i) = gvdwx(k,i) &
- dPOLdR2 * (erhead_tail(k,2) &
- -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
+ -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
+ + dPOLdR2 * condor+epol*sss_ele_grad*rreal(k)*rij
+
gvdwc(k,i) = gvdwc(k,i) &
- - dPOLdR2 * erhead_tail(k,2)
+ - dPOLdR2 * erhead_tail(k,2)-epol*sss_ele_grad*rreal(k)*rij
+
gvdwc(k,j) = gvdwc(k,j) &
- + dPOLdR2 * erhead_tail(k,2)
+ + dPOLdR2 * erhead_tail(k,2)+epol*sss_ele_grad*rreal(k)*rij
+
END DO
RETURN
use calc_data
use comm_momo
double precision facd3, adler,epol
- alphapol2 = alphapolcat(itypj,itypi)
+ 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
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
* (2.0d0 - 0.5d0 * ee2) ) &
/ (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ 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
SUBROUTINE eqd(Ecl,Elj,Epol)
use calc_data
use comm_momo
- double precision facd4, federmaus,ecl,elj,epol
+ double precision facd4, federmaus,ecl,elj,epol,sgrad
alphapol1 = alphapol(itypi,itypj)
w1 = wqdip(1,itypi,itypj)
w2 = wqdip(2,itypi,itypj)
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
+ 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
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
* (2.0d0 - 0.5d0 * ee1) ) &
/ (2.0d0 * fgb1)
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut
!c! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
* (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut
DO k = 1, 3
erhead(k) = Rhead_distance(k)/Rhead
erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
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
-
+ - 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
+ + dGLJdR * pom+sgrad
gvdwc(k,i) = gvdwc(k,i) &
- dGCLdR * erhead(k) &
- dPOLdR1 * erhead_tail(k,1) &
- - dGLJdR * erhead(k)
+ - dGLJdR * erhead(k)-sgrad
gvdwc(k,j) = gvdwc(k,j) &
+ dGCLdR * erhead(k) &
+ dPOLdR1 * erhead_tail(k,1) &
- + dGLJdR * erhead(k)
+ + dGLJdR * erhead(k)+sgrad
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
+
+ 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)
+
+ DO k = 1, 3
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom&
+ - dPOLdR1 * hawk &
+ - dGLJdR * pom
+
+! 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
+
+
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1) &
+ - dGLJdR * erhead(k)
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dGLJdR * erhead(k)
+
+ 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
+ double precision facd3, adler,ecl,elj,epol,sgrad
alphapol2 = alphapol(itypj,itypi)
w1 = wqdip(1,itypi,itypj)
w2 = wqdip(2,itypi,itypj)
!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 =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
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
* (2.0d0 - 0.5d0 * ee2) ) &
/ (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 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)))
+ + (( 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
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
+ - 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
+ + dGLJdR * pom+sgrad
gvdwc(k,i) = gvdwc(k,i) &
- dGCLdR * erhead(k) &
- dPOLdR2 * erhead_tail(k,2) &
- - dGLJdR * erhead(k)
+ - dGLJdR * erhead(k)-sgrad
gvdwc(k,j) = gvdwc(k,j) &
+ dGCLdR * erhead(k) &
+ dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k)
+ + dGLJdR * erhead(k)+sgrad
END DO
RETURN
use calc_data
double precision facd3, adler,ecl,elj,epol
- alphapol2 = alphapolcat(itypj,itypi)
+ alphapol2 = alphapolcat(itypi,itypj)
w1 = wqdipcat(1,itypi,itypj)
w2 = wqdipcat(2,itypi,itypj)
pis = sig0headcat(itypi,itypj)
!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+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
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
* (2.0d0 - 0.5d0 * ee2) ) &
/ (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ 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
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
* (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut+&
+ Elj*sss_ele_grad
+ Elj=Elj*sss_ele_cut
!c!-------------------------------------------------------------------
!c! Return the results
use calc_data
double precision facd3, adler,ecl,elj,epol
- alphapol2 = alphapolcat(itypj,itypi)
+ alphapol2 = alphapolcat(itypi,itypj)
w1 = wqdipcat(1,itypi,itypj)
w2 = wqdipcat(2,itypi,itypj)
pis = sig0headcat(itypi,itypj)
!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+&
+ ECL*sss_ele_grad
+ ECL=ECL*sss_ele_cut
!c! dF/dom1
dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
!c! dF/dom2
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
* (2.0d0 - 0.5d0 * ee2) ) &
/ (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ 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
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 &
+ dGLJdR = 4.0d0 * eps_head*sss_ele_cut &
* (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))+Elj*sss_ele_grad
+ Elj=Elj*sss_ele_cut
!c!-------------------------------------------------------------------
!c! Return the results
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
+ 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) &
DO k = 1, 3
pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
+ 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
+ gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom+(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)
+ 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
+
+ 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
+
+ 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
+
+ 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
+
+ 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
+
+ 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
alf1 = 0.0d0
alf2 = 0.0d0
alf12 = 0.0d0
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ dxj = 0.0d0 !dc_norm( 1, nres+j )
+ dyj = 0.0d0 !dc_norm( 2, nres+j )
+ dzj = 0.0d0 !dc_norm( 3, nres+j )
!c! distance from center of chain(?) to polar/charged head
d1 = dheadcat(1, 1, itypi, itypj)
d2 = dheadcat(2, 1, itypi, itypj)
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
+ j=i
+ endif
+ jtyp=itype(j,4)
+ do k=1,3
+ dist(k)=c(k,j)-c(k,i+1)
+ enddo
+ sumdist=0.0d0
+ do k=1,3
+ 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 (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
- subroutine make_SCSC_inter_list
- include 'mpif.h'
- real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
- real*8 :: dist_init, dist_temp,r_buff_list
- integer:: contlisti(250*nres),contlistj(250*nres)
-! integer :: newcontlisti(200*nres),newcontlistj(200*nres)
- integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_sc,g_ilist_sc
- integer displ(0:nprocs),i_ilist_sc(0:nprocs),ierr
-! print *,"START make_SC"
- r_buff_list=5.0
- ilist_sc=0
- do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i,1))
- if (itypi.eq.ntyp1) cycle
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- call to_box(xi,yi,zi)
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j,1))
- 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
+ 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
+
+ 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
+
+
+! *(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
+ 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
+ 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
use MD_data, only: itime_mat
include 'mpif.h'
- real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
- real*8 :: dist_init, dist_temp,r_buff_list
+ 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
subroutine make_pp_inter_list
include 'mpif.h'
- real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
- real*8 :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
- real*8 :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
- real*8 :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ 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
#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)
-!-----------------------------------------------------------------------------
- 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
+
+! 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
+
+! 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(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)
+
+ 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,*) "sslipi",sslipi," ssgradlipi",ssgradlipi
+ 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
+
+
#endif
- return
- end subroutine lipid_layer
+ if (nfgtasks.gt.1)then
-!--------------------------------------------------------------------------
-!--------------------------------------------------------------------------
+ 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)
+
+
+
+ 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)
+
+
+
+ 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
+ if (nfgtasks.gt.1)then
+
+ 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)
+
+
+ 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
+
+ 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
+
+ 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
+
+ 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)
+
+ 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)
+
+
+
+
+
+#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
+
+
+#endif
+ if (nfgtasks.gt.1)then
+
+! 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)
+
+
+
+ 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)
+
+
+
+ else
+ g_ilist_martsc=ilist_martsc
+ g_ilist_martp=ilist_martp
+
+
+ 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
+
+#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)
+#endif
+ return
+ end subroutine make_lip_pep_list
+
+
+ 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
+
+ do i=1,ilist_catpnorm
+ write (iout,*) i,contlistcatpnormi(i)
+ enddo
+
+
+#endif
+ if (nfgtasks.gt.1)then
+
+ 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
+
+ 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
+
+
+!-----------------------------------------------------------------------------
+ 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
+
+ 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)
+! 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
+
+
+ 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))
+
+ gradcatangc(l,j)=gradcatangc(l,j)-grad*&
+ (dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)-&
+ ene*sss2mingrad*diffnorm(l)
+
+ gradcatangc(l,i)=gradcatangc(l,i)+grad*&
+ (dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)+&
+ ene*sss2mingrad*diffnorm(l)
+
+ 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)
+
+
+
+
+
+ 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))
+
+
+ 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))
+
+
+ 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 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
+
+ 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
+
+ endif
+
+
+ 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
+ endif
+ enddo
+ enddo
+
+ if (nvar.le.nphi+ntheta) return
+
+ 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
+ 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
+
+ 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,&
+ 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)
+ 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
+
+ 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)
+
+! 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
+! 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.0d0
+! 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)
+
+! b1cav=0.0d0
+! b2cav=0.0d0
+! b3cav=0.0d0
+! b4cav=0.0d0
+
+! 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
+ 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 lomartion and distance calculations
+! dhead1
+ d1 = dheadmart(1, 1, itypi, itypj)
+! 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+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_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
+!*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
+ 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 = dtailmart(1,itypi,itypj) * vbld_inv(i+nres)
+ facd2 = dtailmart(2,itypi,itypj) * vbld_inv(j)
+ DO k = 1, 3
+ 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 = 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)
+
+ 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
+!! 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
+
+ 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! 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_listmartp_start,g_listmartp_end
+ i=newcontlistmartpi(ki)
+ j=newcontlistmartpj(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,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
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0
+ ctail(k,2)=c(k,j)
+ END DO
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
+
+!c! tail distances will be themselves usefull elswhere
+!c1 (in Gcav, for example)
+ Rtail = dsqrt( &
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
+! tail 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
+
+! 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
+
+! 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
+ 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
+
+! 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)
+
+ return
+ end subroutine elip_prot
+
+ SUBROUTINE eqq_mart(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 = 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 needed by Epol
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
+!c! Pitagoras
+ R1 = dsqrt(R1)
+ R2 = dsqrt(R2)
+
+!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
+!c! & +dhead(1,1,itypi,itypj))**2))
+!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
+!c! & +dhead(2,1,itypi,itypj))**2))
+
+!c!-------------------------------------------------------------------
+!c! Coulomb electrostatic interaction
+ Ecl = (332.0d0 * Qij) / Rhead
+!c! derivative of Ecl is Gcl...
+ dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
+
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ debkap=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)
+ 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)))
+!c!-------------------------------------------------------------------
+!c! Return the results
+!c! These things do the dRdX derivatives, that is
+!c! allow us to change what we see from function that changes with
+!c! distance to function that changes with LOCATION (of the interaction
+!c! site)
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j) )
+ 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 eqq_mart
+
+ SUBROUTINE eqd_mart(Ecl,Elj,Epol)
+ use calc_data
+ use comm_momo
+ double precision facd4, federmaus,ecl,elj,epol
+ 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
+ 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)
+!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
+!c! dPOLdR1 = 0.0d0
+ dPOLdOM1 = 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*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)
+ END DO
+
+ 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)
+
+ DO k = 1, 3
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ 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))
+! 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
+
+
+ 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
+
+
+ END DO
+ RETURN
+ END SUBROUTINE eqd_mart
+
+ SUBROUTINE edq_mart(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
+ 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
+ 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
+!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*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)
+ 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) )
+ 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))
+ 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)
+
+ gradpepmart(k,j) = gradpepmart(k,j) + dGCLdR * erhead(k)&
+ +ecl*sss_ele_grad*rij*rreal(k)
+
+ END DO
+ RETURN
+ 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 = 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))
+ 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
+!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
+
+ 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
+
+ END DO
+ RETURN
+ 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,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
+!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 )
+! print *,"before dheadmart"
+!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...
+! print *,"after dheadmart"
+ Qi = icharge(itypi)
+ Qj = ichargelipid(itypj)
+ Qij = Qi * Qj
+! print *,"after icharge"
+
+!c! chis1,2,12
+ 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 = 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 = 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+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(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+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_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